sql-ledger/sql-ledger/SL/Inifile.pm

   1 #=====================================================================
   2 # SQL-Ledger Accounting
   3 # Copyright (C) 2002
   4 #
   5 #  Author: Dieter Simader
   6 #   Email: dsimader@sql-ledger.org
   7 #     Web: http://www.sql-ledger.org
   8 #
   9 #  Contributors:
  10 #
  11 # This program is free software; you can redistribute it and/or modify
  12 # it under the terms of the GNU General Public License as published by
  13 # the Free Software Foundation; either version 2 of the License, or
  14 # (at your option) any later version.
  15 #
  16 # This program is distributed in the hope that it will be useful,
  17 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 # GNU General Public License for more details.
  20 # You should have received a copy of the GNU General Public License
  21 # along with this program; if not, write to the Free Software
  22 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23 #=====================================================================
  24 #
  25 # routines to retrieve / manipulate win ini style files
  26 # ORDER is used to keep the elements in the order they appear in .ini
  27 #
  28 #=====================================================================
  29
  30 package Inifile;
  31
  32
  33 sub new {
  34   my ($type, $file, $level) = @_;
  35
  36   my $id = "";
  37   my $skip;
  38
  39   $self ||= {};
  40   $type = ref($self) || $self;
  41
  42   open FH, "$file" or Form->error("$file : $!");
  43
  44   while (<FH>) {
  45     next if /^(#|;|\s)/;
  46     last if /^\./;
  47
  48     chop;
  49
  50     # strip comments
  51     s/\s*(#|;).*//g;
  52
  53     # remove any trailing whitespace
  54     s/^\s*(.*?)\s*$/$1/;
  55
  56     if (/^\[/) {
  57       s/(\[|\])//g;
  58
  59       $id = $_;
  60
  61       # if there is a level skip
  62       if ($skip = ($id !~ /^$level/)) {
  63         next;
  64       }
  65
  66       push @{$self->{ORDER}}, $_;
  67
  68       next;
  69
  70     }
  71
  72     if (!$skip) {
  73       # add key=value to $id
  74       my ($key, $value) = split /=/, $_, 2;
  75
  76       $self->{$id}{$key} = $value;
  77     }
  78
  79   }
  80   close FH;
  81
  82   bless $self, $type;
  83
  84 }
  85
  86
  87 1;
  88