source: A2P/a2p/A2P/Init.pm @ 3

#
# Copyright (c) 2004-2007 - Consultas, PKG.fr
#
# This file is part of A2P.
#
# A2P 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.
#
# A2P 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 A2P; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
#
# $Id: Init.pm 3 2007-10-18 16:20:19Z guillaume $
#

package A2P::Init;

use strict ;
use integer ;

BEGIN {
    use Exporter ();

    our ( $VERSION , @ISA , @EXPORT , @EXPORT_OK );

    $VERSION = sprintf "%s", q$Rev: 415 $ =~ /(\d[0-9.]+)\s+/ ;

    @ISA = qw(Exporter);
    @EXPORT = qw( &Init );
    @EXPORT_OK = qw( &ResetInit );
}
our $VERSION ;

my @Shareds   = () ;
my @ConfFiles = () ;
my %CONF      = () ;

#############################################################################
##          Init code  -  Also called when receiving a HUP signal          ##
#############################################################################
sub Init {
    return unless @Shareds or @_ ;

    # First call should initialize our ConfFiles list
    return @ConfFiles = @_ if ( ! @ConfFiles and @_ );

    # We have to (re-)read our system conf
    my %Updated = () ;

    # Second call should initialize our SHARED and defaults list
    if ( ! %CONF and @_ ) {
        %CONF = @_ ;
        @Shareds = keys(%CONF);

        map {
            my ( $strippedkey ) = $_ =~ /^[\$](.*)$/ ;
            $Updated{$_} = $strippedkey ;
        } @Shareds ;
    }

    # Next calls will update our conf

    foreach my $ConfFile ( @ConfFiles ) {
        next if ( ! -e $ConfFile );

        # Open the file for reading and scan each line for standard shell definition
        if (! open( *CONF , '<', $ConfFile )) {
            warn "Can't open '$ConfFile' for reading" ;
            next ;
        }

        my @lines = (<CONF>);
        close(CONF);

        @lines = grep { $_ !~ /^\s*#/ } @lines ; # Strip comments
        @lines = grep { /=/ } @lines ; # Keep only variable definition

        foreach my $key ( @Shareds ) { # Not optimized but rarely called
            my ( $strippedkey ) = $key =~ /^[\$](.*)$/ ;

            # There should be only one line
            foreach my $def ( grep { /^$strippedkey=/ } @lines ) {
                chomp $def ;
                #&debugdev("Analysing $def from $ConfFile conf...");
                my ( $value ) = $def =~/^$strippedkey=\s*["']?([^"']*)["']?\s*$/;
                if ( ! defined($value) ) {
                    warn "Bad configuration line found for '$strippedkey' var: '$def' in '$ConfFile' file" ;
                    next ;
                }
                $value = $1 if ( $value =~ m|^(.*)/$| ); # Strip / from folders
                if ( $CONF{$key} ne $value ) {
                    $CONF{$key} = $value ;
                    #&debugdev("Updating $key to $value");
                    $Updated{$key} = $strippedkey ;
                }
            }
        }
    }

    # Get vars that are eventually defined with shell expansion
    my @needshellexpansion = grep { $CONF{$_} =~ /[\$]/ } @Shareds ;

    # Does expansion if needed
    foreach my $var ( @needshellexpansion ) {
        #&debugdev("$var has shell expansion: $CONF{$var}");
        my $limitrecursion = 10 ;
        my $temp = "" ;
        while ( $limitrecursion and $CONF{$var} =~ /[\$]/ ) {
            $limitrecursion -- ;
            foreach my $key ( @Shareds ) {
                my ( $strippedkey ) = $key =~ /^[\$](.*)$/ ;
                next unless $CONF{$var} =~ m|$strippedkey| ;
                #&debugdev("$var has shell expansion with $key=$CONF{$key}");
                $CONF{$var} =~ s|[\$]$strippedkey|$CONF{$key}| ;
            }
        }
    }

    # Returns %ENV string list to evaluate
    return map {
        my $chr = $CONF{$_} =~ /^\d+$/ ? "" : "'" ;
        '$ENV{' . $Updated{$_} . '} = ' . $chr . $CONF{$_} . $chr ;
        } keys(%Updated) ;
}

sub ResetInit {
    @Shareds   = () ;
    @ConfFiles = () ;
    %CONF      = () ;
}

1;