1 | #!/usr/bin/perl |
---|
2 | |
---|
3 | # Written by Jessica Hamrick, (C) 2010 |
---|
4 | |
---|
5 | use strict; |
---|
6 | use warnings; |
---|
7 | use Getopt::Long; |
---|
8 | |
---|
9 | my $usage = |
---|
10 | "Usage: gutenbach-client-config [-l|--list|-a|--add|-d|--delete] [QUEUE] [--host=HOST]\n" . |
---|
11 | "\n" . |
---|
12 | "\t-l, --list\t\tList available queues\n" . |
---|
13 | "\t-a, --add QUEUE\t\tAdd a queue (must be used with -h)\n" . |
---|
14 | "\t-d, --delete QUEUE\tDelete a queue)\n" . |
---|
15 | "\t-h, --host HOST\t\tHostname for the queue\n"; |
---|
16 | |
---|
17 | my $list = 0; |
---|
18 | my $add = ""; |
---|
19 | my $delete = ""; |
---|
20 | my $host = ""; |
---|
21 | my $default = ""; |
---|
22 | |
---|
23 | GetOptions ('l|list' => \$list, |
---|
24 | 's|set-default=s' => \$default, |
---|
25 | 'a|add=s' => \$add, |
---|
26 | 'd|delete=s' => \$delete, |
---|
27 | 'h|host=s' => \$host); |
---|
28 | |
---|
29 | my $configpath = "$ENV{'HOME'}/.gutenbach"; |
---|
30 | |
---|
31 | if (! -e $configpath) { |
---|
32 | mkdir "$configpath"; |
---|
33 | } |
---|
34 | #set given queue to default |
---|
35 | if($default and !$add and !$delete and !$list) { |
---|
36 | unless(-e "$configpath/$default") { |
---|
37 | print "Error: queue '$default' doesn't exist yet...you should add it first.\n"; |
---|
38 | exit 1; |
---|
39 | } |
---|
40 | if( -e "$configpath/DEFAULT"){ |
---|
41 | unlink("$configpath/DEFAULT") or die "Couldn't remove config file '$configpath/DEFAULT'"; |
---|
42 | } |
---|
43 | my $symlink_exists = eval { symlink("",""); 1 }; |
---|
44 | if ($symlink_exists){ |
---|
45 | symlink("$configpath/$default","$configpath/DEFAULT"); |
---|
46 | print "Changed default queue to $default.\n"; |
---|
47 | } |
---|
48 | else |
---|
49 | { |
---|
50 | print "Error creating symlink to $configpath/$default"; |
---|
51 | exit 1; |
---|
52 | } |
---|
53 | } |
---|
54 | |
---|
55 | |
---|
56 | |
---|
57 | # list the existing queues |
---|
58 | elsif ($list and !$add and !$delete and !$default) { |
---|
59 | my @queues = glob("$configpath/*") or die "Couldn't find configuration files at '$configpath'"; |
---|
60 | |
---|
61 | print "Queue\t\tHost\n"; |
---|
62 | foreach my $q (@queues) { |
---|
63 | my ($host, $queue); |
---|
64 | |
---|
65 | if (-r $q) { |
---|
66 | local $/; |
---|
67 | my $fh; |
---|
68 | open $fh, $q; |
---|
69 | eval <$fh>; |
---|
70 | } |
---|
71 | |
---|
72 | print "$queue\t\t$host\n"; |
---|
73 | } |
---|
74 | } |
---|
75 | |
---|
76 | # add a new queue |
---|
77 | elsif (!$list and $add and !$delete) { |
---|
78 | if (!$host) { |
---|
79 | print $usage; |
---|
80 | exit 1; |
---|
81 | } |
---|
82 | |
---|
83 | if (-e "$configpath/$add") { |
---|
84 | print "Warning: queue '$add' already exists\n"; |
---|
85 | } |
---|
86 | |
---|
87 | open CONFIG, "> $configpath/$add" or die "Couldn't open config file '$configpath/$add'"; |
---|
88 | print CONFIG "\$host = \"$host\";\n"; |
---|
89 | print CONFIG "\$queue = \"$add\";\n"; |
---|
90 | close CONFIG; |
---|
91 | |
---|
92 | print "Added queue '$add' on host '$host'\n" |
---|
93 | } |
---|
94 | |
---|
95 | # delete an existing queue |
---|
96 | elsif (!$list and !$add and $delete) { |
---|
97 | if (! -e "$configpath/$delete") { |
---|
98 | print "Error: queue '$delete' already exists\n"; |
---|
99 | exit 1; |
---|
100 | } |
---|
101 | |
---|
102 | unlink("$configpath/$delete") or die "Couldn't remove config file '$configpath/$delete'"; |
---|
103 | } |
---|
104 | |
---|
105 | else { |
---|
106 | print $usage; |
---|
107 | exit 1; |
---|
108 | } |
---|