File Coverage

blib/lib/ZConf.pm
Criterion Covered Total %
statement 27 1605 1.6
branch 0 652 0.0
condition 0 57 0.0
subroutine 9 68 13.2
pod 59 59 100.0
total 95 2441 3.8


line stmt bran cond sub pod time code
1             package ZConf;
2              
3 1     1   22198 use File::Path;
  1         4  
  1         72  
4 1     1   770 use File::BaseDir qw/xdg_config_home/;
  1         1420  
  1         74  
5 1     1   902 use Chooser;
  1         148459  
  1         101  
6 1     1   17 use warnings;
  1         2  
  1         35  
7 1     1   7 use strict;
  1         2  
  1         38  
8 1     1   1171 use ZML;
  1         12526  
  1         40  
9 1     1   14 use Sys::Hostname;
  1         3  
  1         72  
10 1     1   949 use Module::List qw(list_modules);
  1         25815  
  1         100  
11 1     1   12 use base 'Error::Helper';
  1         2  
  1         19321  
12              
13             =head1 NAME
14              
15             ZConf - A configuration system allowing for either file or LDAP backed storage.
16              
17             =head1 VERSION
18              
19             Version 6.1.0
20              
21             =cut
22              
23             our $VERSION = '6.1.0';
24              
25             =head1 SYNOPSIS
26              
27             use ZConf;
28              
29             #creates a new instance
30             my $zconf = ZConf->new;
31            
32             my @configs
33              
34             =head1 METHODS
35              
36             =head2 new
37              
38             my $zconf=ZConf->(\%args);
39              
40             This initiates the ZConf object. If it can't be initiated, $zconf->error
41             will be set. This error should be assumed to be permanent.
42              
43             When it is run for the first time, it creates a filesystem only config file.
44              
45             =head3 args hash
46              
47             =head4 file
48              
49             The default is xdf_config_home."/zconf.zml", which is generally '~/.config/zconf.zml'.
50              
51             This is incompatible with the sys option.
52              
53             my $zconf=ZConf->new();
54             if($zconf->error){
55             warn('error: '.$zconf->{error}."\n".$zconf->errorString);
56             }
57              
58             =cut
59              
60             #create it...
61             sub new {
62 0     0 1   my %args;
63 0 0         if(defined($_[1])){
64 0           %args= %{$_[1]};
  0            
65             };
66              
67             #The thing that will be returned.
68             #conf holds configs
69             #args holds the arguements passed to new as well as runtime parameters
70             #set contains what set is in use for any loaded config
71             #zconf contains the parsed contents of zconf.zml
72             #user is space reserved for what ever the user of this package may wish to
73             # use it for... if they ever find the need to or etc... reserved for
74             # the prevention of poeple shoving stuff into $self->{} where ever
75             # they please... probally some one still will... but this is intented
76             # to help minimize it...
77             #error this is undef if, otherwise it is a integer for the error in question
78             #errorString this is a string describing the error
79             #meta holds meta variable information
80 0           my $self = {
81             conf=>{},
82             args=>{%args},
83             set=>{},
84             zconf=>{},
85             user=>{},
86             perror=>undef,
87             error=>undef,
88             errorString=>"",
89             meta=>{},
90             comment=>{},
91             module=>__PACKAGE__,
92             revision=>{},
93             locked=>{},
94             autoupdateGlobal=>1,
95             autoupdate=>{},
96             };
97 0           bless $self;
98              
99             #set the config file if it is not already set
100 0 0         if(!defined($self->{args}{file})){
101 0           $self->{args}{file}=xdg_config_home()."/zconf.zml";
102             #Make the config file if it does not exist.
103             #We don't create it if it is manually specified as we assume
104             #that the caller manually specified it for some reason.
105 0 0         if(!-f $self->{args}{file}){
106 0 0         if(open("CREATECONFIG", '>', $self->{args}{file})){
107 0           print CREATECONFIG "fileonly=1\nreadfallthrough=1\n";
108 0           close("CREATECONFIG");
109             }else{
110 0           print "zconf new error: '".$self->{args}{file}."' could not be opened.\n";
111 0           return undef;
112             }
113             }
114             }
115              
116 0           my $zconfzmlstring="";#holds the contents of zconf.zml
117             #returns undef if it can't read zconf.zml
118 0 0         if(open("READZCONFZML", $self->{args}{file})){
119 0           $zconfzmlstring=join("", );
120 0           my $tempstring;
121 0           close("READZCONFZML");
122             }else{
123 0           print "zconf new error: Could not open'".$self->{args}{file}."\n";
124 0           return undef;
125             }
126              
127             #tries to parse the zconf.zml
128 0           my $zml=ZML->new();
129 0           $zml->parse($zconfzmlstring);
130 0 0         if($zml->{error}){
131 0           $self->{error}=28;
132 0           $self->{errorString}="ZML\-\>parse error, '".$zml->{error}."', '".$zml->{errorString}."'";
133 0           $self->warn;
134 0           return $self;
135             }
136 0           $self->{zconf}=$zml->{var};
137              
138             #saves this for passing on to the backend
139 0           $self->{args}{zconf}=$self->{zconf};
140              
141             #if defaultChooser is defined, use it to find what the default should be
142 0 0         if(defined($self->{zconf}{defaultChooser})){
143             #runs choose if it is defined
144 0           my ($success, $choosen)=choose($self->{zconf}{defaultChooser});
145 0 0         if($success){
146             #check if the choosen has a legit name
147             #if it does not, set it to default
148 0 0         if(setNameLegit($choosen)){
149 0           $self->{args}{default}=$choosen;
150             }else{
151 0           $self->{args}{default}="default";
152             }
153             }else{
154 0           $self->{args}{default}="default";
155             }
156             }else{
157 0 0         if(defined($self->{zconf}{default})){
158 0           $self->{args}{default}=$self->{zconf}{default};
159             }else{
160 0           $self->{args}{default}="default";
161             }
162             }
163              
164             #get what the file only arg should be
165             #this is a Perl boolean value
166 0 0         if(!defined($self->{zconf}{fileonly})){
167 0           $self->{zconf}->{args}{fileonly}="0";
168             }else{
169 0           $self->{args}{fileonly}=$self->{zconf}{fileonly};
170             }
171              
172 0 0         if($self->{args}{fileonly} eq "0"){
173             #gets what the backend should be using backendChooser
174             #if not defined, check for backend and if that is not
175             #defined, just use the file backend
176 0 0         if(defined($self->{zconf}{backendChooser})){
177 0           my ($success, $choosen)=choose($self->{zconf}{backendChooser});
178 0 0         if($success){
179 0           $self->{args}{backend}=$choosen;
180             }else{
181 0 0         if(defined{$self->{zconf}{backend}}){
182 0           $self->{args}{backend}=$self->{zconf}{backend};
183             }else{
184 0           $self->{args}{backend}="file";
185             }
186             }
187             }else{
188 0 0         if(defined($self->{zconf}{backend})){
189 0           $self->{args}{backend}=$self->{zconf}{backend};
190             }else{
191 0           $self->{args}{backend}="file";
192             }
193             }
194             }else{
195 0           $self->{args}{backend}="file";
196             }
197            
198             #make sure the backend is legit
199 0           my @modules=keys( %{list_modules("ZConf::backends::",{list_modules=>1})} );
  0            
200 0           my $int=0;
201 0           my $backendLegit=0;
202 0           while ($modules[$int]) {
203 0           my $beTest=$modules[$int];
204 0           $beTest=~s/ZConf\:\:backends\:\://g;
205 0 0         if ($beTest eq $self->{args}{backend}) {
206 0           $backendLegit=1;
207             }
208              
209 0           $int++;
210             }
211              
212 0 0         if(!$backendLegit){
213 0           $self->{error}=14;
214 0           $self->{errorString}="The backend '".$self->{args}{backend}."' is not a recognized backend";
215 0           $self->warn;
216 0           return $self
217             }
218              
219             #saves a copy of self to the backend
220 0           $self->{args}{self}=$self;
221              
222             #inits the main backend
223 0           my $backend=$self->initBackend($self->{args}{backend});
224 0           my $error=0;
225 0 0 0       if ($self->error || (!defined( $backend ))) {
226 0 0         if ( $self->error ) {
227 0           $self->warn;
228             }else {
229 0           $self->warn;
230             }
231 0           $self->warnString('Using file backend');
232 0           $error=1;
233             }else {
234 0 0         if ($backend->error) {
235 0           $self->warnString('Backend errored using. Using file backend');
236 0           $error=1;
237             }else {
238 0           $self->{be}=$backend;
239             }
240             }
241              
242             #init the file backend
243 0 0         if ( $self->{args}{backend} ne 'file' ) {
244 0           $backend=$self->initBackend('file');
245 0 0 0       if (
246             $self->error ||
247             $backend->error
248             ) {
249 0           $self->{error}='11';
250 0           $self->{errorStirng}='Failed to intiate file backend';
251 0           $self->warn;
252 0           return $self;
253             }
254 0 0         if (defined( $self->{be} )) {
255 0           $self->{fbe}=$backend;
256             }else {
257 0           $self->{be}=$backend;
258             }
259             }
260            
261              
262 0           return $self;
263             }
264              
265             =head2 chooseSet
266              
267             This chooses what set should be used using the associated chooser
268             string for the config in question.
269              
270             This method does fail safely. If a improper configuration is returned by
271             chooser string, it uses the value the default set.
272              
273             It takes one arguement, which is the configuration it is for.
274              
275             If the chooser errors, is blank, or is just a newline, the default is
276             returned.
277              
278             my $set=$zconf->chooseSet("foo/bar");
279             if($zconf->error){
280             warn('error: '.$zconf->{error}."\n".$zconf->errorString);
281             }
282              
283             =cut
284              
285             #the overarching method for getting available sets
286             sub chooseSet{
287 0     0 1   my ($self, $config) = @_;
288              
289 0           $self->errorblank;
290              
291 0           my ($error, $errorString)=$self->configNameCheck($config);
292 0 0         if(defined($error)){
293 0           $self->{error}=$error;
294 0           $self->{errorString}=$errorString;
295 0           $self->warn;
296 0           return undef;
297             }
298              
299 0           my $chooserstring=$self->readChooser($config);
300              
301             #makes sure it is not blank
302 0 0         if ($chooserstring eq '') {
303 0           return $self->{args}{default};
304             }
305             #makes sure it is not just a new line
306 0 0         if ($chooserstring eq "\n") {
307 0           return $self->{args}{default};
308             }
309            
310 0           my ($success, $choosen)=choose($chooserstring);
311            
312 0 0         if(!defined( $choosen )){
313 0           return $self->{args}{default};
314             }
315            
316 0 0         if (!$self->setNameLegit($choosen)){
317 0           $self->{error}=27;
318 0           $self->{errorString}='"'.$choosen."' is not a legit set name. Using the".
319             " default of '".$self->{args}{default}."'.";
320 0           $self->warn;
321 0           return $self->{args}{default};
322             }
323            
324 0           return $choosen;
325             }
326              
327             =head2 configExists
328              
329             This method is used for checking if a config exists or not.
330              
331             It takes one option, which is the configuration to check for.
332              
333             The returned value is a perl boolean value.
334              
335             $zconf->configExists("foo/bar")
336             if($zconf->error){
337             print 'error: '.$zconf->error."\n".$zconf->errorString."\n";
338             }
339              
340             =cut
341              
342             #check if a config exists
343             sub configExists{
344 0     0 1   my ($self, $config) = @_;
345              
346 0           $self->errorblank;
347              
348 0           my ($error, $errorString)=$self->configNameCheck($config);
349 0 0         if(defined($error)){
350 0           $self->{error}=$error;
351 0           $self->{errorString}=$errorString;
352 0           $self->warn;
353 0           return undef;
354             }
355              
356             #run the checks
357 0           my $returned=$self->{be}->configExists($config);
358             #if it errors and read fall through is turned on, try the file backend
359 0 0 0       if ( $self->{be}->error && $self->{args}{readfallthrough} ) {
    0          
360 0           $returned=$self->{fbe}->configExists($config);
361 0 0         if ( $self->{fbe}->error ) {
362 0           $self->{error}=11;
363 0           $self->{errorString}='Backend errored. error="'.$self->{fbe}->error.'" errorString="'.$self->{fbe}->errorString.'"';
364 0           $self->warn;
365             }
366             }elsif ( $self->{be}->error ) {
367 0           $self->{error}=11;
368 0           $self->{errorString}='Backend errored. error="'.$self->{be}->error.'" errorString="'.$self->{be}->errorString.'"';
369 0           $self->warn;
370             }
371              
372 0           return $returned;
373             }
374              
375             =head2 configNameCheck
376              
377             This checks if the name of a config is legit or not. See the section
378             CONFIG NAME for more info on config naming.
379              
380             my ($error, $errorString) = $zconf->configNameCheck($config);
381             if($error){
382             warn("ZConf configExists:".$error.": ".$errorString);
383             $self->{error}=$error;
384             $self->{errorString}=$errorString;
385             $self->warn;
386             return undef;
387             };
388              
389             =cut
390              
391             #checks the config name
392             sub configNameCheck{
393 0     0 1   my ($self, $name) = @_;
394              
395 0           $self->errorblank;
396              
397             #checks for undef
398 0 0         if(!defined($name)){
399 0           return("11", "config name is not defined.");
400             }
401              
402             #checks for ,
403 0 0         if($name =~ /,/){
404 0           return("1", "config name,'".$name."', contains ','");
405             }
406              
407             #checks for /.
408 0 0         if($name =~ /\/\./){
409 0           return("2", "config name,'".$name."', contains '/.'");
410             }
411              
412             #checks for //
413 0 0         if($name =~ /\/\//){
414 0           return("3", "config name,'".$name."', contains '//'");
415             }
416              
417             #checks for ../
418 0 0         if($name =~ /\.\.\//){
419 0           return("4", "config name,'".$name."', contains '../'");
420             }
421              
422             #checks for /..
423 0 0         if($name =~ /\/\.\./){
424 0           return("5", "config name,'".$name."', contains '/..'");
425             }
426              
427             #checks for ^./
428 0 0         if($name =~ /^\.\//){
429 0           return("6", "config name,'".$name."', matched /^\.\//");
430             }
431              
432             #checks for /$
433 0 0         if($name =~ /\/$/){
434 0           return("7", "config name,'".$name."', matched /\/$/");
435             }
436              
437             #checks for ^/
438 0 0         if($name =~ /^\//){
439 0           return("8", "config name,'".$name."', matched /^\//");
440             }
441              
442             #checks for ^/
443 0 0         if($name =~ /\n/){
444 0           return("10", "config name,'".$name."', matched /\\n/");
445             }
446              
447 0           return(undef, "");
448             }
449              
450             =head2 createConfig
451              
452             This method is used for creating a new config.
453              
454             One arguement is needed and that is the config name.
455              
456             The returned value is a perl boolean.
457              
458             $zconf->createConfig("foo/bar")
459             if($zconf->error){
460             print 'error: '.$zconf->{error}."\n".$zconf->errorString."\n";
461             };
462              
463             =cut
464              
465             #the overarching method for getting available sets
466             sub createConfig{
467 0     0 1   my ($self, $config) = @_;
468              
469 0           $self->errorblank;
470              
471 0           my ($error, $errorString)=$self->configNameCheck($config);
472 0 0         if(defined($error)){
473 0           $self->{error}=$error;
474 0           $self->{errorString}=$errorString;
475 0           $self->warn;
476 0           return undef;
477             }
478              
479 0           my $returned=undef;
480              
481             #create the config
482 0           $self->{be}->createConfig( $config );
483 0 0         if ( $self->{be}->error ) {
484 0           $self->{error}=11;
485 0           $self->{errorString}='Backend errored. error="'.$self->{be}->error.'" errorString="'.$self->{be}->errorString.'"';
486 0           $self->warn;
487 0           return undef;
488             }
489              
490              
491             #attempt to sync the config locally if not using the file backend
492 0 0         if( defined( $self->{fbe} ) ){
493             #if it does not exist, add it
494 0 0         if(!$self->{fbe}->configExists($config)){
495 0           my $syncReturn=$self->{fbe}->createConfig($config);
496 0 0         if ( $self->{fbe}->error ){
497 0           $self->warn;
498             }
499             }
500             }
501              
502 0           return 1;
503             }
504              
505             =head2 defaultSetExists
506              
507             This checks to if the default set for a config exists. It takes one arguement,
508             which is the name of the config. The returned value is a Perl boolean.
509              
510             my $returned=$zconf->defaultSetExists('someConfig');
511             if($zconf->error){
512             warn('error: '.$zconf->{error}."\n".$zconf->errorString);
513             }
514             if($returned){
515             print "It exists.\n";
516             }
517              
518             =cut
519              
520             sub defaultSetExists{
521 0     0 1   my $self=$_[0];
522 0           my $config=$_[1];
523              
524 0           $self->errorblank;
525              
526             #make sure the config name is legit
527 0           my ($error, $errorString)=$self->configNameCheck($config);
528 0 0         if(defined($error)){
529 0           $self->{error}=$error;
530 0           $self->{errorString}=$errorString;
531 0           $self->warn;
532 0           return undef;
533             }
534              
535             #makes sure it exists
536 0 0         if (!$self->configExists($config)){
537 0           $self->{error}=12;
538 0           $self->{errorString}='The specified config, "'.$config.'" does not exist';
539 0           $self->warn;
540 0           return undef;
541             }
542              
543             #figures out what to use for the set
544 0           my $set=$self->chooseSet($config);
545 0 0         if (defined($self->{error})){
546 0           return undef;
547             }
548              
549             #get the available sets to check if the default exists
550 0           my @sets=$self->getAvailableSets($config);
551 0 0         if ($self->error) {
552 0           $self->warnString('getAvailableSets errored');
553 0           return undef;
554             }
555              
556             #check for one that matches...
557 0           my $int=0;
558 0           while (defined($sets[$int])) {
559 0 0         if ($set eq $sets[$int]) {
560 0           return 1;
561             }
562 0           $int++;
563             }
564              
565 0           return undef;
566             }
567              
568             =head2 delConfig
569              
570             This removes a config. Any sub configs will need to removes first. If any are
571             present, this method will error.
572              
573             #removes 'foo/bar'
574             $zconf->delConfig('foo/bar');
575             if(defined($zconf->error)){
576             warn('error: '.$zconf->{error}."\n".$zconf->errorString);
577             }
578              
579             =cut
580              
581             sub delConfig{
582 0     0 1   my $self=$_[0];
583 0           my $config=$_[1];
584              
585 0           $self->errorblank;
586            
587             #return if no set is given
588 0 0         if (!defined($config)) {
589 0           $self->{error}=25;
590 0           $self->{errorString}='$config not defined';
591 0           $self->warn;
592 0           return undef;
593             }
594              
595             #makes sure no subconfigs exist
596 0           my @subs=$self->getSubConfigs($config);
597             #return if this can't be completed
598 0 0         if (defined($self->{error})) {
599 0           return undef;
600             }
601 0 0         if (defined($subs[0])) {
602 0           $self->{error}=33;
603 0           $self->{errorString}='Could not remove the config as it has sub configs.';
604 0           $self->warn;
605 0           return undef;
606             }
607              
608             #delete the config
609 0           $self->{be}->delConfig( $config );
610 0 0         if ( $self->{be}->error ) {
611 0           $self->{error}=11;
612 0           $self->{errorString}='Backend errored. error="'.$self->{be}->error.'" errorString="'.$self->{be}->errorString.'"';
613 0           $self->warn;
614 0           return undef;
615             }
616              
617             #attempt to sync the config locally if not using the file backend
618 0 0         if( defined( $self->{fbe} ) ){
619             #if it does exist, remove it
620 0 0         if($self->{fbe}->configExists($config)){
621 0           my $syncReturn=$self->{fbe}->createConfig($config);
622 0 0         if ( $self->{fbe}->error ){
623 0           $self->warn;
624             }
625             }
626             }
627              
628 0           return 1;
629             }
630              
631             =head2 delSet
632              
633             This deletes a specified set.
634              
635             Two arguements are required. The first one is the name of the config and the and
636             the second is the name of the set.
637              
638             $zconf->delSetFile("foo/bar", "someset");
639             if($zconf->error){
640             warn('error: '.$zconf->{error}."\n".$zconf->errorString);
641             }
642              
643             =cut
644              
645             sub delSet{
646 0     0 1   my $self=$_[0];
647 0           my $config=$_[1];
648 0           my $set=$_[2];
649            
650 0           $self->errorblank;
651              
652             #return if no set is given
653 0 0         if (!defined($set)){
654 0           $self->{error}=24;
655 0           $self->{errorString}='$set not defined';
656 0           $self->warn;
657 0           return undef;
658             }
659              
660             #return if no config is given
661 0 0         if (!defined($config)){
662 0           $self->{error}=25;
663 0           $self->{errorString}='$config not defined';
664 0           $self->warn;
665 0           return undef;
666             }
667              
668             #makes sure it exists before continuing
669             #This will also make sure the config exists.
670 0           my $returned = $self->configExists($config);
671 0 0         if (defined($self->{error})){
672 0           $self->{error}=12;
673 0           $self->{errorString}='The config "'.$config.'" does not exist';
674 0           $self->warn;
675 0           return undef;
676             }
677              
678             #delete the config
679 0           $self->{be}->delSet( $config, $set );
680 0 0         if ( $self->{be}->error ) {
681 0           $self->{error}=11;
682 0           $self->{errorString}='Backend errored. error="'.$self->{be}->error.'" errorString="'.$self->{be}->errorString.'"';
683 0           $self->warn;
684 0           return undef;
685             }
686              
687             #attempt to sync the config locally if not using the file backend
688 0 0         if( defined( $self->{fbe} ) ){
689             #if it does exist, remove it
690 0 0         if ($self->{fbe}->setExists) {
691 0           my $syncReturn=$self->{fbe}->delSet($config, $set);
692 0 0         if ( $self->{fbe}->error ){
693 0           $self->warnString('File backend sync failed. error="'.$self->{fbe}->error.
694             '" errorString="'.$self->{fbe}->errorString.'"');
695             }
696             }
697             }
698              
699 0           return $returned;
700             }
701              
702             =head2 dumpToZML
703              
704             This dumps a loaded config to a ZML object.
705              
706             One arguement is required and it is the name of the loaded config.
707              
708             my $zml=$foo->dumpToZML($config);
709             if($zconf->error){
710             warn('error: '.$zconf->{error}."\n".$zconf->errorString);
711             }
712              
713             =cut
714              
715             sub dumpToZML{
716 0     0 1   my $self=$_[0];
717 0           my $config=$_[1];
718              
719 0           $self->errorblank;
720              
721             #return if no config is given
722 0 0         if (!defined($config)){
723 0           $self->{error}=25;
724 0           $self->{errorString}='$config not defined';
725 0           $self->warn;
726 0           return undef;
727             }
728              
729 0 0         if ( ! $self->isConfigLoaded($config) ) {
730 0           $self->{error}=26;
731 0           $self->{errorString}="Config '".$config."' is not loaded.";
732 0           $self->warn;
733 0           return undef;
734             }
735              
736             #create the ZML object
737 0           my $zml=ZML->new();
738              
739             #process variables
740 0           my $varhashkeysInt=0;#used for intering through the list of hash keys
741             #builds the ZML object
742 0           my @varhashkeys=keys(%{$self->{conf}{$config}});
  0            
743 0           while(defined($varhashkeys[$varhashkeysInt])){
744             #attempts to add the variable
745 0           $zml->addVar($varhashkeys[$varhashkeysInt],
746             $self->{conf}{$config}{$varhashkeys[$varhashkeysInt]});
747             #checks to verify there was no error
748             #this is not a fatal error... skips it if it is not legit
749 0 0         if(defined($zml->{error})){
750 0           $self->warnString(':23: $zml->add() returned '. $zml->{error}.
751             ", '".$zml->{errorString}."'. Skipping variable '".
752             $varhashkeys[$varhashkeysInt]."' in '".$config."'.");
753             }
754              
755 0           $varhashkeysInt++;
756             }
757              
758             #processes the meta variables
759 0           $varhashkeysInt=0;#used for intering through the list of hash keys
760             #builds the ZML object
761 0           @varhashkeys=keys(%{$self->{meta}{$config}});
  0            
762 0           while(defined($varhashkeys[$varhashkeysInt])){
763 0           my @metahashkeys=keys( %{$self->{meta}{ $config }{ $varhashkeys[$varhashkeysInt] }} );
  0            
764 0           my $metahashkeysInt=0;
765 0           while (defined($metahashkeys[ $metahashkeysInt ])) {
766 0           $zml->addMeta(
767             $varhashkeys[$varhashkeysInt],
768             $metahashkeys[$metahashkeysInt],
769             $self->{meta}{ $config }{ $varhashkeys[$varhashkeysInt] }{ $metahashkeys[$metahashkeysInt] }
770             );
771            
772 0           $metahashkeysInt++;
773             }
774              
775 0           $varhashkeysInt++;
776             }
777              
778             #processes the comment variables
779 0           $varhashkeysInt=0;#used for intering through the list of hash keys
780             #builds the ZML object
781 0           @varhashkeys=keys(%{ $self->{comment}{$config} });
  0            
782 0           while(defined($varhashkeys[$varhashkeysInt])){
783 0           my @commenthashkeys=keys( %{$self->{self}->{comment}{ $config }{ $varhashkeys[$varhashkeysInt] }} );
  0            
784 0           my $commenthashkeysInt=0;
785 0           while (defined($commenthashkeys[ $commenthashkeysInt ])) {
786 0           $zml->addComment(
787             $varhashkeys[$varhashkeysInt],
788             $commenthashkeys[$commenthashkeysInt],
789             $self->{comment}{ $config }{ $varhashkeys[$varhashkeysInt] }{ $commenthashkeys[$commenthashkeysInt] }
790             );
791            
792 0           $commenthashkeysInt++;
793             }
794              
795 0           $varhashkeysInt++;
796             }
797              
798 0           return $zml;
799             }
800              
801             =head2 getAutoupdate
802              
803             This gets if a config should be automatically updated or not.
804              
805             One arguement is required and it is the config. If this is undefined
806             or a matching one is not found, the global is used.
807              
808             The return value is a boolean.
809              
810             #fetches the global
811             my $autoupdate=$zconf->getAutoupdate();
812              
813             #fetches it for 'some/config'
814             my $autoupdate=$zconf->getAutoupdate('some/config');
815              
816             =cut
817              
818             sub getAutoupdate{
819 0     0 1   my $self=$_[0];
820 0           my $config=$_[1];
821              
822 0           $self->errorblank;
823              
824 0 0         if (!defined( $config )) {
825 0           return $self->{autoupdateGlobal};
826             }
827              
828 0 0         if (defined( $self->{autoupdate}{$config} )) {
829 0           return $self->{autoupdate}{$config};
830             }
831              
832 0           return $self->{autoupdateGlobal};
833             }
834              
835             =head2 getAvailableSets
836              
837             This gets the available sets for a config.
838              
839             The only arguement is the name of the configuration in question.
840              
841             my @sets = $zconf->getAvailableSets("foo/bar");
842             if($zconf->error){
843             warn('error: '.$zconf->error.":".$zconf->errorString);
844             }
845              
846             =cut
847              
848             #the overarching method for getting available sets
849             sub getAvailableSets{
850 0     0 1   my ($self, $config) = @_;
851              
852 0           $self->errorblank;
853              
854             #make sure the config name is legit
855 0           my ($error, $errorString)=$self->configNameCheck($config);
856 0 0         if(defined($error)){
857 0           $self->{error}=$error;
858 0           $self->{errorString}=$errorString;
859 0           $self->warn;
860 0           return undef;
861             }
862              
863             #checks to make sure the config does exist
864 0 0         if(!$self->configExists($config)){
865 0           $self->{error}=12;
866 0           $self->{errorString}="'".$config."' does not exist.";
867 0           $self->warn;
868 0           return undef;
869             }
870              
871             #run the checks
872 0           my @returned=$self->{be}->getAvailableSets($config);
873             #if it errors and read fall through is turned on, try the file backend
874 0 0 0       if ( $self->{be}->error &&
    0 0        
875             $self->{args}{readfallthrough} &&
876             defined( $self->{fbe} )
877             ) {
878 0           @returned=$self->{fbe}->getAvailableSets($config);
879 0 0         if ( $self->{fbe}->error ) {
880 0           $self->{error}=11;
881 0           $self->{errorString}='Backend errored. error="'.$self->{fbe}->error.'" errorString="'.$self->{fbe}->errorString.'"';
882 0           $self->warn;
883             }
884             }elsif ( $self->{be}->error ) {
885 0           $self->{error}=11;
886 0           $self->{errorString}='Backend errored. error="'.$self->{be}->error.'" errorString="'.$self->{be}->errorString.'"';
887 0           $self->warn;
888             }
889              
890 0           return @returned;
891             }
892              
893             =head2 getDefault
894              
895             This gets the default set currently being used if one is not choosen.
896              
897             my $defaultSet = $zml->getDefault();
898              
899             =cut
900            
901             #gets what the default set is
902             sub getDefault{
903 0     0 1   my ($self)= @_;
904              
905 0           $self->errorblank;
906              
907 0           return $self->{args}{default};
908             }
909              
910             =head2 getComments
911              
912             This gets a list of variables that have comments.
913              
914             my @keys = $zconf->getComments("foo/bar")
915             if($zconf->error){
916             print 'error: '.$zconf->error."\n".$zconf->errorString."\n";
917             }
918              
919             =cut
920              
921             #get a list of keys for a config
922             sub getComments {
923 0     0 1   my ($self, $config) = @_;
924              
925 0           $self->errorblank;
926              
927             #update if if needed
928 0           $self->updateIfNeeded({config=>$config, clearerror=>1, autocheck=>1});
929              
930 0 0         if(!defined($self->{comment}{$config})){
931 0           $self->{error}=26;
932 0           $self->{errorString}="Config '".$config."' is not loaded.";
933 0           $self->warn;
934 0           return undef;
935             }
936              
937 0           my @keys=keys(%{$self->{comment}{$config}});
  0            
938              
939 0           return @keys;
940             }
941              
942             =head2 getConfigRevision
943              
944             This fetches the revision for the speified config.
945              
946             my $revision=$zconf->getConfigRevision('some/config');
947             if($zconf->error){
948             warn('error: '.$zconf->error.":".$zconf->errorString);
949             }
950              
951             =cut
952              
953             sub getConfigRevision{
954 0     0 1   my $self=$_[0];
955 0           my $config=$_[1];
956              
957 0           $self->errorblank;
958              
959             #return false if the config is not set
960 0 0         if (!defined($config)){
961 0           $self->{error}=25;
962 0           $self->{errorString}='No config specified';
963 0           $self->warn;
964 0           return undef;
965             }
966              
967             #checks to make sure the config does exist
968 0 0         if(!$self->configExists($config)){
969 0           $self->{error}=12;
970 0           $self->{errorString}="'".$config."' does not exist.";
971 0           $self->warn;
972 0           return undef;
973             }
974              
975             #run the checks
976 0           my $returned=$self->{be}->getConfigRevision($config);
977             #if it errors and read fall through is turned on, try the file backend
978 0 0 0       if ( $self->{be}->error &&
    0 0        
979             $self->{args}{readfallthrough} &&
980             defined( $self->{fbe} )
981             ) {
982 0           $returned=$self->{fbe}->getConfigRevision($config);
983 0 0         if ( $self->{fbe}->error ) {
984 0           $self->{error}=11;
985 0           $self->{errorString}='Backend errored. error="'.$self->{fbe}->error.'" errorString="'.$self->{fbe}->errorString.'"';
986 0           $self->warn;
987             }
988             }elsif ( $self->{be}->error ) {
989 0           $self->{error}=11;
990 0           $self->{errorString}='Backend errored. error="'.$self->{be}->error.'" errorString="'.$self->{be}->errorString.'"';
991 0           $self->warn;
992             }
993              
994 0           return $returned;
995             }
996              
997             =head2 getCtime
998              
999             This fetches the mtime for a variable.
1000              
1001             Two arguements are required. The first is the config
1002             and the second is the variable.
1003              
1004             The returned value is UNIX time value for when it was last
1005             changed. If it is undef, it means the variable has not been
1006             changed since ZConf 2.0.0 came out.
1007              
1008             my $time=$zconf->getMtime('some/config', 'some/var');
1009             if($zconf->error){
1010             warn('error: '.$zconf->error.":".$zconf->errorString);
1011             }
1012             if(defined($time)){
1013             print "variable modified at".$time." seconds past 1970-01-01.\n";
1014             }else{
1015             print "variable not modifined since ZConf 2.0.0 came out.\n";
1016             }
1017              
1018             =cut
1019              
1020             sub getCtime{
1021 0     0 1   my $self=$_[0];
1022 0           my $config=$_[1];
1023 0           my $var=$_[2];
1024              
1025 0           $self->errorblank;
1026              
1027             #update if if needed
1028 0           $self->updateIfNeeded({config=>$config, clearerror=>1, autocheck=>1 });
1029              
1030             #return false if the config is not set
1031 0 0         if (!defined($config)){
1032 0           $self->{error}=25;
1033 0           $self->{errorString}='$config not defined';
1034 0           $self->warn;
1035 0           return undef;
1036             }
1037              
1038             #makes sure it is loaded
1039 0 0         if ( ! $self->isConfigLoaded($config) ) {
1040 0           $self->{error}=26;
1041 0           $self->{errorString}="Config '".$config."' is not loaded.";
1042 0           $self->warn;
1043 0           return undef;
1044             }
1045              
1046             #no metas for this var
1047 0 0         if (!defined( $self->{meta}{$config}{$var} )) {
1048 0           return undef;
1049             }
1050              
1051 0 0         if (!defined( $self->{meta}{$config}{$var}{'ctime'} )) {
1052 0           return undef;
1053             }
1054              
1055 0           return $self->{meta}{$config}{$var}{'ctime'};
1056             }
1057              
1058             =head2 getKeys
1059              
1060             This gets gets the keys for a loaded config.
1061              
1062             my @keys = $zconf->getKeys("foo/bar")
1063             if($zconf->error){
1064             warn('error: '.$zconf->error.":".$zconf->errorString);
1065             }
1066              
1067             =cut
1068              
1069             #get a list of keys for a config
1070             sub getKeys {
1071 0     0 1   my ($self, $config) = @_;
1072              
1073 0           $self->errorblank;
1074              
1075             #update if if needed
1076 0           $self->updateIfNeeded({config=>$config, clearerror=>1, autocheck=>1 });
1077              
1078             #makes sure it is loaded
1079 0 0         if ( ! $self->isConfigLoaded($config) ) {
1080 0           $self->{error}=26;
1081 0           $self->{errorString}="Config '".$config."' is not loaded.";
1082 0           $self->warn;
1083 0           return undef;
1084             }
1085              
1086 0           my @keys=keys(%{$self->{conf}{$config}});
  0            
1087              
1088 0           return @keys;
1089             }
1090              
1091             =head2 getLoadedConfigRevision
1092              
1093             This gets the revision of the specified config,
1094             if it is loaded.
1095              
1096             my $rev=$zconf->getLoadedConfigRevision;
1097             if($zconf->error){
1098             warn('error: '.$zconf->error.":".$zconf->errorString);
1099             }
1100              
1101             =cut
1102              
1103             sub getLoadedConfigRevision{
1104 0     0 1   my $self=$_[0];
1105 0           my $config=$_[1];
1106              
1107 0           $self->errorblank;
1108              
1109             #return false if the config is not set
1110 0 0         if (!defined($config)){
1111 0           $self->{error}=25;
1112 0           $self->{errorString}='No config specified';
1113 0           $self->warn;
1114 0           return undef;
1115             }
1116              
1117             #make sure it is loaded
1118 0 0         if(! $self->isConfigLoaded($config) ){
1119 0           $self->{error}=26;
1120 0           $self->{errorString}="Config '".$config."' is not loaded.";
1121 0           $self->warn;
1122 0           return undef;
1123             }
1124              
1125 0           return $self->{revision}{$config};
1126             }
1127              
1128             =head2 getLoadedConfigs
1129              
1130             This gets gets the keys for a loaded config.
1131              
1132             my @configs = $zconf->getLoadedConfigs("foo/bar")
1133             if($zconf->error){
1134             warn('error: '.$zconf->error.":".$zconf->errorString);
1135             }
1136              
1137             =cut
1138              
1139             #get a list loaded configs
1140             sub getLoadedConfigs {
1141 0     0 1   my ($self, $config) = @_;
1142              
1143 0           $self->errorblank;
1144              
1145 0           my @keys=keys(%{$self->{conf}});
  0            
1146              
1147 0           return @keys;
1148             }
1149              
1150             =head2 getMetas
1151              
1152             This gets a list of variables that have meta
1153             variables.
1154              
1155             my @keys = $zconf->getComments("foo/bar")
1156             if($zconf->error){
1157             warn('error: '.$zconf->error.":".$zconf->errorString);
1158             }
1159              
1160             =cut
1161              
1162             #get a list of keys for a config
1163             sub getMetas {
1164 0     0 1   my ($self, $config) = @_;
1165              
1166 0           $self->errorblank;
1167              
1168             #update if if needed
1169 0           $self->updateIfNeeded({config=>$config, clearerror=>1, autocheck=>1 });
1170              
1171 0 0         if ( ! $self->isConfigLoaded($config) ) {
1172 0           $self->{error}=26;
1173 0           $self->{errorString}="Config '".$config."' is not loaded.";
1174 0           $self->warn;
1175 0           return undef;
1176             }
1177              
1178 0           my @keys=keys(%{$self->{meta}{$config}});
  0            
1179              
1180 0           return @keys;
1181             }
1182              
1183             =head2 getMtime
1184              
1185             This fetches the mtime for a variable.
1186              
1187             Two arguements are required. The first is the config
1188             and the second is the variable.
1189              
1190             The returned value is UNIX time value for when it was last
1191             changed. If it is undef, it means the variable has not been
1192             changed since ZConf 2.0.0 came out.
1193              
1194             my $time=$zconf->getMtime('some/config', 'some/var');
1195             if($zconf->error){
1196             warn('error: '.$zconf->error.":".$zconf->errorString);
1197             }
1198             if(defined($time)){
1199             print "variable modified at".$time." seconds past 1970-01-01.\n";
1200             }else{
1201             print "variable not modifined since ZConf 2.0.0 came out.\n";
1202             }
1203              
1204             =cut
1205              
1206             sub getMtime{
1207 0     0 1   my $self=$_[0];
1208 0           my $config=$_[1];
1209 0           my $var=$_[2];
1210              
1211 0           $self->errorblank;
1212              
1213             #update if if needed
1214 0           $self->updateIfNeeded({config=>$config, clearerror=>1, autocheck=>1 });
1215              
1216             #return false if the config is not set
1217 0 0         if (!defined($config)){
1218 0           $self->{error}=25;
1219 0           $self->{errorString}='$config not defined';
1220 0           $self->warn;
1221 0           return undef;
1222             }
1223              
1224             #makes sure it is loaded
1225 0 0         if ( ! $self->isConfigLoaded($config) ) {
1226 0           $self->{error}=26;
1227 0           $self->{errorString}="Config '".$config."' is not loaded.";
1228 0           $self->warn;
1229 0           return undef;
1230             }
1231              
1232             #no metas for this var
1233 0 0         if (!defined( $self->{meta}{$config}{$var} )) {
1234 0           return undef;
1235             }
1236              
1237 0 0         if (!defined( $self->{meta}{$config}{$var}{'mtime'} )) {
1238 0           return undef;
1239             }
1240              
1241 0           return $self->{meta}{$config}{$var}{'mtime'};
1242             }
1243              
1244             =head2 getOverrideChooser
1245              
1246             This will get the current override chooser for a config.
1247              
1248             If no chooser is specified for the loaded config
1249              
1250             One arguement is required it is the name of the config.
1251              
1252             This method is basically a wrapper around regexMetaGet.
1253              
1254             my $orchooser=$zconf->getOverrideChooser($config);
1255             if($zconf->error){
1256             warn('error: '.$zconf->error.":".$zconf->errorString);
1257             }
1258              
1259             =cut
1260              
1261             sub getOverrideChooser{
1262 0     0 1   my $self=$_[0];
1263 0           my $config=$_[1];
1264              
1265             #blank the any previous errors
1266 0           $self->errorblank;
1267              
1268             #return false if the config is not set
1269 0 0         if (!defined($config)){
1270 0           $self->{error}=25;
1271 0           $self->{errorString}='$config not defined';
1272 0           return undef;
1273             }
1274              
1275             #makes sure it is loaded
1276 0 0         if ( ! $self->isConfigLoaded($config) ) {
1277 0           $self->{error}=26;
1278 0           $self->{errorString}="Config '".$config."' is not loaded.";
1279 0           $self->warn;
1280 0           return undef;
1281             }
1282              
1283 0           my $chooser;
1284              
1285 0 0 0       if ( (defined( $self->{meta}{$config}{zconf} ))&&(defined( $self->{meta}{$config}{zconf}{'override/chooser'} )) ) {
1286 0           $chooser=$self->{meta}{$config}{zconf}{'override/chooser'};
1287             }
1288              
1289 0           return $chooser;
1290             }
1291              
1292             =head2 getSet
1293              
1294             This gets the set for a loaded config.
1295              
1296             my $set = $zconf->getSet("foo/bar")
1297             if($zconf->error){
1298             warn('error: '.$zconf->error.":".$zconf->errorString);
1299             }
1300              
1301             =cut
1302              
1303             #get the set a config is currently using
1304             sub getSet{
1305 0     0 1   my ($self, $config)= @_;
1306              
1307 0           $self->errorblank;
1308              
1309 0 0         if ( ! defined( $config ) ){
1310 0           $self->{error}=25;
1311 0           $self->{errorString}='No config defined';
1312 0           $self->warn;
1313 0           return undef;
1314             }
1315              
1316 0 0         if(!defined($self->{set}{$config})){
1317 0           $self->{error}=26;
1318 0           $self->{errorString}="Set '".$config."' is not loaded.";
1319 0           $self->warn;
1320 0           return undef;
1321             }
1322            
1323 0           return $self->{set}{$config};
1324             }
1325              
1326             =head2 getSubConfigs
1327              
1328             This gets any sub configs for a config. "" can be used to get a list of configs
1329             under the root.
1330              
1331             One arguement is accepted and that is the config to look under.
1332              
1333             #lets assume 'foo/bar' exists, this would return
1334             my @subConfigs=$zconf->getSubConfigs("foo");
1335             if($zconf->error){
1336             warn('error: '.$zconf->error.":".$zconf->errorString);
1337             }
1338              
1339             =cut
1340              
1341             #gets the configs under a config
1342             sub getSubConfigs{
1343 0     0 1   my ($self, $config)= @_;
1344              
1345             #blank any previous errors
1346 0           $self->errorblank;
1347              
1348             #make sure the config name is legit
1349 0           my ($error, $errorString)=$self->configNameCheck($config);
1350 0 0         if(defined($error)){
1351 0           $self->{error}=$error;
1352 0           $self->{errorString}=$errorString;
1353 0           $self->warn;
1354 0           return undef;
1355             }
1356              
1357             #run the checks
1358 0           my @returned=$self->{be}->getSubConfigs($config);
1359             #if it errors and read fall through is turned on, try the file backend
1360 0 0 0       if ( $self->{be}->error &&
    0 0        
1361             $self->{args}{readfallthrough} &&
1362             defined( $self->{fbe} )
1363             ) {
1364 0           @returned=$self->{fbe}->getSubConfigs($config);
1365 0 0         if ( $self->{fbe}->error ) {
1366 0           $self->{error}=11;
1367 0           $self->{errorString}='Backend errored. error="'.$self->{fbe}->error.'" errorString="'.$self->{fbe}->errorString.'"';
1368 0           $self->warn;
1369             }
1370             }
1371             elsif( $self->{be}->error ){
1372 0           $self->{error}=11;
1373 0           $self->{errorString}='Backend errored. error="'.$self->{be}->error.'" errorString="'.$self->{be}->errorString.'"';
1374 0           $self->warn;
1375             }
1376              
1377 0           return @returned;
1378             }
1379              
1380             =head2 getComment
1381              
1382             This requires three arguments.
1383              
1384             The first is the name of the config.
1385              
1386             The second is the variable.
1387              
1388             The third is the comment name.
1389              
1390             If the comment does not exist, undef is returned. It is also possible it errored, but
1391             a non-existant variable is not considered a error.
1392              
1393             my $value=$zconf->getVar($someConfig, $someVariable, $someComment);
1394             if($zconf->error){
1395             warn('error: '.$zconf->error.":".$zconf->errorString);
1396             }
1397             if(!defined($value)){
1398             print "'.$someVariable.' and/or '".$someComment."' does not exist\n";
1399             }
1400              
1401             =cut
1402              
1403             sub getComment{
1404 0     0 1   my ($self, $config, $var, $comment) = @_;
1405              
1406 0           $self->errorblank;
1407              
1408             #update if if needed
1409 0           $self->updateIfNeeded({config=>$config, clearerror=>1, autocheck=>1 });
1410              
1411             #return false if the config is not set
1412 0 0         if (!defined($config)){
1413 0           $self->{error}=25;
1414 0           $self->{errorString}='No config specified';
1415 0           $self->warn;
1416 0           return undef;
1417             }
1418              
1419             #makes sure it is loaded
1420 0 0         if ( ! $self->isConfigLoaded($config) ) {
1421 0           $self->{error}=26;
1422 0           $self->{errorString}="Config '".$config."' is not loaded.";
1423 0           $self->warn;
1424 0           return undef;
1425             }
1426              
1427             #make sure we have a variable
1428 0 0         if (!defined($var)) {
1429 0           $self->{error}=18;
1430 0           $self->{errorString}='No variable specified';
1431 0           $self->warn;
1432 0           return undef;
1433             }
1434              
1435             #makes sure we have a comment specified
1436 0 0         if (!defined($comment)) {
1437 0           $self->{error}=41;
1438 0           $self->{errorString}='No comment specified';
1439 0           $self->warn;
1440 0           return undef;
1441             }
1442              
1443             #make sure it exists
1444 0 0         if (!defined( $self->{comment}{$config}{$var} )) {
1445 0           return undef;
1446             }
1447 0 0         if (!defined( $self->{comment}{$config}{$var}{$comment} )) {
1448 0           return undef;
1449             }
1450              
1451 0           return $self->{comment}{$config}{$var}{$comment};
1452             }
1453              
1454             =head2 getMeta
1455              
1456             This requires three arguments.
1457              
1458             The first is the name of the config.
1459              
1460             The second is the variable.
1461              
1462             The third is the meta name.
1463              
1464             If the comment does not exist, undef is returned. It is also possible it errored, but
1465             a non-existant variable is not considered a error.
1466              
1467             my $value=$zconf->getVar($someConfig, $someVariable, $someMeta);
1468             if($zconf->error){
1469             warn('error: '.$zconf->error.":".$zconf->errorString);
1470             }
1471             if(!defined($value)){
1472             print "'.$someVariable.' and/or '".$someMeta."' does not exist\n";
1473             }
1474              
1475             =cut
1476              
1477             sub getMeta{
1478 0     0 1   my ($self, $config, $var, $meta) = @_;
1479              
1480 0           $self->errorblank;
1481              
1482             #update if if needed
1483 0           $self->updateIfNeeded({config=>$config, clearerror=>1, autocheck=>1 });
1484              
1485             #return false if the config is not set
1486 0 0         if (!defined($config)){
1487 0           $self->{error}=25;
1488 0           $self->{errorString}='No config specified';
1489 0           $self->warn;
1490 0           return undef;
1491             }
1492              
1493             #makes sure it is loaded
1494 0 0         if ( ! $self->isConfigLoaded($config) ) {
1495 0           $self->{error}=26;
1496 0           $self->{errorString}="Config '".$config."' is not loaded.";
1497 0           $self->warn;
1498 0           return undef;
1499             }
1500              
1501             #make sure we have a variable
1502 0 0         if (!defined($var)) {
1503 0           $self->{error}=18;
1504 0           $self->{errorString}='No variable specified';
1505 0           $self->warn;
1506 0           return undef;
1507             }
1508              
1509             #makes sure we have a meta specified
1510 0 0         if (!defined($meta)) {
1511 0           $self->{error}=42;
1512 0           $self->{errorString}='No meta specified';
1513 0           $self->warn;
1514 0           return undef;
1515             }
1516              
1517             #make sure it exists
1518 0 0         if (!defined( $self->{meta}{$config}{$var} )) {
1519 0           return undef;
1520             }
1521 0 0         if (!defined( $self->{meta}{$config}{$var}{$meta} )) {
1522 0           return undef;
1523             }
1524              
1525 0           return $self->{meta}{$config}{$var}{$meta};
1526             }
1527              
1528             =head2 getVar
1529              
1530             This reqyures two arguments.
1531              
1532             The first is the name of the config.
1533              
1534             The second is the variable.
1535              
1536             If the variable does not exist, undef is returned. It is also possible it errored, but
1537             a non-existant variable is not considered a error.
1538              
1539             my $value=$zconf->getVar($someConfig, $someVariable);
1540             if($zconf->error){
1541             warn('error: '.$zconf->error.":".$zconf->errorString);
1542             }
1543             if(!defined($value)){
1544             print "'.$someVariable.' does not exist\n";
1545             }
1546              
1547             =cut
1548              
1549             sub getVar{
1550 0     0 1   my ($self, $config, $var) = @_;
1551              
1552 0           $self->errorblank;
1553              
1554             #update if if needed
1555 0           $self->updateIfNeeded({config=>$config, clearerror=>1, autocheck=>1 });
1556              
1557             #return false if the config is not set
1558 0 0         if (!defined($config)){
1559 0           $self->{error}=25;
1560 0           $self->{errorString}='No config specified';
1561 0           $self->Warn;
1562 0           return undef;
1563             }
1564              
1565             #makes sure it is loaded
1566 0 0         if ( ! $self->isConfigLoaded($config) ) {
1567 0           $self->{error}=26;
1568 0           $self->{errorString}="Config '".$config."' is not loaded.";
1569 0           $self->warn;
1570 0           return undef;
1571             }
1572              
1573             #make sure we have a variable
1574 0 0         if (!defined($var)) {
1575 0           $self->{error}=18;
1576 0           $self->{errorString}='No variable specified';
1577 0           $self->warn;
1578 0           return undef;
1579             }
1580              
1581             #make sure it exists
1582 0 0         if (!defined( $self->{conf}{$config}{$var} )) {
1583 0           return undef;
1584             }
1585              
1586 0           return $self->{conf}{$config}{$var};
1587             }
1588              
1589             =head2 initBackend
1590              
1591             This initializes a backend.
1592              
1593             One arguement is required and it is the backend name.
1594              
1595             my $backend=$zconf->initBackend('file');
1596             if($zconf->error){
1597             warn('error: '.$zconf->error.":".$zconf->errorString);
1598             }else{
1599             if($backend->error){
1600             warn('backend error: '.$backend->error.":".$backend->errorString);
1601             }
1602             }
1603              
1604             =cut
1605              
1606             sub initBackend{
1607 0     0 1   my $self=$_[0];
1608 0           my $backend=$_[1];
1609              
1610 0           $self->errorblank;
1611              
1612 0 0         if (!defined( $backend )) {
1613 0           $self->{error}=15;
1614 0           $self->{errorString}='No backend specified';
1615 0           $self->warn;
1616 0           return undef;
1617             }
1618              
1619             #tries to load it
1620 0           my $torun='use ZConf::backends::'.$backend.
1621             '; $be=ZConf::backends::'.$backend.
1622             '->new( \%{ $self->{args} } );';
1623 0           my $be;
1624 0           eval($torun);
1625 0 0         if (!defined($be)) {
1626 0           $self->{error}=47;
1627 0           $self->{errorString}='Trying to initialize the backend failed. It returned undefined';
1628 0           $self->warn;
1629 0           return undef;
1630             }
1631              
1632 0           return $be;
1633             }
1634              
1635             =head2 isLoadedConfigLocked
1636              
1637             This returns if the loaded config is locked or not.
1638              
1639             Only one arguement is taken and that is the name of the config.
1640              
1641             my $returned=$zconf->isLoadedConfigLocked('some/config');
1642             if($zconf->error){
1643             warn('error: '.$zconf->error.":".$zconf->errorString);
1644             }
1645              
1646             =cut
1647              
1648             sub isLoadedConfigLocked{
1649 0     0 1   my $self=$_[0];
1650 0           my $config=$_[1];
1651              
1652 0           $self->errorblank;
1653              
1654             #return false if the config is not set
1655 0 0         if (!defined($config)){
1656 0           $self->{error}=25;
1657 0           $self->{errorString}='No config specified';
1658 0           $self->warn;
1659 0           return undef;
1660             }
1661              
1662             #make sure it is loaded
1663 0 0         if(! $self->isConfigLoaded( $config ) ){
1664 0           $self->{error}=26;
1665 0           $self->{errorString}="Config '".$config."' is not loaded.";
1666 0           $self->warn;
1667 0           return undef;
1668             }
1669              
1670 0 0         if (defined($self->{locked}{$config})) {
1671 0           return 1;
1672             }
1673              
1674 0           return undef;
1675             }
1676              
1677             =head2 isConfigLoaded
1678              
1679             This checks if a config or not.
1680              
1681             One argument is taken and that is if a config is loaded or not.
1682              
1683             $zconf->isConfigLoaded($config);
1684             if( $zconf->error ){
1685             warn('error: '.$zconf->error.":".$zconf->errorString);
1686             }
1687              
1688             =cut
1689              
1690             sub isConfigLoaded{
1691 0     0 1   my $self=$_[0];
1692 0           my $config=$_[1];
1693              
1694 0           $self->errorblank;
1695              
1696 0 0         if (!defined($config)) {
1697 0           $self->{error}=25;
1698 0           $self->{errorString}="Config is undefined";
1699 0           $self->warn;
1700 0           return undef;
1701             }
1702              
1703 0 0         if ( defined( $self->{conf}{ $config } ) ) {
1704 0           return 1;
1705             }
1706              
1707 0           return undef;
1708             }
1709              
1710             =head2 isConfigLocked
1711              
1712             This checks if a config is locked or not.
1713              
1714             One arguement is required and it is the name of the config.
1715              
1716             The returned value is a boolean value.
1717              
1718             my $locked=$zconf->isConfigLocked('some/config');
1719             if($zconf->error){
1720             warn('error: '.$zconf->error.":".$zconf->errorString);
1721             }
1722             if($locked){
1723             print "The config is locked\n";
1724             }
1725              
1726             =cut
1727              
1728             sub isConfigLocked{
1729 0     0 1   my $self=$_[0];
1730 0           my $config=$_[1];
1731              
1732 0           $self->errorblank;
1733              
1734             #return false if the config is not set
1735 0 0         if (!defined($config)){
1736 0           $self->{error}=25;
1737 0           $self->{errorString}='No config specified';
1738 0           $self->warn;
1739 0           return undef;
1740             }
1741              
1742             #makes sure it exists
1743 0           my $exists=$self->configExists($config);
1744 0 0         if ($self->{error}) {
1745 0           $self->warnString('configExists errored');
1746 0           return undef;
1747             }
1748 0 0         if (!$exists) {
1749 0           $self->{error}=12;
1750 0           $self->{errorString}='The config, "'.$config.'", does not exist';
1751 0           $self->warn;
1752 0           return undef;
1753             }
1754              
1755             #run the checks
1756 0           my $returned=$self->{be}->isConfigLocked($config);
1757             #if it errors and read fall through is turned on, try the file backend
1758 0 0 0       if ( $self->{be}->error &&
    0 0        
1759             $self->{args}{readfallthrough} &&
1760             defined( $self->{fbe} )
1761             ) {
1762 0           $returned=$self->{fbe}->isConfigLocked($config);
1763 0 0         if ( $self->{fbe}->error ) {
1764 0           $self->{error}=11;
1765 0           $self->{errorString}='Backend errored. error="'.$self->{fbe}->error.'" errorString="'.$self->{fbe}->errorString.'"';
1766 0           $self->warn;
1767             }
1768             }elsif ( $self->{be}->error ) {
1769 0           $self->{error}=11;
1770 0           $self->{errorString}='Backend errored. error="'.$self->{be}->error.'" errorString="'.$self->{be}->errorString.'"';
1771 0           $self->warn;
1772             }
1773              
1774 0           return $returned;
1775             }
1776              
1777             =head2 LDAPconnect
1778              
1779             This generates a Net::LDAP object based on the LDAP backend.
1780              
1781             my $ldap=$zconf->LDAPconnect();
1782             if($zconf->error){
1783             warn('error: '.$zconf->error.":".$zconf->errorString);
1784             }
1785              
1786             =cut
1787              
1788             sub LDAPconnect{
1789 0     0 1   my $self=$_[0];
1790              
1791 0           $self->errorblank;
1792              
1793 0           my $returned;
1794 0 0         if (ref( $self->{be} ) eq "ZConf::backends::ldap" ) {
1795 0           $returned=$self->{be}->LDAPconnect;
1796 0 0         if ($self->{be}->error) {
1797 0           $self->{error}=11;
1798 0           $self->{errorString}='Backend errored. error="'.$self->{be}->error.'" errorString="'.$self->{be}->errorString.'"';
1799 0           $self->warn;
1800             }
1801             }else {
1802 0           $self->{error}=13;
1803 0           $self->{errorString}='Backend is not "ZConf::backends::ldap"';
1804 0           $self->warn;
1805             }
1806              
1807 0           return $returned;
1808             }
1809              
1810             =head2 override
1811              
1812             This runs the overrides for a config.
1813              
1814             This overrides various variables in the config by
1815             running the chooser stored in '#!zconf=override/chooser'.
1816             If it fails, the profile 'default' is used.
1817              
1818             Once a profile name has been picked, everything under
1819             '#!zconf=override/profiles//' has
1820             /^override\/profiles\/\// removed and it is
1821             set as a regular variable.
1822              
1823             One arguement is taken and it is a hash.
1824              
1825             If a value of undef is returned, but no error is set, no
1826             '#!zconf=override/chooser' is not defined.
1827              
1828             This method does not invoke the method updateIfNeeded.
1829              
1830             =head3 args hash
1831              
1832             =head4 config
1833              
1834             This is the config to operate on.
1835              
1836             =head4 profile
1837              
1838             If this is not specified, the chooser stored
1839             in the meta is '#!zconf=override/chooser'.
1840              
1841             =cut
1842              
1843             sub override{
1844 0     0 1   my $self=$_[0];
1845 0           my %args;
1846 0 0         if (defined($_[1])) {
1847 0           %args=%{$_[1]};
  0            
1848             }
1849              
1850             #blank the any previous errors
1851 0           $self->errorblank;
1852              
1853             #update if if needed
1854             #commenting this out as of currently as it results in a infinite loop for the file backend
1855             #$self->updateIfNeeded({config=>$args{config}, clearerror=>1, autocheck=>1});
1856              
1857             #return false if the config is not set
1858 0 0         if (!defined($args{config})){
1859 0           $self->{error}=25;
1860 0           $self->{errorString}='$args{config} not defined';
1861 0           $self->warn;
1862 0           return undef;
1863             }
1864              
1865             #make sure the loaded config is not locked
1866 0 0         if (defined( $self->{locked}{ $args{config} } )) {
1867 0           $self->{error}=45;
1868 0           $self->{errorString}='The config "'.$args{config}.'" is locked';
1869 0           $self->warn;
1870 0           return undef;
1871             }
1872              
1873             #make sure the config is loaded
1874 0 0         if(!defined( $self->{conf}{ $args{config} } )){
1875 0           $self->{error}=26;
1876 0           $self->{errorString}="Config '".$args{config}."' is not loaded.";
1877 0           $self->warn;
1878 0           return undef;
1879             }
1880              
1881             #if no profile is given, get one
1882 0 0         if (!defined( $args{profile} )) {
1883 0 0 0       if ( (defined( $self->{meta}{$args{config}}{zconf} ))&&
1884             (defined( $self->{meta}{$args{config}}{zconf}{'override/chooser'} ))
1885             ) {
1886              
1887 0           my $chooser=$self->{meta}{$args{config}}{zconf}{'override/chooser'};
1888             #if the chooser is not blank, run it
1889 0 0         if ($chooser ne '') {
1890 0           my ($success, $choosen)=choose($chooser);
1891              
1892             #if no choosen name is returned, use 'default'
1893 0 0         if ($success) {
1894 0           $args{profile}=$choosen;
1895             }else {
1896 0           $args{profile}='default';
1897             }
1898             }else {
1899 0           $args{profile}='default';
1900             }
1901             }else {
1902             #none to process
1903 0           return undef;
1904             }
1905             }
1906              
1907             #make sure it is legit
1908 0 0         if (!$self->setNameLegit($args{profile})){
1909 0           $self->{error}=27;
1910 0           $self->{errorString}='"'.$args{profile}.'" is not a valid set name';
1911 0           $self->warn;
1912 0           return undef;
1913             }
1914              
1915             #
1916 0           my %metas=$self->regexMetaGet({
1917             config=>$args{config},
1918             varRegex=>'^zconf$',
1919             metaRegex=>'^override\/profiles\/'.quotemeta($args{profile}).'\/',
1920             });
1921              
1922             #this does definitely exist as it would have returned previously.
1923 0           my @keys=keys( %{ $metas{zconf} } );
  0            
1924              
1925             #processes each one
1926 0           my $int=0;
1927 0           while (defined( $keys[$int] )) {
1928 0           my $override=$keys[$int];
1929              
1930 0           my $remove='^override\/profiles\/'.quotemeta($args{profile}).'\/';
1931              
1932 0           $override=s/$override//g;
1933              
1934 0           $self->{conf}{$args{config}}{$override}=$self->{meta}{$args{config}}{'zconf'}{$keys[$int]};
1935              
1936 0           $int++;
1937             }
1938            
1939 0           return 1;
1940             }
1941              
1942             =head2 read
1943              
1944             This reads a config. The only accepted option is the config name.
1945              
1946             It takes one arguement, which is a hash.
1947              
1948             =head3 hash args
1949              
1950             =head4 config
1951              
1952             The config to load.
1953              
1954             =head4 override
1955              
1956             This specifies if override should be ran not.
1957              
1958             If this is not specified, it defaults to 1, true.
1959              
1960             =head4 set
1961              
1962             The set for that config to load.
1963              
1964             $zconf->read({config=>"foo/bar"})
1965             if($zconf->error){
1966             warn('error: '.$zconf->error.":".$zconf->errorString);
1967             }
1968              
1969             =cut
1970              
1971             #the overarching read
1972             sub read{
1973 0     0 1   my $self=$_[0];
1974 0           my %args=%{$_[1]};
  0            
1975              
1976 0           $self->errorblank;
1977              
1978             #return false if the config is not set
1979 0 0         if (!defined($args{config})){
1980 0           $self->{error}=25;
1981 0           $self->{errorString}='No config specified';
1982 0           $self->warn;
1983 0           return undef;
1984             }
1985              
1986             #make sure the config name is legit
1987 0           my ($error, $errorString)=$self->configNameCheck($args{config});
1988 0 0         if(defined($error)){
1989 0           $self->{error}=$error;
1990 0           $self->{errorString}=$errorString;
1991 0           $self->warn;
1992 0           return undef;
1993             }
1994              
1995             #checks to make sure the config does exist
1996 0 0         if(!$self->configExists($args{config})){
1997 0           $self->{error}=12;
1998 0           $self->{errorString}="'".$args{config}."' does not exist.";
1999 0           $self->warn;
2000 0           return undef;
2001             }
2002              
2003             #gets the set to use if not set
2004 0 0         if(!defined($args{set})){
2005 0           $args{set}=$self->chooseSet($args{config});
2006 0 0         if (defined($self->{error})) {
2007 0           $self->{error}='32';
2008 0           $self->{errorString}='Unable to choose a set';
2009 0           $self->warn;
2010 0           return undef;
2011             }
2012             }
2013              
2014             #reads the config
2015 0           my $returned=$self->{be}->read(\%args);
2016             #if it errors and read fall through is turned on, try the file backend
2017 0 0 0       if ( $self->{be}->error &&
    0 0        
2018             $self->{args}{readfallthrough} &&
2019             defined( $self->{fbe} )
2020             ) {
2021 0           $returned=$self->{fbe}->read(\%args);
2022 0 0         if ( $self->{fbe}->error ) {
2023 0           $self->{error}=11;
2024 0           $self->{errorString}='Backend errored. error="'.$self->{fbe}->error.'" errorString="'.$self->{fbe}->errorString.'"';
2025 0           $self->warn;
2026             }
2027             }elsif ( $self->{be}->error ) {
2028 0           $self->{error}=11;
2029 0           $self->{errorString}='Backend errored. error="'.$self->{be}->error.'" errorString="'.$self->{be}->errorString.'"';
2030 0           $self->warn;
2031             }
2032             #sync to the file backend
2033 0 0 0       if (
2034             defined( $self->{fbe} ) &&
2035             ( ! $self->{be}->error )
2036             ) {
2037 0           $self->{fbe}->writeSetFromLoadedConfig(\%args);
2038 0 0         if ($self->{fbe}->error) {
2039 0           $self->warnString('Failed to sync to the backend error='.$self->{fbe}->error.' errorString='.$self->{fbe}->errorString);
2040             }
2041             }
2042              
2043 0           return $returned;
2044             }
2045              
2046             =head2 readChooser
2047              
2048             This reads the chooser for a config. If no chooser is defined "" is returned.
2049              
2050             The name of the config is the only required arguement.
2051              
2052             my $chooser = $zconf->readChooser("foo/bar")
2053             if($zconf->error){
2054             warn('error: '.$zconf->error.":".$zconf->errorString);
2055             }
2056              
2057             =cut
2058              
2059             #the overarching readChooser
2060             #this gets the chooser for a the config
2061             sub readChooser{
2062 0     0 1   my ($self, $config)= @_;
2063              
2064 0           $self->errorblank;
2065              
2066             #return false if the config is not set
2067 0 0         if (!defined($config)){
2068 0           $self->{error}=25;
2069 0           $self->{errorString}='$config not defined';
2070 0           $self->warn;
2071 0           return undef;
2072             }
2073              
2074             #make sure the config name is legit
2075 0           my ($error, $errorString)=$self->configNameCheck($config);
2076 0 0         if(defined($error)){
2077 0           $self->{error}=$error;
2078 0           $self->{errorString}=$errorString;
2079 0           $self->warn;
2080 0           return undef;
2081             }
2082              
2083             #checks to make sure the config does exist
2084 0 0         if(!$self->configExists($config)){
2085 0           $self->{error}=12;
2086 0           $self->{errorString}="'".$config."' does not exist.";
2087 0           $self->warn;
2088 0           return undef;
2089             }
2090              
2091             #reads the chooser
2092 0           my $returned=$self->{be}->readChooser($config);
2093             #if it errors and read fall through is turned on, try the file backend
2094 0 0 0       if ( $self->{be}->error &&
    0 0        
2095             $self->{args}{readfallthrough} &&
2096             defined( $self->{fbe} )
2097             ) {
2098 0           $returned=$self->{fbe}->readChooser($config);
2099 0 0         if ( $self->{fbe}->error ) {
2100 0           $self->{error}=11;
2101 0           $self->{errorString}='Backend errored. error="'.$self->{fbe}->error.'" errorString="'.$self->{fbe}->errorString.'"';
2102 0           $self->warn;
2103             }
2104             }elsif ( $self->{be}->error ) {
2105 0           $self->{error}=11;
2106 0           $self->{errorString}='Backend errored. error="'.$self->{be}->error.'" errorString="'.$self->{be}->errorString.'"';
2107 0           $self->warn;
2108             }
2109             #sync to the file backend
2110 0 0 0       if (
2111             defined( $self->{fbe} ) &&
2112             ( ! $self->{be}->error )
2113             ) {
2114 0           $self->{fbe}->writeChooser($config, $returned);
2115 0 0         if ($self->{fbe}->error) {
2116 0           $self->warnString('Failed to sync to the backend error='.$self->{fbe}->error.' errorString='.$self->{fbe}->errorString);
2117             }
2118             }
2119              
2120 0           return $returned;
2121             }
2122              
2123             =head2 regexCommentDel
2124              
2125             This searches through the comments for variables in a loaded config for
2126             any that match the supplied regex and removes them.
2127              
2128             One arguement is taken and it is a hash.
2129              
2130             A hash of hash containing copies of the deleted variables are returned.
2131              
2132             =head3 args hash
2133              
2134             =head4 config
2135              
2136             This is the config search.
2137              
2138             =head4 varRegex
2139              
2140             The variable to search for matching comment names.
2141              
2142             =head4 commentRegex
2143              
2144             The regex use for matching comment names.
2145              
2146             my %deleted=$zconf->regexCommentDel({
2147             config=>"foo/bar",
2148             varRegex=>"^some/var$",
2149             commentRegex=>"^monkey\/";
2150             });
2151             if($zconf->error){
2152             warn('error: '.$zconf->error.":".$zconf->errorString);
2153             }
2154              
2155             =cut
2156              
2157             #removes variables based on a regex
2158             sub regexCommentDel{
2159 0     0 1   my $self=$_[0];
2160 0           my %args;
2161 0 0         if (defined($_[1])) {
2162 0           %args=%{$_[1]};
  0            
2163             }
2164              
2165 0           $self->errorblank;
2166              
2167             #update if if needed
2168 0           $self->updateIfNeeded({config=>$args{config}, clearerror=>1, autocheck=>1 });
2169              
2170             #return false if the config is not set
2171 0 0         if (!defined($args{config})){
2172 0           $self->{error}=25;
2173 0           $self->{errorString}='$config not defined';
2174 0           $self->warn;
2175 0           return undef;
2176             }
2177              
2178             #makes sure it is loaded
2179 0 0         if ( ! $self->isConfigLoaded($args{config}) ) {
2180 0           $self->{error}=26;
2181 0           $self->{errorString}="Config '".$args{config}."' is not loaded.";
2182 0           $self->warn;
2183 0           return undef;
2184             }
2185              
2186              
2187             #return false if the config is not set
2188 0 0         if (!defined($args{varRegex})){
2189 0           $self->{error}=18;
2190 0           $self->{errorString}='$args{varRegex} not defined';
2191 0           $self->warn;
2192 0           return undef;
2193             }
2194              
2195             #make sure the loaded config is not locked
2196 0 0         if (defined($self->{locked}{$args{config}})) {
2197 0           $self->{error}=45;
2198 0           $self->{errorString}='The config "'.$args{config}.'" is locked';
2199 0           $self->warn;
2200 0           return undef;
2201             }
2202              
2203 0           my @vars=keys(%{$self->{comment}{$args{config}}});
  0            
2204              
2205 0           my %returned;
2206              
2207             #run through checking it all
2208 0           my $varsInt=0;
2209 0           while(defined($vars[$varsInt])){
2210             #if the variable matches, it is ok
2211 0 0         if ($vars[$varsInt] =~ /$args{varRegex}/) {
2212 0           my @comments=keys(%{$self->{comment}{ $args{config} }{ $vars[$varsInt] }});
  0            
2213 0           my $commentsInt=0;
2214             #check the each meta
2215 0           while (defined($comments[$commentsInt])) {
2216             #remove any matches
2217 0 0         if ($self->{comment}{ $args{config} }{ $vars[$varsInt] }{ $comments[$commentsInt] } =~ /$args{commentRegex}/) {
2218             #copies the variable before it is deleted
2219 0 0         if (!defined( $returned{ $vars[$varsInt] } )) {
2220 0           $returned{ $vars[$varsInt] }={};
2221             }
2222 0           $returned{ $vars[$varsInt] }{ $comments[$commentsInt] }=
2223             $self->{comment}{ $args{config} }{ $vars[$varsInt] }{ $comments[$commentsInt] };
2224 0           delete($self->{comment}{ $args{config} }{ $vars[$varsInt] }{ $comments[$commentsInt] });
2225             }
2226            
2227 0           $commentsInt++;
2228             }
2229             }
2230              
2231 0           $varsInt++;
2232             }
2233              
2234 0           return %returned;
2235             }
2236              
2237             =head2 regexCommentGet
2238              
2239             This searches through the comments for variables in a loaded config for
2240             any that match the supplied regex and returns them.
2241              
2242             One arguement is taken and it is a hash.
2243              
2244             A hash of hash containing copies of the deleted variables are returned.
2245              
2246             =head3 args hash
2247              
2248             =head4 config
2249              
2250             This is the config search.
2251              
2252             =head4 varRegex
2253              
2254             The variable to search for matching comment names.
2255              
2256             =head4 commentRegex
2257              
2258             The regex use for matching comment names.
2259              
2260             my %deleted=$zconf->regexCommentGet({
2261             config=>"foo/bar",
2262             varRegex=>"^some/var$",
2263             commentRegex=>"^monkey\/";
2264             });
2265             if($zconf->error){
2266             warn('error: '.$zconf->error.":".$zconf->errorString);
2267             }
2268              
2269             =cut
2270              
2271             #removes variables based on a regex
2272             sub regexCommentGet{
2273 0     0 1   my $self=$_[0];
2274 0           my %args;
2275 0 0         if (defined($_[1])) {
2276 0           %args=%{$_[1]};
  0            
2277             }
2278              
2279 0           $self->errorblank;
2280              
2281             #update if if needed
2282 0           $self->updateIfNeeded({config=>$args{config}, clearerror=>1, autocheck=>1 });
2283              
2284             #return false if the config is not set
2285 0 0         if (!defined($args{config})) {
2286 0           $self->{error}=25;
2287 0           $self->{errorString}='$config not defined';
2288 0           $self->warn;
2289 0           return undef;
2290             }
2291              
2292             #makes sure it is loaded
2293 0 0         if ( ! $self->isConfigLoaded($args{config}) ) {
2294 0           $self->{error}=26;
2295 0           $self->{errorString}="Config '".$args{config}."' is not loaded.";
2296 0           $self->warn;
2297 0           return undef;
2298             }
2299              
2300             #return false if the config is not set
2301 0 0         if (!defined($args{varRegex})) {
2302 0           $self->{error}=18;
2303 0           $self->{errorString}='$args{varRegex} not defined';
2304 0           $self->warn;
2305 0           return undef;
2306             }
2307              
2308 0           my @vars=keys(%{$self->{comment}{$args{config}}});
  0            
2309              
2310 0           my %returned;
2311              
2312             #run through checking it all
2313 0           my $varsInt=0;
2314 0           while (defined($vars[$varsInt])) {
2315             #if the variable matches, it is ok
2316 0 0         if ($vars[$varsInt] =~ /$args{varRegex}/) {
2317 0           my @comments=keys(%{$self->{comment}{ $args{config} }{ $vars[$varsInt] }});
  0            
2318 0           my $commentsInt=0;
2319             #check the each meta
2320 0           while (defined($comments[$commentsInt])) {
2321             #remove any matches
2322 0 0         if ($self->{comment}{ $args{config} }{ $vars[$varsInt] }{ $comments[$commentsInt] } =~ /$args{commentRegex}/) {
2323             #adds it to the returned hash
2324 0 0         if (!defined( $returned{ $vars[$varsInt] } )) {
2325 0           $returned{ $vars[$varsInt] }={};
2326             }
2327 0           $returned{ $vars[$varsInt] }{ $comments[$commentsInt] }=
2328             $self->{comment}{ $args{config} }{ $vars[$varsInt] }{ $comments[$commentsInt] };
2329             }
2330            
2331 0           $commentsInt++;
2332             }
2333             }
2334              
2335 0           $varsInt++;
2336             }
2337              
2338 0           return %returned;
2339             }
2340              
2341             =head2 regexMetaDel
2342              
2343             This searches through the meta variables in a loaded config for any that match
2344             the supplied regex and removes them.
2345              
2346             One arguement is taken and it is a hash.
2347              
2348             A hash of hash containing copies of the deleted variables are returned.
2349              
2350             =head3 args hash
2351              
2352             =head4 config
2353              
2354             This is the config search.
2355              
2356             =head4 varRegex
2357              
2358             The variable to search for matching comment names.
2359              
2360             =head4 metaRegex
2361              
2362             The regex use for matching meta variables.
2363              
2364             my %deleted=$zconf->regexMetaDel({
2365             config=>"foo/bar",
2366             varRegex=>"^some/var$",
2367             metaRegex=>"^monkey\/";
2368             });
2369             if($zconf->error){
2370             warn('error: '.$zconf->error.":".$zconf->errorString);
2371             }
2372              
2373             =cut
2374              
2375             #removes variables based on a regex
2376             sub regexMetaDel{
2377 0     0 1   my $self=$_[0];
2378 0           my %args;
2379 0 0         if (defined($_[1])) {
2380 0           %args=%{$_[1]};
  0            
2381             }
2382              
2383 0           $self->errorblank;
2384              
2385             #update if if needed
2386 0           $self->updateIfNeeded({config=>$args{config}, clearerror=>1, autocheck=>1 });
2387              
2388             #return false if the config is not set
2389 0 0         if (!defined($args{config})){
2390 0           $self->{error}=25;
2391 0           $self->{errorString}='$config not defined';
2392 0           $self->warn;
2393 0           return undef;
2394             }
2395              
2396             #makes sure it is loaded
2397 0 0         if ( ! $self->isConfigLoaded($args{config}) ) {
2398 0           $self->{error}=26;
2399 0           $self->{errorString}="Config '".$args{config}."' is not loaded.";
2400 0           $self->warn;
2401 0           return undef;
2402             }
2403              
2404             #return false if the config is not set
2405 0 0         if (!defined($args{varRegex})){
2406 0           $self->{error}=18;
2407 0           $self->{errorString}='$args{varRegex} not defined';
2408 0           $self->warn;
2409 0           return undef;
2410             }
2411              
2412             #make sure the loaded config is not locked
2413 0 0         if (defined($self->{locked}{$args{config}})) {
2414 0           $self->{error}=45;
2415 0           $self->{errorString}='The config "'.$args{config}.'" is locked';
2416 0           $self->warn;
2417 0           return undef;
2418             }
2419              
2420 0           my @vars=keys(%{$self->{meta}{$args{config}}});
  0            
2421              
2422 0           my %returned;
2423              
2424             #run through checking it all
2425 0           my $varsInt=0;
2426 0           while(defined($vars[$varsInt])){
2427             #if the variable matches, it is ok
2428 0 0         if ($vars[$varsInt] =~ /$args{varRegex}/) {
2429 0           my @metas=keys(%{$self->{meta}{ $args{config} }{ $vars[$varsInt] }});
  0            
2430 0           my $metasInt=0;
2431             #check the each meta
2432 0           while (defined($metas[$metasInt])) {
2433             #remove any matches
2434 0 0         if ($self->{meta}{ $args{config} }{ $vars[$varsInt] }{ $metas[$metasInt] } =~ /$args{metaRegex}/) {
2435             #copies the variable before it is deleted
2436 0 0         if (!defined( $returned{ $vars[$varsInt] } )) {
2437 0           $returned{ $vars[$varsInt] }={};
2438             }
2439 0           $returned{ $vars[$varsInt] }{ $metas[$metasInt] }=
2440             $self->{meta}{ $args{config} }{ $vars[$varsInt] }{ $metas[$metasInt] };
2441 0           delete($self->{meta}{ $args{config} }{ $vars[$varsInt] }{ $metas[$metasInt] });
2442             }
2443            
2444 0           $metasInt++;
2445             }
2446             }
2447              
2448 0           $varsInt++;
2449             }
2450              
2451 0           return %returned;
2452             }
2453              
2454             =head2 regexMetaGet
2455              
2456             This searches through the meta variables in a loaded config for any that match
2457             the supplied regex and removes them.
2458              
2459             One arguement is taken and it is a hash.
2460              
2461             A hash of hash containing copies of the deleted variables are returned.
2462              
2463             =head3 args hash
2464              
2465             =head4 config
2466              
2467             This is the config search.
2468              
2469             =head4 varRegex
2470              
2471             The variable to search for matching comment names.
2472              
2473             =head4 metaRegex
2474              
2475             The regex use for matching meta variables.
2476              
2477             my %deleted=$zconf->regexMetaGet({
2478             config=>"foo/bar",
2479             varRegex=>"^some/var$",
2480             metaRegex=>"^monkey\/";
2481             });
2482             if($zconf->error){
2483             warn('error: '.$zconf->error.":".$zconf->errorString);
2484             }
2485              
2486             =cut
2487              
2488             #removes variables based on a regex
2489             sub regexMetaGet{
2490 0     0 1   my $self=$_[0];
2491 0           my %args;
2492 0 0         if (defined($_[1])) {
2493 0           %args=%{$_[1]};
  0            
2494             }
2495              
2496 0           $self->errorblank;
2497              
2498             #update if if needed
2499 0           $self->updateIfNeeded({config=>$args{config}, clearerror=>1, autocheck=>1 });
2500              
2501             #return false if the config is not set
2502 0 0         if (!defined($args{config})){
2503 0           $self->{error}=25;
2504 0           $self->{errorString}='$config not defined';
2505 0           $self->warn;
2506 0           return undef;
2507             }
2508              
2509             #makes sure it is loaded
2510 0 0         if ( ! $self->isConfigLoaded($args{config}) ) {
2511 0           $self->{error}=26;
2512 0           $self->{errorString}="Config '".$args{config}."' is not loaded.";
2513 0           $self->warn;
2514 0           return undef;
2515             }
2516              
2517             #return false if the config is not set
2518 0 0         if (!defined($args{varRegex})){
2519 0           $self->{error}=18;
2520 0           $self->{errorString}='$args{varRegex} not defined';
2521 0           $self->warn;
2522 0           return undef;
2523             }
2524              
2525 0           my @vars=keys(%{$self->{meta}{$args{config}}});
  0            
2526              
2527 0           my %returned;
2528              
2529             #run through checking it all
2530 0           my $varsInt=0;
2531 0           while(defined($vars[$varsInt])){
2532             #if the variable matches, it is ok
2533 0 0         if ($vars[$varsInt] =~ /$args{varRegex}/) {
2534 0           my @metas=keys(%{$self->{meta}{ $args{config} }{ $vars[$varsInt] }});
  0            
2535 0           my $metasInt=0;
2536             #check the each meta
2537 0           while (defined($metas[$metasInt])) {
2538             #add any matched
2539 0 0         if ($self->{meta}{ $args{config} }{ $vars[$varsInt] }{ $metas[$metasInt] } =~ /$args{metaRegex}/) {
2540             #copies the variable before it is deleted
2541 0 0         if (!defined( $returned{ $vars[$varsInt] } )) {
2542 0           $returned{ $vars[$varsInt] }={};
2543             }
2544 0           $returned{ $vars[$varsInt] }{ $metas[$metasInt] }=
2545             $self->{meta}{ $args{config} }{ $vars[$varsInt] }{ $metas[$metasInt] };
2546             }
2547            
2548 0           $metasInt++;
2549             }
2550             }
2551              
2552 0           $varsInt++;
2553             }
2554              
2555 0           return %returned;
2556             }
2557              
2558             =head2 regexVarDel
2559              
2560             This searches through the variables in a loaded config for any that match
2561             the supplied regex and removes them.
2562              
2563             Two arguements are required. The first is the config to search. The second
2564             is the regular expression to use.
2565              
2566             #removes any variable starting with the monkey
2567             my @deleted = $zconf->regexVarDel("foo/bar", "^monkey");
2568             if($zconf->error){
2569             warn('error: '.$zconf->error.":".$zconf->errorString);
2570             }
2571              
2572             =cut
2573              
2574             #removes variables based on a regex
2575             sub regexVarDel{
2576 0     0 1   my ($self, $config, $regex) = @_;
2577              
2578 0           $self->errorblank;
2579              
2580             #update if if needed
2581 0           $self->updateIfNeeded({config=>$config, clearerror=>1, autocheck=>1 });
2582              
2583             #return false if the config is not set
2584 0 0         if (!defined($config)){
2585 0           $self->{error}=25;
2586 0           $self->{errorString}='$config not defined';
2587 0           $self->warn;
2588 0           return undef;
2589             }
2590              
2591             #makes sure it is loaded
2592 0 0         if ( ! $self->isConfigLoaded($config) ) {
2593 0           $self->{error}=26;
2594 0           $self->{errorString}="Config '".$config."' is not loaded.";
2595 0           $self->warn;
2596 0           return undef;
2597             }
2598              
2599             #make sure the loaded config is not locked
2600 0 0         if (defined($self->{locked}{$config})) {
2601 0           $self->{error}=45;
2602 0           $self->{errorString}='The config "'.$config.'" is locked';
2603 0           $self->warn;
2604 0           return undef;
2605             }
2606              
2607 0           my @keys=keys(%{$self->{conf}{$config}});
  0            
2608              
2609 0           my @returnKeys=();
2610              
2611 0           my $int=0;
2612 0           while(defined($keys[$int])){
2613 0 0         if($keys[$int] =~ /$regex/){
2614 0           delete($self->{conf}{$config}{$keys[$int]});
2615 0           push(@returnKeys, $keys[$int]);
2616             }
2617              
2618 0           $int++;
2619             }
2620              
2621 0           return @returnKeys;
2622             }
2623              
2624             =head2 regexVarGet
2625              
2626             This searches through the variables in a loaded config for any that match
2627             the supplied regex and returns them in a hash.
2628              
2629             Two arguements are required. The first is the config to search. The second
2630             is the regular expression to use.
2631              
2632             #returns any variable begining with monkey
2633             my %vars = $zconf->regexVarGet("foo/bar", "^monkey");
2634             if($zconf->error){
2635             warn('error: '.$zconf->error.":".$zconf->errorString);
2636             }
2637              
2638             =cut
2639              
2640             #returns a hash of regex matched vars
2641             #return undef on error
2642             sub regexVarGet{
2643 0     0 1   my ($self, $config, $regex) = @_;
2644              
2645 0           $self->errorblank;
2646              
2647             #update if if needed
2648 0           $self->updateIfNeeded({config=>$config, clearerror=>1, autocheck=>1 });
2649              
2650             #return false if the config is not set
2651 0 0         if (!defined($config)){
2652 0           $self->{error}=25;
2653 0           $self->{errorString}='$config not defined';
2654 0           $self->warn;
2655 0           return undef;
2656             }
2657              
2658             #makes sure it is loaded
2659 0 0         if ( ! $self->isConfigLoaded($config) ) {
2660 0           $self->{error}=26;
2661 0           $self->{errorString}="Config '".$config."' is not loaded.";
2662 0           $self->warn;
2663 0           return undef;
2664             }
2665              
2666 0           my @keys=keys(%{$self->{conf}{$config}});
  0            
2667              
2668 0           my %returnKeys=();
2669              
2670 0           my $int=0;
2671 0           while(defined($keys[$int])){
2672 0 0         if($keys[$int] =~ /$regex/){
2673 0           $returnKeys{$keys[$int]}=$self->{conf}{$config}{$keys[$int]};
2674             }
2675            
2676 0           $int++;
2677             }
2678              
2679 0           return %returnKeys;
2680             }
2681              
2682             =head2 regexVarSearch
2683              
2684             This searches through the variables in a loaded config for any that match
2685             the supplied regex and returns a array of matches.
2686              
2687             Two arguements are required. The first is the config to search. The second
2688             is the regular expression to use.
2689              
2690             #removes any variable starting with the monkey
2691             my @matched = $zconf->regexVarSearch("foo/bar", "^monkey")
2692             if($zconf->error)){
2693             warn('error: '.$zconf->error.":".$zconf->errorString);
2694             }
2695              
2696             =cut
2697              
2698             #search variables based on a regex
2699             sub regexVarSearch{
2700 0     0 1   my ($self, $config, $regex) = @_;
2701              
2702 0           $self->errorblank;
2703              
2704             #update if if needed
2705 0           $self->updateIfNeeded({config=>$config, clearerror=>1, autocheck=>1 });
2706              
2707             #return false if the config is not set
2708 0 0         if (!defined($config)){
2709 0           $self->{error}=25;
2710 0           $self->{errorString}='$config not defined';
2711 0           $self->warn;
2712 0           return undef;
2713             }
2714              
2715             #makes sure it is loaded
2716 0 0         if ( ! $self->isConfigLoaded($config) ) {
2717 0           $self->{error}=26;
2718 0           $self->{errorString}="Config '".$config."' is not loaded.";
2719 0           $self->warn;
2720 0           return undef;
2721             }
2722              
2723 0           my @keys=keys(%{$self->{conf}{$config}});
  0            
2724              
2725 0           my @returnKeys=();
2726              
2727 0           my $int=0;
2728 0           while(defined($keys[$int])){
2729 0 0         if($keys[$int] =~ /$regex/){
2730 0           push(@returnKeys, $keys[$int]);
2731             }
2732            
2733 0           $int++;
2734             }
2735              
2736 0           return @returnKeys;
2737             }
2738              
2739             =head2 reread
2740              
2741             This rereads the specified config file. This requires it to be already
2742             loaded.
2743              
2744             $zconf->reread('some/config');
2745             if($zconf->error){
2746             warn('error: '.$zconf->error.":".$zconf->errorString);
2747             }
2748              
2749             =cut
2750              
2751             sub reread{
2752 0     0 1   my $self=$_[0];
2753 0           my $config=$_[1];
2754              
2755 0           $self->errorblank;
2756              
2757             #return false if the config is not set
2758 0 0         if (!defined($config)){
2759 0           $self->{error}=25;
2760 0           $self->{errorString}='$config not defined';
2761 0           $self->warn;
2762 0           return undef;
2763             }
2764              
2765             #makes sure it is loaded
2766 0 0         if ( ! $self->isConfigLoaded($config) ) {
2767 0           $self->{error}=26;
2768 0           $self->{errorString}="Config '".$config."' is not loaded.";
2769 0           $self->warn;
2770 0           return undef;
2771             }
2772              
2773             #gets the set
2774 0           my $set=$self->getSet($config);
2775 0 0         if ($self->{error}) {
2776 0           $self->warn('getSet errored');
2777 0           return undef;
2778             }
2779              
2780             #reread it
2781 0           $self->read({config=>$config, set=>$set});
2782 0 0         if ($self->{error}) {
2783 0           $self->warn('read errored');
2784 0           return undef;
2785             }
2786 0           return 1;
2787             }
2788              
2789             =head2 setAutoupdate
2790              
2791             This sets if a value for autoupdate.
2792              
2793             It takes two optional arguements. The first is a
2794             name for a config and second is a boolean value.
2795              
2796             If a config name is not specified, it sets the
2797             global value for it.
2798              
2799             #set the global auto update value to false
2800             $zconf->setAutoupdate(undef, '0');
2801              
2802             #sets it to true for 'some/config'
2803             $zconf->setAutoupdate('some/config', '1');
2804              
2805             =cut
2806              
2807             sub setAutoupdate{
2808 0     0 1   my $self=$_[0];
2809 0           my $config=$_[1];
2810 0           my $autoupdate=$_[2];
2811              
2812 0           $self->errorblank;
2813              
2814 0 0         if (!defined( $config )) {
2815 0           $self->{autoupdateGlobal}=$autoupdate;
2816             }
2817              
2818 0           $self->{autoupdate}{$config}=$autoupdate;
2819              
2820 0           return 1;
2821             }
2822              
2823             =head2 setComment
2824              
2825             This sets a comment variable in a loaded config.
2826              
2827             Four arguements are required. The first is the name of the config.
2828             The second is the name of the variable. The third is the comment
2829             variable. The fourth is the value.
2830              
2831             $zconf->setComment("foo/bar" , "somethingVar", "someComment", "eat more weazel\n\nor something"
2832             if($zconf->error){
2833             warn('error: '.$zconf->error.":".$zconf->errorString);
2834             }
2835              
2836              
2837             =cut
2838              
2839             #sets a comment
2840             sub setComment{
2841 0     0 1   my ($self, $config, $var, $comment, $value) = @_;
2842              
2843             #blank the any previous errors
2844 0           $self->errorblank;
2845              
2846             #update if if needed
2847 0           $self->updateIfNeeded({config=>$config, clearerror=>1, autocheck=>1 });
2848              
2849             #return false if the config is not set
2850 0 0         if (!defined($config)){
2851 0           $self->{error}=25;
2852 0           $self->{errorString}='$config not defined';
2853 0           $self->warn;
2854 0           return undef;
2855             }
2856              
2857             #make sure the loaded config is not locked
2858 0 0         if (defined($self->{locked}{$config})) {
2859 0           $self->{error}=45;
2860 0           $self->{errorString}='The config "'.$config.'" is locked';
2861 0           $self->warn;
2862 0           return undef;
2863             }
2864              
2865             #return false if the config is not set
2866 0 0         if (!defined($comment)){
2867 0           $self->{error}=41;
2868 0           $self->{errorString}='No comment name defined';
2869 0           $self->warn;
2870 0           return undef;
2871             }
2872              
2873             #make sure the config name is legit
2874 0           my ($error, $errorString)=$self->configNameCheck($config);
2875 0 0         if(defined($error)){
2876 0           $self->{error}=$error;
2877 0           $self->{errorString}=$errorString;
2878 0           $self->warn;
2879 0           return undef;
2880             }
2881              
2882             #make sure the config name is legit
2883 0           ($error, $errorString)=$self->varNameCheck($var);
2884 0 0         if(defined($error)){
2885 0           $self->{error}=$error;
2886 0           $self->{errorString}=$errorString;
2887 0           $self->warn;
2888 0           return undef;
2889             }
2890              
2891             #make sure the config name is legit
2892 0           ($error, $errorString)=$self->varNameCheck($comment);
2893 0 0         if(defined($error)){
2894 0           $self->{error}=$error;
2895 0           $self->{errorString}=$errorString;
2896 0           $self->warn;
2897 0           return undef;
2898             }
2899              
2900             #makes sure it is loaded
2901 0 0         if ( ! $self->isConfigLoaded($config) ) {
2902 0           $self->{error}=26;
2903 0           $self->{errorString}="Config '".$config."' is not loaded.";
2904 0           $self->warn;
2905 0           return undef;
2906             }
2907              
2908 0 0         if(!defined($self->{comment}{$config}{$var})){
2909 0           $self->{comment}{$config}{$var}={};
2910             }
2911              
2912 0           $self->{comment}{$config}{$var}{$comment}=$value;
2913              
2914 0           return 1;
2915             }
2916              
2917             =head2 setDefault
2918              
2919             This sets the default set to use if one is not specified or choosen.
2920              
2921             my $returned = $zconf->setDefault("something")
2922             if($zconf->error){
2923             warn('error: '.$zconf->error.":".$zconf->errorString);
2924             }
2925              
2926             =cut
2927            
2928             #sets the default set
2929             sub setDefault{
2930 0     0 1   my ($self, $set)= @_;
2931              
2932             #blank any errors
2933 0           $self->errorblank;
2934              
2935 0 0         if($self->setNameLegit($set)){
2936 0           $self->{args}{default}=$set;
2937             }else{
2938 0           $self->{error}=27;
2939 0           $self->{errorString}="'".$set."' is not a legit set name.";
2940 0           $self->warn;
2941             return undef
2942 0           }
2943              
2944 0           return 1;
2945             }
2946              
2947             =head2 setExists
2948              
2949             This checks if the specified set exists.
2950              
2951             Two arguements are required. The first arguement is the name of the config.
2952             The second arguement is the name of the set. If no set is specified, the default
2953             set is used. This is done by calling 'defaultSetExists'.
2954              
2955             my $return=$zconf->setExists("foo/bar", "fubar");
2956             if($zconf->error){
2957             warn('error: '.$zconf->error.":".$zconf->errorString);
2958             }else{
2959             if($return){
2960             print "It exists.\n";
2961             }
2962             }
2963              
2964             =cut
2965              
2966             sub setExists{
2967 0     0 1   my ($self, $config, $set)= @_;
2968              
2969             #blank any errors
2970 0           $self->errorblank;
2971              
2972             #this will get what set to use if it is not specified
2973 0 0         if (!defined($set)) {
2974 0           return $self->defaultSetExists($config);
2975 0 0         if ($self->{error}) {
2976 0           $self->warnString('No set specified and defaultSetExists errored');
2977 0           return undef;
2978             }
2979             }
2980              
2981             #We don't do any config name checking here or even if it exists as getAvailableSets
2982             #will do that.
2983              
2984 0           my @sets = $self->getAvailableSets($config);
2985 0 0         if (defined($self->{error})) {
2986 0           return undef;
2987             }
2988              
2989              
2990 0           my $setsInt=0;#used for intering through $sets
2991             #go through @sets and check for matches
2992 0           while (defined($sets[$setsInt])) {
2993             #return true if the current one matches
2994 0 0         if ($sets[$setsInt] eq $set) {
2995 0           return 1;
2996             }
2997              
2998 0           $setsInt++;
2999             }
3000              
3001             #if we get here, it means it was not found in the loop
3002 0           return undef;
3003             }
3004              
3005             =head2 setLockConfig
3006              
3007             This unlocks or logs a config.
3008              
3009             Two arguements are taken. The first is a
3010             the config name, required, and the second is
3011             if it should be locked or unlocked
3012              
3013             #lock 'some/config'
3014             $zconf->setLockConfig('some/config', 1);
3015             if($zconf->error){
3016             warn('error: '.$zconf->error.":".$zconf->errorString);
3017             }
3018              
3019             #unlock 'some/config'
3020             $zconf->setLockConfig('some/config', 0);
3021             if($zconf->error){
3022             warn('error: '.$zconf->error.":".$zconf->errorString);
3023             }
3024              
3025             #unlock 'some/config'
3026             $zconf->setLockConfig('some/config');
3027             if($zconf->error){
3028             warn('error: '.$zconf->error.":".$zconf->errorString);
3029             }
3030              
3031             =cut
3032              
3033             sub setLockConfig{
3034 0     0 1   my $self=$_[0];
3035 0           my $config=$_[1];
3036 0           my $lock=$_[2];
3037              
3038 0           $self->errorblank;
3039              
3040             #return false if the config is not set
3041 0 0         if (!defined($config)){
3042 0           $self->{error}=25;
3043 0           $self->{errorString}='No config specified';
3044 0           $self->warn;
3045 0           return undef;
3046             }
3047              
3048             #makes sure it exists
3049 0           my $exists=$self->configExists($config);
3050 0 0         if ($self->error) {
3051 0           warnSring('configExists errored');
3052 0           return undef;
3053             }
3054 0 0         if (!$exists) {
3055 0           $self->{error}=12;
3056 0           $self->{errorString}='The config, "'.$config.'", does not exist';
3057 0           $self->warn;
3058 0           return undef;
3059             }
3060              
3061             #reads the config
3062 0           my $returned=$self->{be}->setLockConfig($config, $lock);
3063             #if it errors and read fall through is turned on, try the file backend
3064 0 0         if ( $self->{be}->error ) {
3065 0           $self->{error}=11;
3066 0           $self->{errorString}='Backend errored. error="'.$self->{be}->error.'" errorString="'.$self->{be}->errorString.'"';
3067 0           $self->warn;
3068 0           return undef;
3069             }
3070             #sync to the file backend
3071 0 0         if ( defined( $self->{fbe} ) ) {
3072 0           $self->{fbe}->setLockConfig($config, $lock);
3073 0 0         if ($self->{fbe}->error) {
3074 0           $self->warnString('Failed to sync to the backend error='.$self->{fbe}->error.' errorString='.$self->{fbe}->errorString);
3075             }
3076             }
3077              
3078 0           return 1;
3079             }
3080              
3081             =head2 setMeta
3082              
3083             This sets a meta variable in a loaded config.
3084              
3085             Four arguements are required. The first is the name of the config.
3086             The second is the name of the variable. The third is the meta
3087             variable. The fourth is the value.
3088              
3089             $zconf->setMeta("foo/bar" , "somethingVar", "someComment", "eat more weazel\n\nor something"
3090             if($zconf->{error}){
3091             warn('error: '.$zconf->error.":".$zconf->errorString);
3092             }
3093              
3094              
3095             =cut
3096              
3097             #sets a comment
3098             sub setMeta{
3099 0     0 1   my ($self, $config, $var, $meta, $value) = @_;
3100              
3101             #blank the any previous errors
3102 0           $self->errorblank;
3103              
3104             #update if if needed
3105 0           $self->updateIfNeeded({config=>$config, clearerror=>1, autocheck=>1 });
3106              
3107             #return false if the config is not set
3108 0 0         if (!defined($config)){
3109 0           $self->{error}=25;
3110 0           $self->{errorString}='$config not defined';
3111 0           $self->warn;
3112 0           return undef;
3113             }
3114              
3115             #make sure the loaded config is not locked
3116 0 0         if (defined($self->{locked}{$config})) {
3117 0           $self->{error}=45;
3118 0           $self->{errorString}='The config "'.$config.'" is locked';
3119 0           $self->warn;
3120 0           return undef;
3121             }
3122              
3123             #return false if the config is not set
3124 0 0         if (!defined($meta)){
3125 0           $self->{error}=41;
3126 0           $self->{errorString}='No comment name defined';
3127 0           $self->warn;
3128 0           return undef;
3129             }
3130              
3131             #make sure the var name is legit
3132 0           my ($error, $errorString)=$self->varNameCheck($var);
3133 0 0         if(defined($error)){
3134 0           $self->{error}=$error;
3135 0           $self->{errorString}=$errorString;
3136 0           $self->warn;
3137 0           return undef;
3138             }
3139              
3140             #make sure the meta name is legit
3141 0           ($error, $errorString)=$self->varNameCheck($meta);
3142 0 0         if(defined($error)){
3143 0           $self->{error}=$error;
3144 0           $self->{errorString}=$errorString;
3145 0           $self->Warn;
3146 0           return undef;
3147             }
3148              
3149             #makes sure it is loaded
3150 0 0         if ( ! $self->isConfigLoaded($config) ) {
3151 0           $self->{error}=26;
3152 0           $self->{errorString}="Config '".$config."' is not loaded.";
3153 0           $self->warn;
3154 0           return undef;
3155             }
3156              
3157 0 0         if(!defined($self->{meta}{$config}{$var})){
3158 0           $self->{meta}{$config}{$var}={};
3159             }
3160              
3161 0           $self->{meta}{$config}{$var}{$meta}=$value;
3162              
3163 0           return 1;
3164             }
3165              
3166              
3167             =head2 setNameLegit
3168              
3169             This checks if a setname is legit.
3170              
3171             There is one required arguement, which is the set name.
3172              
3173             The returned value is a perl boolean value.
3174              
3175             my $set="something";
3176             if(!$zconf->setNameLegit($set)){
3177             warn('error: '.$zconf->error.":".$zconf->errorString);
3178             }
3179              
3180             =cut
3181              
3182             #checks the setnames to make sure they are legit.
3183             sub setNameLegit{
3184 0     0 1   my ($self, $set)= @_;
3185              
3186 0           $self->errorblank;
3187              
3188 0 0         if (!defined($set)){
3189 0           return undef;
3190             }
3191              
3192             #return false if it / is found
3193 0 0         if ($set =~ /\//){
3194 0           return undef;
3195             }
3196            
3197             #return undef if it begins with .
3198 0 0         if ($set =~ /^\./){
3199 0           return undef;
3200             }
3201              
3202             #return undef if it begins with " "
3203 0 0         if ($set =~ /^ /){
3204 0           return undef;
3205             }
3206              
3207             #return undef if it ends with " "
3208 0 0         if ($set =~ / $/){
3209 0           return undef;
3210             }
3211              
3212             #return undef if it contains ".."
3213 0 0         if ($set =~ /\.\./){
3214 0           return undef;
3215             }
3216              
3217 0           return 1;
3218             }
3219              
3220             =head2 setOverrideChooser
3221              
3222             This will set the override chooser for a config.
3223              
3224             If no chooser is specified for the loaded config
3225              
3226             Two arguements are required. The first is the config
3227             and th e second is the chooser string.
3228              
3229             This method is basically a wrapper around setMeta.
3230              
3231             $zconf->setOverrideChooser($config, $chooser);
3232             if($zconf->error){
3233             warn('error: '.$zconf->error.":".$zconf->errorString);
3234             }
3235              
3236             =cut
3237              
3238             sub setOverrideChooser{
3239 0     0 1   my $self=$_[0];
3240 0           my $config=$_[1];
3241 0           my $chooser=$_[2];
3242              
3243             #blank the any previous errors
3244 0           $self->errorblank;
3245              
3246             #return false if the config is not set
3247 0 0         if (!defined($config)){
3248 0           $self->{error}=25;
3249 0           $self->{errorString}='$config not defined';
3250 0           $self->warn;
3251 0           return undef;
3252             }
3253              
3254             #make sure the loaded config is not locked
3255 0 0         if (defined( $self->{locked}{ $config } )) {
3256 0           $self->{error}=45;
3257 0           $self->{errorString}='The config "'.$config.'" is locked';
3258 0           $self->warn;
3259 0           return undef;
3260             }
3261              
3262             #return false if the config is not set
3263 0 0         if (!defined($chooser)){
3264 0           $self->{error}=40;
3265 0           $self->{errorString}='$chooser not defined';
3266 0           $self->warn;
3267 0           return undef;
3268             }
3269              
3270             #makes sure it is loaded
3271 0 0         if ( ! $self->isConfigLoaded($config) ) {
3272 0           $self->{error}=26;
3273 0           $self->{errorString}="Config '".$config."' is not loaded.";
3274 0           $self->warn;
3275 0           return undef;
3276             }
3277              
3278             #make sure the loaded config is not locked
3279 0 0         if (defined( $self->{locked}{ $config } )) {
3280 0           $self->{error}=45;
3281 0           $self->{errorString}='The config "'.$config.'" is locked';
3282 0           $self->warn;
3283 0           return undef;
3284             }
3285              
3286 0 0         if (!defined( $self->{meta}{$config}{zconf} )){
3287 0           $self->{meta}{$config}{zconf}={};
3288             }
3289              
3290 0           $self->{meta}{$config}{zconf}{'override/chooser'}=$chooser;
3291              
3292 0           return 1;
3293             }
3294              
3295             =head2 setVar
3296              
3297             This sets a variable in a loaded config.
3298              
3299             Three arguements are required. The first is the name of the config.
3300             The second is the name of the variable. The third is the value.
3301              
3302             $zconf->setVar("foo/bar" , "something", "eat more weazel\n\nor something"
3303             if($zconf->error){
3304             warn('error: '.$zconf->error.":".$zconf->errorString);
3305             }
3306              
3307              
3308             =cut
3309              
3310             #sets a variable
3311             sub setVar{
3312 0     0 1   my ($self, $config, $var, $value) = @_;
3313              
3314             #blank the any previous errors
3315 0           $self->errorblank;
3316              
3317             #update if if needed
3318 0           $self->updateIfNeeded({config=>$config, clearerror=>1, autocheck=>1});
3319              
3320             #return false if the config is not set
3321 0 0         if (!defined($config)){
3322 0           $self->{error}=25;
3323 0           $self->{errorString}='$config not defined';
3324 0           $self->warn;
3325 0           return undef;
3326             }
3327              
3328             #make sure the loaded config is not locked
3329 0 0         if (defined($self->{locked}{$config})) {
3330 0           $self->{error}=45;
3331 0           $self->{errorString}='The config "'.$config.'" is locked';
3332 0           $self->warn;
3333 0           return undef;
3334             }
3335              
3336             #make sure the config name is legit
3337 0           my ($error, $errorString)=$self->varNameCheck($var);
3338 0 0         if(defined($error)){
3339 0           $self->{error}=$error;
3340 0           $self->{errorString}=$errorString;
3341 0           $self->warn;
3342 0           return undef;
3343             }
3344              
3345             #makes sure it is loaded
3346 0 0         if ( ! $self->isConfigLoaded($config) ) {
3347 0           $self->{error}=26;
3348 0           $self->{errorString}="Config '".$config."' is not loaded.";
3349 0           $self->warn;
3350 0           return undef;
3351             }
3352              
3353 0 0         if(!defined($var)){
3354 0           $self->{error}=18;
3355 0           $self->{errorString}="\$var is not defined.";
3356 0           $self->warn;
3357 0           return undef;
3358             }
3359              
3360 0           $self->{conf}{$config}{$var}=$value;
3361              
3362             #makes sure that the config var for it the meta info exists
3363 0 0         if (!defined( $self->{meta}{$config}{$var} )) {
3364 0           $self->{meta}{$config}{$var}={};
3365             }
3366             #set the mtime
3367 0           $self->{meta}{$config}{$var}{'mtime'}=time;
3368             #sets the ctime if needed
3369 0 0         if (!defined( $self->{meta}{$config}{$var}{'ctime'} )) {
3370 0           $self->{meta}{$config}{$var}{'ctime'}=time;
3371             }
3372              
3373              
3374 0           return 1;
3375             }
3376              
3377             =head2 unloadConfig
3378              
3379             Unloads a specified configuration. The only required value is the
3380             set name. The return value is a Perl boolean value.
3381              
3382             zconf->unloadConfig($config);
3383             if( $zconf->error )
3384             warn('error: '.$zconf->error.":".$zconf->errorString);
3385             }
3386              
3387             =cut
3388              
3389             sub unloadConfig{
3390 0     0 1   my $self=$_[0];
3391 0           my $config=$_[1];
3392              
3393 0           $self->errorblank;
3394              
3395             #return false if the config is not set
3396 0 0         if (!defined($config)){
3397 0           $self->{error}=25;
3398 0           $self->{errorString}='$config not defined';
3399 0           $self->warn;
3400 0           return undef;
3401             }
3402              
3403 0 0         if (!defined($self->{conf}{$config})){
3404 0           $self->{error}=26;
3405 0           $self->{errorString}='The specified config, ".$config.", is not loaded';
3406 0           $self->warn;
3407             #even if it is not defined, check to see if this is defined and remove it
3408 0 0         if (defined($self->{set}{$config})){
3409 0           delete($self->{set}{$config});
3410             }
3411 0           return undef;
3412             }else {
3413 0           delete($self->{conf}{$config});
3414             }
3415              
3416             #removes the loaded set information
3417 0 0         if (defined($self->{set}{$config})){
3418 0           delete($self->{set}{$config});
3419             }
3420              
3421             #remove any lock info
3422 0 0         if (defined($self->{locked}{$config})) {
3423 0           delete($self->{locked}{$config});
3424             }
3425              
3426             #remove any meta info
3427 0 0         if (defined($self->{meta}{$config})) {
3428 0           delete($self->{meta}{$config});
3429             }
3430              
3431             #remove any comment info
3432 0 0         if (defined($self->{comment}{$config})) {
3433 0           delete($self->{comment}{$config});
3434             }
3435              
3436             #remove any revision info
3437 0 0         if (defined($self->{revision}{$config})) {
3438 0           delete($self->{revision}{$config});
3439             }
3440              
3441 0           return 1;
3442             }
3443              
3444             =head2 updatable
3445              
3446             This checks if the loaded config on disk has a different revision ID than the
3447             saved one.
3448              
3449             The return value is a boolean value. A value of true indicates the config has
3450             been changed on the backend.
3451              
3452             my $updatable=$zconf->updatable('some/config');
3453             if($zconf->error){
3454             warn('error: '.$zconf->error.":".$zconf->errorString);
3455             }
3456              
3457             =cut
3458              
3459             sub updatable{
3460 0     0 1   my $self=$_[0];
3461 0           my $config=$_[1];
3462              
3463 0           $self->errorblank;
3464              
3465             #return false if the config is not set
3466 0 0         if (!defined($config)){
3467 0           $self->{error}=25;
3468 0           $self->{errorString}='No config specified';
3469 0           $self->warn;
3470 0           return undef;
3471             }
3472              
3473             #makes sure it is loaded
3474 0 0         if (! $self->isConfigLoaded($config) ) {
3475 0           $self->{error}=26;
3476 0           $self->{errorString}="Config '".$config."' is not loaded.";
3477 0           $self->warn;
3478 0           return undef;
3479             }
3480              
3481 0           my $backendRev=$self->getConfigRevision($config);
3482 0 0         if ($self->{error}) {
3483 0           $self->warnString('getConfigRevision failed');
3484 0           return undef;
3485             }
3486              
3487             #return false as if this is not defined, it means
3488             #that the config has no sets or has never been read
3489             #on a version of ZConf newer than 2.0.0
3490 0 0         if (!defined($backendRev)) {
3491 0           return undef;
3492             }
3493              
3494             #if we are here, it will no error so we don't check
3495 0           my $loadedRev=$self->getLoadedConfigRevision($config);
3496              
3497 0 0         if (!defined($loadedRev)) {
3498 0           $loadedRev='';
3499             }
3500              
3501             #they are not the same so a update is available
3502 0 0         if ($backendRev ne $loadedRev) {
3503 0           return 1;
3504             }
3505              
3506             #the are the same so no updates
3507 0           return undef;
3508             }
3509              
3510             =head2 updateIfNeeded
3511              
3512             If a loaded config is updatable, reread it.
3513              
3514             The returned value is a boolean value indicating
3515             if it was updated or not. A value of true indicates
3516             it was.
3517              
3518             =head3 args hash
3519              
3520             =head4 autocheck
3521              
3522             This tells it to check getAutoupdate. If it returns false,
3523             it will return.
3524              
3525             =head4 clearerror
3526              
3527             If $zconf->{error} is set, clear it. This is primarily
3528             meant for being used internally.
3529              
3530             =head4 config
3531              
3532             This config to check.
3533              
3534             This is required.
3535              
3536             my $updated=$zconf->updateIfNeeded({config=>'some/config'});
3537             if($zconf->{error}){
3538             warn('error: '.$zconf->error.":".$zconf->errorString);
3539             }
3540             if($updated){
3541             print "Updated!\n";
3542             }
3543              
3544             =cut
3545              
3546             sub updateIfNeeded{
3547 0     0 1   my $self=$_[0];
3548 0           my %args;
3549 0 0         if (defined($_[1])) {
3550 0           %args=%{$_[1]};
  0            
3551             }
3552              
3553 0           $self->errorblank;
3554              
3555             #return false if the config is not set
3556 0 0         if (!defined($args{config})){
3557 0           $self->{error}=25;
3558 0           $self->{errorString}='No config specified';
3559 0           $self->warn;
3560 0           return undef;
3561             }
3562              
3563             #makes sure it is loaded
3564 0 0         if ( ! $self->isConfigLoaded( $args{config}) ) {
3565 0           $self->{error}=26;
3566 0           $self->{errorString}="Config '".$args{config}."' is not loaded.";
3567 0           $self->warn;
3568 0           return undef;
3569             }
3570              
3571             #checks the value for autoupdate
3572 0 0         if ($args{autocheck}) {
3573 0           my $autoupdate=$self->getAutoupdate($args{config});
3574 0 0         if(!$autoupdate){
3575 0           return undef;
3576             }
3577             }
3578              
3579             #check if it is updatable
3580 0           my $updatable=$self->updatable($args{config});
3581 0 0         if ($self->error) {
3582 0           $self->warn('updatable errored');
3583 0           return undef;
3584             }
3585              
3586             #not updatable
3587 0 0         if (!$updatable) {
3588 0           return undef;
3589             }
3590              
3591             #reread it
3592 0           $self->reread($args{config});
3593 0 0         if ($self->error) {
3594 0           $self->warnString('reread errored');
3595             #clear the error if needed
3596 0 0         if ($args{clearerror}) {
3597 0           $self->errorblank;
3598             }
3599              
3600 0           return undef;
3601             }
3602              
3603 0           return 1;
3604             }
3605              
3606             =head2 varNameCheck
3607              
3608             This checks if a there if the specified variable name is a legit one or not.
3609              
3610             my ($error, $errorString) = $zconf->varNameCheck($config);
3611             if(defined($error)){
3612             warn('error: '.$zconf->error.":".$zconf->errorString);
3613             }
3614              
3615             =cut
3616              
3617             sub varNameCheck{
3618 0     0 1   my ($self, $name) = @_;
3619              
3620 0           $self->errorblank;
3621              
3622             #makes sure it is defined
3623 0 0         if (!defined($name)) {
3624 0           return('10', 'variable name is not defined');
3625             }
3626              
3627             #checks for ,
3628 0 0         if($name =~ /,/){
3629 0           return("0", "variavble name,'".$name."', contains ','");
3630             }
3631              
3632             #checks for /.
3633 0 0         if($name =~ /\/\./){
3634 0           return("1", "variavble name,'".$name."', contains '/.'");
3635             }
3636              
3637             #checks for //
3638 0 0         if($name =~ /\/\//){
3639 0           return("2", "variavble name,'".$name."', contains '//'");
3640             }
3641              
3642             #checks for ../
3643 0 0         if($name =~ /\.\.\//){
3644 0           return("3", "variavble name,'".$name."', contains '../'");
3645             }
3646              
3647             #checks for /..
3648 0 0         if($name =~ /\/\.\./){
3649 0           return("4", "variavble name,'".$name."', contains '/..'");
3650             }
3651              
3652             #checks for ^./
3653 0 0         if($name =~ /^\.\//){
3654 0           return("5", "variavble name,'".$name."', matched /^\.\//");
3655             }
3656              
3657             #checks for /$
3658 0 0         if($name =~ /\/$/){
3659 0           return("6", "variavble name,'".$name."', matched /\/$/");
3660             }
3661              
3662             #checks for ^/
3663 0 0         if($name =~ /^\//){
3664 0           return("7", "variavble name,'".$name."', matched /^\//");
3665             }
3666              
3667             #checks for \\n
3668 0 0         if($name =~ /\n/){
3669 0           return("8", "variavble name,'".$name."', matched /\\n/");
3670             }
3671              
3672             #checks for =
3673 0 0         if($name =~ /=/){
3674 0           return("9", "variavble name,'".$name."', matched /=/");
3675             }
3676              
3677 0           return(undef, "");
3678             }
3679              
3680             =head2 writeChooser
3681              
3682             This writes a string into the chooser for a config.
3683              
3684             There are two required arguements. The first is the
3685             config name. The second is chooser string.
3686              
3687             No error checking is done currently on the chooser string.
3688              
3689             Setting this to '' or "\n" will disable the chooser fuction
3690             and the default will be used when chooseSet is called.
3691              
3692             my $returned = $zconf->writeChooser("foo/bar", $chooserString)
3693             if($zconf->error){
3694             warn('error: '.$zconf->error.":".$zconf->errorString);
3695             }
3696              
3697             =cut
3698              
3699             #the overarching read
3700             sub writeChooser{
3701 0     0 1   my ($self, $config, $chooserstring)= @_;
3702              
3703 0           $self->errorblank;
3704              
3705             #return false if the config is not set
3706 0 0         if (!defined($config)){
3707 0           $self->{error}=25;
3708 0           $self->{errorString}='$config not defined';
3709 0           $self->warn;
3710 0           return undef;
3711             }
3712              
3713             #return false if the config is not set
3714 0 0         if (!defined($chooserstring)){
3715 0           $self->{error}=40;
3716 0           $self->{errorString}='\$chooserstring not defined';
3717 0           $self->warn;
3718 0           return undef;
3719             }
3720              
3721             #make sure the config name is legit
3722 0           my ($error, $errorString)=$self->configNameCheck($config);
3723 0 0         if(defined($error)){
3724 0           $self->{error}=$error;
3725 0           $self->{errorString}=$errorString;
3726 0           $self->warn;
3727 0           return undef;
3728             }
3729            
3730             #checks to make sure the config does exist
3731 0 0         if(!$self->configExists($config)){
3732 0           $self->{error}=12;
3733 0           $self->{errorString}="'".$config."' does not exist.";
3734 0           $self->warn;
3735 0           return undef;
3736             }
3737              
3738             #checks if it is locked or not
3739 0           my $locked=$self->isConfigLocked($config);
3740 0 0         if ($self->{error}) {
3741 0           $self->warnString('isconfigLocked errored');
3742 0           return undef;
3743             }
3744 0 0         if ($locked) {
3745 0           $self->{error}=45;
3746 0           $self->{errorString}='The config "'.$config.'" is locked';
3747 0           $self->warn;
3748 0           return undef;
3749             }
3750              
3751             #writes the chooser
3752 0           my $returned=$self->{be}->writeChooser($config, $chooserstring);
3753             #if it errors and read fall through is turned on, try the file backend
3754 0 0         if ( $self->{be}->error ) {
3755 0           $self->{error}=11;
3756 0           $self->{errorString}='Backend errored. error="'.$self->{be}->error.'" errorString="'.$self->{be}->errorString.'"';
3757 0           $self->warn;
3758 0           return undef;
3759             }
3760             #sync to the file backend
3761 0 0         if ( defined( $self->{fbe} ) ) {
3762 0           $self->{fbe}->writeChooser($config, $chooserstring);
3763 0 0         if ($self->{fbe}->error) {
3764 0           $self->warnString('Failed to sync to the backend error='.$self->{fbe}->error.' errorString='.$self->{fbe}->errorString);
3765             }
3766             }
3767              
3768 0           return 1;
3769             }
3770              
3771             =head2 writeSetFromHash
3772              
3773             This takes a hash and writes it to a config. It takes two arguements,
3774             both of which are hashes.
3775              
3776             The first hash contains
3777              
3778             The second hash is the hash to be written to the config.
3779              
3780             =head2 args hash
3781              
3782             =head3 config
3783              
3784             The config to write it to.
3785              
3786             This is required.
3787              
3788             =head3 set
3789              
3790             This is the set name to use.
3791              
3792             If not defined, the one will be choosen.
3793              
3794             =head3 revision
3795              
3796             This is the revision string to use.
3797              
3798             This is primarily meant for internal usage and is suggested
3799             that you don't touch this unless you really know what you
3800             are doing.
3801              
3802             $zconf->writeSetFromHash({config=>"foo/bar"}, \%hash);
3803             if($zconf->error){
3804             warn('error: '.$zconf->error.":".$zconf->errorString);
3805             }
3806              
3807             =cut
3808              
3809             #the overarching writeSetFromHash
3810             sub writeSetFromHash{
3811 0     0 1   my $self=$_[0];
3812 0           my %args=%{$_[1]};
  0            
3813 0           my %hash = %{$_[2]};
  0            
3814              
3815 0           $self->errorblank;
3816              
3817             #return false if the config is not set
3818 0 0         if (!defined($args{config})){
3819 0           $self->{error}=25;
3820 0           $self->{errorString}='$config not defined';
3821 0           $self->warn;
3822 0           return undef;
3823             }
3824              
3825             #make sure the config name is legit
3826 0           my ($error, $errorString)=$self->configNameCheck($args{config});
3827 0 0         if(defined($error)){
3828 0           $self->{error}=$error;
3829 0           $self->{errorString}=$errorString;
3830 0           $self->warn;
3831 0           return undef;
3832             }
3833            
3834             #checks to make sure the config does exist
3835 0 0         if(!$self->configExists($args{config})){
3836 0           $self->{error}=12;
3837 0           $self->{errorString}="'".$args{config}."' does not exist.";
3838 0           $self->warn;
3839 0           return undef;
3840             }
3841              
3842             #checks if it is locked or not
3843 0           my $locked=$self->isConfigLocked($args{config});
3844 0 0         if ($self->{error}) {
3845 0           $self->warnString('isconfigLocked errored');
3846 0           return undef;
3847             }
3848 0 0         if ($locked) {
3849 0           $self->{error}=45;
3850 0           $self->{errorString}='The config "'.$args{config}.'" is locked';
3851 0           $self->warn;
3852 0           return undef;
3853             }
3854              
3855             #sets the set to default if it is not defined
3856 0 0         if (!defined($args{set})){
3857 0           $args{set}=$self->{args}{default};
3858             }
3859              
3860             #update the revision if needed
3861 0 0         if (!defined($args{revision})) {
3862 0           $args{revision}=time.' '.hostname.' '.rand();
3863             }
3864              
3865             #writes the chooser
3866 0           my $returned=$self->{be}->writeSetFromHash(\%args, \%hash);
3867             #if it errors and read fall through is turned on, try the file backend
3868 0 0         if ( $self->{be}->error ) {
3869 0           $self->{error}=11;
3870 0           $self->{errorString}='Backend errored. error="'.$self->{be}->error.'" errorString="'.$self->{be}->errorString.'"';
3871 0           $self->warn;
3872 0           return undef;
3873             }
3874             #sync to the file backend
3875 0 0         if ( defined( $self->{fbe} ) ) {
3876 0           $self->{fbe}->writeSetFromHash(\%args, \%hash);
3877 0 0         if ($self->{fbe}->error) {
3878 0           $self->warnString('Failed to sync to the backend error='.$self->{fbe}->error.' errorString='.$self->{fbe}->errorString);
3879             }
3880             }
3881              
3882 0           return 1;
3883             }
3884              
3885             =head2 writeSetFromLoadedConfig
3886              
3887             This method writes a loaded config to a to a set.
3888              
3889             One arguement is required.
3890              
3891             =head2 args hash
3892              
3893             =head3 config
3894              
3895             The config to write it to.
3896              
3897             This is required.
3898              
3899             =head3 set
3900              
3901             This is the set name to use.
3902              
3903             If not defined, the one will be choosen.
3904              
3905             =head3 revision
3906              
3907             This is the revision string to use.
3908              
3909             This is primarily meant for internal usage and is suggested
3910             that you don't touch this unless you really know what you
3911             are doing.
3912              
3913             $zconf->writeSetFromLoadedConfig({config=>"foo/bar"});
3914             if($zconf->error){
3915             warn('error: '.$zconf->error.":".$zconf->errorString);
3916             }
3917              
3918             =cut
3919              
3920             #the overarching writeSetFromLoadedConfig
3921             sub writeSetFromLoadedConfig{
3922 0     0 1   my $self=$_[0];
3923 0           my %args= %{$_[1]};
  0            
3924              
3925 0           $self->errorblank;
3926              
3927             #return false if the config is not set
3928 0 0         if (!defined($args{config})){
3929 0           $self->{error}=25;
3930 0           $self->{errorString}='$config not defined';
3931 0           $self->warn;
3932 0           return undef;
3933             }
3934              
3935 0 0         if(! $self->isConfigLoaded( $args{config} ) ){
3936 0           $self->{error}=25;
3937 0           $self->{errorString}="Config '".$args{config}."' is not loaded";
3938 0           $self->warn;
3939 0           return undef;
3940             }
3941              
3942             #checks if it is locked or not
3943 0           my $locked=$self->isConfigLocked($args{config});
3944 0 0         if ($self->{error}) {
3945 0           $self->warnString('isconfigLocked errored');
3946 0           return undef;
3947             }
3948 0 0         if ($locked) {
3949 0           $self->{error}=45;
3950 0           $self->{errorString}='The config "'.$args{config}.'" is locked';
3951 0           $self->warn;
3952 0           return undef;
3953             }
3954              
3955             #sets the set to default if it is not defined
3956 0 0         if (!defined($args{set})){
3957 0           $args{set}=$self->{set}{$args{config}};
3958             }else{
3959 0 0         if($self->setNameLegit($args{set})){
3960 0           $self->{args}{default}=$args{set};
3961             }else{
3962 0           $self->{error}=27;
3963 0           $self->{errorString}="'".$args{set}."' is not a legit set name.";
3964 0           $self->warn;
3965             return undef
3966 0           }
3967             }
3968              
3969             #update the revision if needed
3970 0 0         if (!defined($args{revision})) {
3971 0           $args{revision}=time.' '.hostname.' '.rand();
3972             }
3973              
3974             #writes the chooser
3975 0           my $returned=$self->{be}->writeSetFromLoadedConfig(\%args);
3976             #if it errors and read fall through is turned on, try the file backend
3977 0 0         if ( $self->{be}->error ) {
3978 0           $self->{error}=11;
3979 0           $self->{errorString}='Backend errored. error="'.$self->{be}->error.'" errorString="'.$self->{be}->errorString.'"';
3980 0           $self->warn;
3981 0           return undef;
3982             }
3983             #sync to the file backend
3984 0 0         if ( defined( $self->{fbe} ) ) {
3985 0           $self->{fbe}->writeSetFromLoadedConfig(\%args);
3986 0 0         if ($self->{fbe}->error) {
3987 0           $self->warnString('Failed to sync to the backend error='.$self->{fbe}->error.' errorString='.$self->{fbe}->errorString);
3988             }
3989             }
3990              
3991 0           return 1;
3992             }
3993              
3994             =head2 writeSetFromZML
3995              
3996             This method writes a loaded config to a to a set.
3997              
3998             One arguement is required.
3999              
4000             =head2 args hash
4001              
4002             =head3 config
4003              
4004             The config to write it to.
4005              
4006             This is required.
4007              
4008             =head3 set
4009              
4010             This is the set name to use.
4011              
4012             If not defined, the one will be choosen.
4013              
4014             =head3 zml
4015              
4016             This is the ZML object to use.
4017              
4018             =head3 revision
4019              
4020             This is the revision string to use.
4021              
4022             This is primarily meant for internal usage and is suggested
4023             that you don't touch this unless you really know what you
4024             are doing.
4025              
4026             $zconf->writeSetFromZML({config=>"foo/bar", zml=>$zml});
4027             if($zconf->error){
4028             warn('error: '.$zconf->error.":".$zconf->errorString);
4029             }
4030              
4031             =cut
4032              
4033             #the overarching writeSetFromLoadedConfig
4034             sub writeSetFromZML{
4035 0     0 1   my $self=$_[0];
4036 0           my %args= %{$_[1]};
  0            
4037              
4038 0           $self->errorblank;
4039              
4040             #return false if the config is not set
4041 0 0         if (!defined($args{config})){
4042 0           $self->{error}=25;
4043 0           $self->{errorString}='$config not defined';
4044 0           $self->warn;
4045 0           return undef;
4046             }
4047              
4048             #makes sure ZML is passed
4049 0 0         if (!defined( $args{zml} )) {
4050 0           $self->{error}=16;
4051 0           $self->{errorString}='$args{zml} is not defined';
4052 0           $self->warn;
4053 0           return undef;
4054             }
4055 0 0         if ( ref($args{zml}) ne "ZML" ) {
4056 0           $self->{error}=16;
4057 0           $self->{errorString}='$args{zml} is not a ZML';
4058 0           $self->warn;
4059 0           return undef;
4060             }
4061              
4062             #checks if it is locked or not
4063 0           my $locked=$self->isConfigLocked($args{config});
4064 0 0         if ($self->{error}) {
4065 0           $self->warnString('isconfigLocked errored');
4066 0           return undef;
4067             }
4068 0 0         if ($locked) {
4069 0           $self->{error}=45;
4070 0           $self->{errorString}='The config "'.$args{config}.'" is locked';
4071 0           $self->warn;
4072 0           return undef;
4073             }
4074              
4075             #sets the set to default if it is not defined
4076 0 0         if (!defined($args{set})){
4077 0           $args{set}=$self->{set}{$args{config}};
4078             }else{
4079 0 0         if($self->setNameLegit($args{set})){
4080 0           $self->{args}{default}=$args{set};
4081             }else{
4082 0           $self->{error}=27;
4083 0           $self->{errorString}="'".$args{set}."' is not a legit set name.";
4084 0           $self->Warn;
4085             return undef
4086 0           }
4087             }
4088              
4089             #update the revision if needed
4090 0 0         if (!defined($args{revision})) {
4091 0           $args{revision}=time.' '.hostname.' '.rand();
4092             }
4093              
4094             #writes the chooser
4095 0           my $returned=$self->{be}->writeSetFromZML(\%args);
4096             #if it errors and read fall through is turned on, try the file backend
4097 0 0         if ( $self->{be}->error ) {
4098 0           $self->{error}=11;
4099 0           $self->{errorString}='Backend errored. error="'.$self->{be}->error.'" errorString="'.$self->{be}->errorString.'"';
4100 0           $self->warn;
4101 0           return undef;
4102             }
4103             #sync to the file backend
4104 0 0         if ( defined( $self->{fbe} ) ) {
4105 0           $self->{fbe}->writeSetFromZML(\%args);
4106 0 0         if ($self->{fbe}->error) {
4107 0           $self->warnString('Failed to sync to the backend error='.$self->{fbe}->error.' errorString='.$self->{fbe}->errorString);
4108             }
4109             }
4110              
4111 0           return 1;
4112             }
4113              
4114             =head1 CONFIG NAME
4115              
4116             Any configuration name is legit as long as it does not match any of the following.
4117              
4118             undef
4119             /./
4120             /\/\./
4121             /\.\.\//
4122             /\/\//
4123             /\.\.\//
4124             /\/\.\./
4125             /^\.\//
4126             /\/$/
4127             /^\//
4128             /\n/
4129              
4130             =head1 SET NAME
4131              
4132             Any set name is legit as long as it does not match any of the following.
4133              
4134             undef
4135             /\//
4136             /^\./
4137             /^ /
4138             / $/
4139             /\.\./
4140              
4141             =head1 VARIABLE NAME
4142              
4143             Any variable name is legit as long it does not match any of the following. This also
4144             covers comments and meta variables.
4145              
4146             /,/
4147             /\/\./
4148             /\/\//
4149             \.\.\//
4150             /\/\.\./
4151             /^\.\//
4152             /\/$/
4153             /^\//
4154             /\n/
4155             /=/
4156              
4157             =head1 ERROR HANDLING/CODES
4158              
4159             This module uses L for error handling. Below are the
4160             error codes returned by the error method.
4161              
4162             =head2 1
4163              
4164             config name contains ,
4165              
4166             =head2 2
4167              
4168             config name contains /.
4169              
4170             =head2 3
4171              
4172             config name contains //
4173              
4174             =head2 4
4175              
4176             config name contains ../
4177              
4178             =head2 5
4179              
4180             config name contains /..
4181              
4182             =head2 6
4183              
4184             config name contains ^./
4185              
4186             =head2 7
4187              
4188             config name ends in /
4189              
4190             =head2 8
4191              
4192             config name starts with /
4193              
4194             =head2 9
4195              
4196             could not sync to file
4197              
4198             =head2 10
4199              
4200             config name contains a \n
4201              
4202             =head2 11
4203              
4204             Backend errored.
4205              
4206             =head2 12
4207              
4208             config does not exist
4209              
4210             =head2 13
4211              
4212             Backend is not ZConf::backends::ldap.
4213              
4214             =head2 14
4215              
4216             The backend could not be found.
4217              
4218             =head2 15
4219              
4220             No backend specified.
4221              
4222             =head2 16
4223              
4224             ZML object not passed.
4225              
4226             =head2 18
4227              
4228             No variable name specified.
4229              
4230             =head2 19
4231              
4232             config key starts with a ' '
4233              
4234             =head2 21
4235              
4236             set not found for config
4237              
4238             =head2 23
4239              
4240             skilling variable as it is not a legit name
4241              
4242             =head2 24
4243              
4244             set is not defined
4245              
4246             =head2 25
4247              
4248             Config is undefined.
4249              
4250             =head2 26
4251              
4252             Config not loaded.
4253              
4254             =head2 27
4255              
4256             Set name is not a legit name.
4257              
4258             =head2 28
4259              
4260             ZML->parse error.
4261              
4262             =head2 29
4263              
4264             Could not unlink the unlink the set.
4265              
4266             =head2 30
4267              
4268             The sets exist for the specified config.
4269              
4270             =head2 31
4271              
4272             Did not find a matching set.
4273              
4274             =head2 32
4275              
4276             Unable to choose a set.
4277              
4278             =head2 33
4279              
4280             Unable to remove the config as it has sub configs.
4281              
4282             =head2 38
4283              
4284             Sys name matched /\//.
4285              
4286             =head2 39
4287              
4288             Sys name matched /\./.
4289              
4290             =head2 40
4291              
4292             No chooser string specified.
4293              
4294             =head2 41
4295              
4296             No comment specified.
4297              
4298             =head2 42
4299              
4300             No meta specified.
4301              
4302             =head2 45
4303              
4304             Config is locked.
4305              
4306             =head2 46
4307              
4308             LDAP entry update failed.
4309              
4310             =head2 47
4311              
4312             Failed to initialize the backend. It returned undef.
4313              
4314             =head1 ERROR CHECKING
4315              
4316             This can be done by checking $zconf->{error} to see if it is defined. If it is defined,
4317             The number it contains is the corresponding error code. A description of the error can also
4318             be found in $zconf->{errorString}, which is set to "" when there is no error.
4319              
4320             =head1 zconf.zml
4321              
4322             The default is 'xdf_config_home/zconf.zml', which is generally '~/.config/zconf.zml'. See perldoc
4323             ZML for more information on the file format. The keys are listed below.
4324              
4325             For information on the keys for the backends, please see perldoc for the backend in question.
4326              
4327             The two included are 'file' and 'ldap'. See perldoc for 'ZConf::backends::file' and
4328             'ZConf::backends::ldap' for their key values.
4329              
4330             =head2 zconf.zml keys
4331              
4332             =head3 backend
4333              
4334             This is the backend to use for storage. Current values of 'file' and 'ldap' are supported.
4335              
4336             =head3 backendChooser
4337              
4338             This is a Chooser string that chooses what backend should be used.
4339              
4340             =head3 defaultChooser
4341              
4342             This is a chooser string that chooses what the name of the default to use should be.
4343              
4344             =head3 fileonly
4345              
4346             This is a boolean value. If it is set to 1, only the file backend is used.
4347              
4348             This will override 'backend'.
4349              
4350             =head2 readfallthrough
4351              
4352             If this is set, if any of the methods below error when trying the any backend other than 'file'
4353             , it will fall through to the file backend.
4354              
4355             configExists
4356             getAvailableSets
4357             getSubConfigs
4358             read
4359             readChooser
4360              
4361             =head1 UTILITIES
4362              
4363             There are several scripts installed with this module. Please see the perldocs for
4364             the utilities listed below.
4365              
4366             zcchooser-edit
4367             zcchooser-get
4368             zcchooser-run
4369             zcchooser-set
4370             zccreate
4371             zcget
4372             zcls
4373             zcrm
4374             zcset
4375             zcvdel
4376             zcvls
4377              
4378             =head1 Backend Requirements
4379              
4380             Coming shortly.
4381              
4382             This will be documented more shortly.
4383              
4384             =head1 AUTHOR
4385              
4386             Zane C. Bowers-Hadley, C<< >>
4387              
4388             =head1 BUGS
4389              
4390             Please report any bugs or feature requests to C, or through
4391             the web interface at L. I will be notified, and then you'll
4392             automatically be notified of progress on your bug as I make changes.
4393              
4394             =head1 SUPPORT
4395              
4396             You can find documentation for this module with the perldoc command.
4397              
4398             perldoc ZConf
4399              
4400              
4401             You can also look for information at:
4402              
4403             =over 4
4404              
4405             =item * RT: CPAN's request tracker
4406              
4407             L
4408              
4409             =item * AnnoCPAN: Annotated CPAN documentation
4410              
4411             L
4412              
4413             =item * CPAN Ratings
4414              
4415             L
4416              
4417             =item * Search CPAN
4418              
4419             L
4420              
4421             =item * Subversion Repository
4422              
4423             L
4424              
4425             =back
4426              
4427             =head1 ACKNOWLEDGEMENTS
4428              
4429              
4430             =head1 COPYRIGHT & LICENSE
4431              
4432             Copyright 2011 Zane C. Bowers-Hadley, all rights reserved.
4433              
4434             This program is free software; you can redistribute it and/or modify it
4435             under the same terms as Perl itself.
4436              
4437              
4438             =cut
4439              
4440             1; # End of ZConf