########################################################################### # # cfgread.pm -- # A component of the Greenstone digital library software # from the New Zealand Digital Library Project at the # University of Waikato, New Zealand. # # Copyright (C) 1999 New Zealand Digital Library Project # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # ########################################################################### # reads in configuration files package cfgread; use strict; sub read_cfg_line { my ($handle) = @_; my $line = ""; my @line = (); my $linecontinues = 0; while (defined($line = <$handle>)) { $line =~ s/^\#.*$//; # remove comments $line =~ s/\cM|\cJ//g; # remove end-of-line characters $line =~ s/^\s+//; # remove initial white space # Merge with following line if a quoted phrase is left un-closed. if ($line =~ m/[^\\]([\"\'])/) { my $quote=$1; while ($line !~ m/$quote(.*?[^\\])?(\\\\)*$quote/) { my $nextline = <$handle>; if (defined($nextline)) { $nextline =~ s/\r?\n//; # remove end-of-line $line .= " " . $nextline; } else { return undef; # parse error? } } } $linecontinues = $line =~ s/\\$//; while ($line =~ s/\s*(\".*?[^\\](\\\\)*\"|\'.*?[^\\](\\\\)*\'|\S+)\s*//) { if (defined $1) { # remove any enclosing quotes my $entry = $1; $entry =~ s/^([\"\'])(.*)\1$/$2/; # substitute an environment variables ## $entry =~ s/\$(\w+)/$ENV{$1}/g; $entry =~ s/\$\{(\w+)\}/$ENV{$1}/g; push (@line, $entry); } else { push (@line, ""); } } if (scalar(@line) > 0 && !$linecontinues) { # print STDERR "line: \"" . join ("\" \"", @line) . "\"\n"; return \@line; } } return undef; } sub write_cfg_line { my ($handle, $line) = @_; print $handle join ("\t", @$line), "\n"; } # stringexp, arrayexp, hashexp,arrayarrayexp and hashhashexp # should be something like '^(this|that)$' sub read_cfg_file { my ($filename, $stringexp, $arrayexp, $hashexp, $arrayarrayexp, $hashhashexp) = @_; my ($line); my $data = {}; if (open (COLCFG, $filename)) { while (defined ($line = &read_cfg_line('COLCFG'))) { if (scalar(@$line) >= 2) { my $key = shift (@$line); if (defined $stringexp && $key =~ /$stringexp/) { $data->{$key} = shift (@$line); } elsif (defined $arrayexp && $key =~ /$arrayexp/) { push (@{$data->{$key}}, @$line); } elsif (defined $hashexp && $key =~ /$hashexp/) { my $k = shift @$line; my $v = shift @$line; $data->{$key}->{$k} = $v; } elsif (defined $arrayarrayexp && $key =~ /$arrayarrayexp/) { if (!defined $data->{$key}) { $data->{$key} = []; } push (@{$data->{$key}}, $line); } elsif (defined $hashhashexp && $key =~ /$hashhashexp/) { my $k = shift @$line; my $p = shift @$line; my $v = shift @$line; if (!defined $v) { $v = $p; $p = 'default'; } $data->{$key}->{$k}->{$p} = $v; } } } close (COLCFG); } else { print STDERR "cfgread::read_cfg_file couldn't read the cfg file $filename\n"; } return $data; } # stringexp, arrayexp, hashexp and arrayarrayexp # should be something like '^(this|that)$' sub write_cfg_file { my ($filename, $data, $stringexp, $arrayexp, $hashexp, $arrayarrayexp, $hashhashexp) = @_; if (open (COLCFG, ">$filename")) { foreach my $key (sort(keys(%$data))) { if ($key =~ /$stringexp/) { &write_cfg_line ('COLCFG', [$key, $data->{$key}]); } elsif ($key =~ /$arrayexp/) { &write_cfg_line ('COLCFG', [$key, @{$data->{$key}}]); } elsif ($key =~ /$hashexp/) { foreach my $k (keys (%{$data->{$key}})) { &write_cfg_line ('COLCFG', [$key, $k, $data->{$key}->{$k}]); } } elsif ($key =~ /$arrayarrayexp/) { foreach my $k (@{$data->{$key}}) { &write_cfg_line ('COLCFG', [$key, @$k]); } } elsif ($key =~ /$hashhashexp/) { foreach my $k (keys (%{$data->{$key}})) { foreach my $p (keys (%{$data->{$key}->{$k}})) { if ($p =~ /default/) { &write_cfg_line ('COLCFG', [$key, $k, $data->{$key}->{$k}]); } else { &write_cfg_line ('COLCFG', [$key, $k, $p, $data->{$key}->{$k}->{$p}]); } } } } } close (COLCFG); } else { print STDERR "cfgread::write_cfg_file couldn't write the cfg file $filename\n"; } } 1;