source: trunk/gsdl/perllib/cfgread.pm@ 740

###########################################################################
#
# 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;


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
    $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 and arrayexp should be something like
#   '^(this|that)$'
sub read_cfg_file {
    my ($filename, $stringexp, $arrayexp, $hashexp) = @_;
    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;
        }
        }
    }
    close (COLCFG);
    } else {
    print STDERR "cfgread::read_cfg_file couldn't read the cfg file $filename\n";
    }

    return $data;
}


# stringexp and arrayexp should be something like
#   '^(this|that)$'
sub write_cfg_file {
    my ($filename, $data, $stringexp, $arrayexp, $hashexp) = @_;

    if (open (COLCFG, ">$filename")) {
    foreach $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 $k (keys (%{$data->{$key}})) {
            &write_cfg_line ('COLCFG', [$key, $k, $data->{$key}->{$k}]);
        }
        }
    }
    close (COLCFG);
    } else {
    print STDERR "cfgread::write_cfg_file couldn't write the cfg file $filename\n";
    }
}


1;