"Fossies" - the Fresh Open Source Software Archive

Member "bayonne-1.2.16/data/tgi/KEYDATA.pm" (22 Feb 2001, 1133 Bytes) of package /linux/misc/old/bayonne-1.2.16.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "KEYDATA.pm" see the Fossies "Dox" file reference documentation.

    1 # Copyright (C) 2000-2001 Open Source Telecom Corporation.
    2 #  
    3 # This file is free software; as a special exception the author gives
    4 # unlimited permission to copy and/or distribute it, with or without 
    5 # modifications, as long as this notice is preserved.
    6 # 
    7 # This program is distributed in the hope that it will be useful, but
    8 # WITHOUT ANY WARRANTY, to the extent permitted by law; without even the
    9 # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
   10 
   11 package KEYDATA;
   12 
   13 $VERSION = "0.01";
   14 
   15 1;
   16 
   17 sub load
   18 {
   19     my($self) = {};
   20     my($section) = "_INIT";
   21     $filename = shift;
   22     open(CONFIG, "< $filename");
   23     while(<CONFIG>)
   24     {
   25         s/^\s+//g;
   26         s/\s+$//g;
   27         if(/^[A-Za-z]/)
   28         {
   29             my($keyword, $value) = split('=', $_, 2);
   30             $keyword = lc($keyword);
   31             $keyword =~ s/\s+//g;
   32             $value =~ s/^\s+//g;
   33             if($value =~ /^\"/)
   34             {
   35                 $value =~ s/^\"//;
   36                 $value =~ s/\"$//;
   37             }
   38             if($value =~ /^\'/)
   39             {
   40                 $value =~ s/^\'//;
   41                 $value =~ s/\'$//;
   42             }
   43             eval "\$$section\{$keyword\}=\$value";
   44         }
   45         if(/^\[/)
   46         {
   47             s/^\[//;
   48             s/\]$//;
   49             $section = uc($_);
   50             $section =~ s/\s+//g;
   51         }
   52         
   53     }
   54     close(CONFIG);
   55 }