1#!/usr/bin/perl -w
2######################################################################
3#
4# $Id: webjob-mldbm-set-config-kvps,v 1.17 2012/01/07 08:01:23 mavrik Exp $
5#
6######################################################################
7#
8# Copyright 2004-2012 The WebJob Project, All Rights Reserved.
9#
10######################################################################
11#
12# Purpose: Set config- or client-related key/value pairs.
13#
14######################################################################
15
16use strict;
17use Fcntl qw(:DEFAULT :flock);
18use File::Basename;
19use FindBin qw($Bin $RealBin); use lib ("$Bin/../lib/perl5/site_perl", "$RealBin/../lib/perl5/site_perl", "/usr/local/webjob/lib/perl5/site_perl", "/opt/local/webjob/lib/perl5/site_perl");
20use Getopt::Std;
21use WebJob::MldbmRoutines;
22use WebJob::Properties 1.008;
23
24BEGIN
25{
26  ####################################################################
27  #
28  # The Properties hash is essentially private. Those parts of the
29  # program that wish to access or modify the data in this hash need
30  # to call GetProperties() to obtain a reference.
31  #
32  ####################################################################
33
34  my (%hProperties);
35
36  $hProperties{'CommonRegexes'} = PropertiesGetGlobalRegexes();
37
38  sub GetProperties
39  {
40    return \%hProperties;
41  }
42}
43
44######################################################################
45#
46# Main Routine
47#
48######################################################################
49
50  ####################################################################
51  #
52  # Punch in and go to work.
53  #
54  ####################################################################
55
56  my ($phProperties);
57
58  $phProperties = GetProperties();
59
60  $$phProperties{'Program'} = basename(__FILE__);
61
62  ####################################################################
63  #
64  # Get Options.
65  #
66  ####################################################################
67
68  my (%hOptions);
69
70  if (!getopts('c:d:r', \%hOptions))
71  {
72    Usage($$phProperties{'Program'});
73  }
74
75  ####################################################################
76  #
77  # A client ID, '-c', is required.
78  #
79  # N.B. We do not test the contents of this right away, because it
80  # may not be a client ID after all.
81  #
82  ####################################################################
83
84  $$phProperties{'ClientId'} = (exists($hOptions{'c'})) ? $hOptions{'c'} : undef;
85
86  if (!defined($$phProperties{'ClientId'}))
87  {
88    Usage($$phProperties{'Program'});
89  }
90
91  ####################################################################
92  #
93  # A database, '-d', is optional.
94  #
95  ####################################################################
96
97  $$phProperties{'DbFile'} = (exists($hOptions{'d'})) ? $hOptions{'d'} : "/var/webjob/db/mldbm/client.db";
98
99  ####################################################################
100  #
101  # The reverse keys flag, '-r', is optional.
102  #
103  ####################################################################
104
105  $$phProperties{'ReverseKeys'} = (exists($hOptions{'r'})) ? 1 : 0;
106
107  ####################################################################
108  #
109  # If there isn't at least one argument left, it's an error.
110  #
111  ####################################################################
112
113  if (scalar(@ARGV) < 1)
114  {
115    Usage($$phProperties{'Program'});
116  }
117
118  ####################################################################
119  #
120  # Connect to the specified DB.
121  #
122  ####################################################################
123
124  my ($phDb, $phDbContext, $sLocalError);
125
126  $phDbContext = MldbmNewContext
127  (
128    {
129      'DbFile'     => $$phProperties{'DbFile'},
130      'DbFlags'    => O_RDWR,
131      'LockFlags'  => LOCK_EX,
132      'LockMode'   => "+<",
133    }
134  );
135  if (!MldbmConnect($phDbContext, \$sLocalError))
136  {
137    print STDERR "$$phProperties{'Program'}: Error='$sLocalError'\n";
138    exit(2);
139  }
140  $phDb = $$phDbContext{'DbHandle'};
141
142  ####################################################################
143  #
144  # Set the key/value pair(s). Add intermediate layers as required.
145  #
146  ####################################################################
147
148  my $sKey;
149  if ($$phProperties{'ReverseKeys'})
150  {
151    $sKey = $$phProperties{'ClientId'};
152    if ($sKey !~ /^$$phProperties{'CommonRegexes'}{'MldbmKeyName'}$/)
153    {
154      print STDERR "$$phProperties{'Program'}: Key='$sKey' Error='Value does not pass muster.'\n";
155      exit(2);
156    }
157  }
158  else
159  {
160    if ($$phProperties{'ClientId'} !~ /^$$phProperties{'CommonRegexes'}{'ClientId'}$/)
161    {
162      print STDERR "$$phProperties{'Program'}: ClientId='$$phProperties{'ClientId'}' Error='Value does not pass muster.'\n";
163      exit(2);
164    }
165  }
166
167  foreach my $sKeyValuePair (@ARGV)
168  {
169    my ($sTempKey, $sValue) = ($sKeyValuePair =~ /^([^=]+)=(.*)$/);
170    if ($$phProperties{'ReverseKeys'})
171    {
172      $$phProperties{'ClientId'} = $sTempKey;
173      if ($$phProperties{'ClientId'} !~ /^$$phProperties{'CommonRegexes'}{'ClientId'}$/)
174      {
175        print STDERR "$$phProperties{'Program'}: ClientId='$$phProperties{'ClientId'}' Error='Value does not pass muster.'\n";
176        next;
177      }
178    }
179    else
180    {
181      $sKey = $sTempKey;
182      if ($sKey !~ /^$$phProperties{'CommonRegexes'}{'MldbmKeyName'}$/)
183      {
184        print STDERR "$$phProperties{'Program'}: Key='$sKey' Error='Value does not pass muster.'\n";
185        next;
186      }
187    }
188    my %hKeys = ( $sKey => $sValue );
189    my %hClient = ( 'Config' => \%hKeys );
190
191    if (exists($$phDb{$$phProperties{'ClientId'}}))
192    {
193      my $phClient = $$phDb{$$phProperties{'ClientId'}};
194      if (exists($$phClient{'Config'}))
195      {
196        my $phKeys = $$phClient{'Config'};
197        $$phKeys{$sKey} = $sValue,
198      }
199      else
200      {
201        $$phClient{'Config'} = \%hKeys;
202      }
203      $$phDb{$$phProperties{'ClientId'}} = $phClient;
204    }
205    else
206    {
207      $$phDb{$$phProperties{'ClientId'}} = \%hClient;
208    }
209  }
210
211  ####################################################################
212  #
213  # Shutdown and go home.
214  #
215  ####################################################################
216
217  MldbmDisconnect($phDbContext, \$sLocalError);
218
219  1;
220
221
222######################################################################
223#
224# Usage
225#
226######################################################################
227
228sub Usage
229{
230  my ($sProgram) = @_;
231  print STDERR "\n";
232  print STDERR "Usage: $sProgram [-r] [-d db] -c client-id key=value [key=value ...]\n";
233  print STDERR "\n";
234  exit(1);
235}
236
237
238=pod
239
240=head1 NAME
241
242webjob-mldbm-set-config-kvps - Set config- or client-related key/value pairs.
243
244=head1 SYNOPSIS
245
246B<webjob-mldbm-set-config-kvps> B<[-r]> B<[-d db]> B<-c client-id> B<key=value [key=value ...]>
247
248=head1 DESCRIPTION
249
250This utility sets config- or client-related key/value pairs.
251
252=head1 OPTIONS
253
254=over 4
255
256=item B<-c client-id>
257
258Specifies the client ID to update.
259
260=item B<-d db>
261
262Specifies the MLDBM database to update.
263
264=item B<-r>
265
266Reverse the meaning of the B<clientid> and B<key> arguments. This
267option allows you to set the value of a single key for each
268client/value pair specified.
269
270=back
271
272=head1 AUTHOR
273
274Klayton Monroe
275
276=head1 SEE ALSO
277
278webjob-mldbm-get-config-kvps(1)
279
280=head1 LICENSE
281
282All documentation and code are distributed under same terms and
283conditions as B<WebJob>.
284
285=cut
286