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