dbscripts/lib/property.pl

   1 #!/usr/bin/perl
   2
   3 ###########################################################
   4 ### property module
   5 ###
   6 ### $VER: 2.1$
   7
   8 package Property;
   9
  10 sub compile {
  11         my ($value)=shift;
  12         $value=~s/\$\((\w+)\)/$ENV{$1}/e;
  13         return $value;
  14         }
  15
  16 sub append {
  17         my($hash,$file)=@_;
  18         local(*FH);
  19         my($line,$cat,$slot,$key,$value,$from,$to);
  20
  21         $cat="public";
  22         if (open(FH,$file)) {
  23                 while (<FH>) {
  24                         s/[\r\n]+//g;
  25                         next if /^\s*$/;
  26                         next if /^#/;
  27
  28                         if (/^\[(\w+)\]/) {
  29                                 $cat=$1;
  30                                 $$hash{$cat}{'_'}=$cat;
  31                                 next;
  32                                 }
  33                         if (/^\[(\w+)\]\s*=\>\s*\[(\w+)\]$/) {
  34                                 $$hash{$2}=$$hash{$1};
  35                                 next;
  36                                 }
  37                         if (/([^=\s]+)\s*=\s*(.*?)\s*$/) {
  38                                 $$hash{$cat}{$1}=$2;
  39                                 next;
  40                                 }
  41                         if (/([^=\s]+)\s*:\s*(.*)/) {
  42                                 $key=$1; $value=$2;
  43                                 $value=&compile($value);
  44                                 $$hash{$cat}{$key}=$value;
  45                                 next;
  46                                 }
  47                         if (/([^\<\s]+)\s*\<\<\s*(.*)/) {
  48                                 $slot=$1;
  49                                 undef @collect;
  50                                 while (<FH>) {
  51                                         last if substr($_,0,2) eq "<<";
  52                                         push(@collect,$_);
  53                                         }
  54                                 $$hash{$cat}{$slot}=join("\n",@collect);
  55                                 }
  56                         }
  57                 close(FH);
  58                 }
  59         else { print "CANNOT OPEN $file --- $!\n"; }
  60         }
  61
  62 sub read {
  63         my($file)=shift;
  64         my($hash)={};
  65
  66         &append($hash,$file);
  67         return $hash;
  68         }
  69
  70 1;