package Lire::Config;

use strict;

use vars qw/ $VERSION $PACKAGE $prefix $sysconfdir $exec_prefix $pkgdatadir
	     $datadir $libexecdir
	     $xsldir $dsssldir $filterdir $reportdir $schemadir
	     $gzip $sendmail $tar
	     $LR_DEBUG $LR_KEEP $KEYS_THRESHOLD_TOP $KEYS_THRESHOLD_NESTED
	     $LR_SCALE_BYTES $LR_SCALE_NUMBER $LR_SCALE_SEC
	     $LR_ARCHIVE $LR_IMAGE_FORMAT
	     $LR_WEEK_STARTS_ON $LR_SQL_MAX_SIZE
	     @SERVICES
	     @SUPERSERVICES
	     $FILTERS_PATH
	     $REPORTS_PATH
	     $SCHEMAS_PATH
	     $dbi_available
	    /;

use Lire::Program   qw/ lr_err lr_warn lr_debug /;
use Lire::DataTypes qw/ check_bool check_int eval_bool check_number /;

# not in public interface
my %SERVICE_ALIASES;
my %SERVICE_MAP;
my $aliasfile;
my $servicefile;

BEGIN {
    no strict 'refs'; # So that things like ${prefix}/etc works

    ($VERSION)	= '$Release$' =~ m!Release: ([.\d]+)!;

    $PACKAGE	    = "lire";
    $prefix	    = "/usr/local";
    $sysconfdir	    = "${prefix}/etc";
    $exec_prefix    = "${prefix}";
    $datadir	    = "${prefix}/share";
    $pkgdatadir	    = "${prefix}/share/lire";
    $libexecdir	    = "${exec_prefix}/libexec";

    $dsssldir	    = "$pkgdatadir/xml/stylesheet/dsssl";
    $xsldir	    = "$pkgdatadir/xml/stylesheet/xsl";

    $schemadir	    = "$pkgdatadir/schemas";
    $SCHEMAS_PATH   = "$ENV{HOME}/.lire/schemas:$schemadir";
    $reportdir	    = "$pkgdatadir/reports";
    $REPORTS_PATH   = "$ENV{HOME}/.lire/reports:$reportdir";
    $filterdir	    = "$pkgdatadir/filters";
    $FILTERS_PATH   = "$ENV{HOME}/.lire/filters:$filterdir";

    $servicefile    = "$sysconfdir/lire/address.cf";
    $aliasfile      = "$sysconfdir/lire/service_aliases.cf";

    $gzip	    = $ENV{LR_GZIP}    || "/usr/bin/gzip";
    $sendmail	    = $ENV{LR_SENDMAIL}|| "/usr/sbin/sendmail";
    $tar	    = $ENV{LR_TAR}     || "/usr/bin/tar";

    $ENV{LR_DEBUG} ||= "no";
    $LR_DEBUG = 0;
    if ( check_bool( $ENV{LR_DEBUG} ) ) {
	$LR_DEBUG = eval_bool( $ENV{LR_DEBUG} );
    } else {
	lr_warn( "invalid boolean value in LR_DEBUG: ", $ENV{LR_DEBUG} );
    }

    $ENV{LR_KEEP}||= "no";
    $LR_KEEP = 0;
    if ( check_bool( $ENV{LR_KEEP} ) ) {
	$LR_KEEP = eval_bool( $ENV{LR_KEEP} );
    } else {
	lr_warn( "invalid boolean value in LR_KEEP: ", $ENV{LR_KEEP} );
    }

    $ENV{LR_ARCHIVE}	||= "no";
    $LR_ARCHIVE	    = 0;
    if ( check_bool( $ENV{LR_ARCHIVE} ) ) {
	$LR_ARCHIVE = eval_bool( $ENV{LR_ARCHIVE} );
    } else {
	lr_warn( "invalid boolean value in LR_ARCHIVE: ", $ENV{LR_ARCHIVE} );
    }

    # Use a data structure and algorithm that minimize memory usage
    # after this threshold.
    # The maximum number of different keys in top-level operations.
    $KEYS_THRESHOLD_TOP	    = 500;
    # The maximum number of different keys in nested operations.
    $KEYS_THRESHOLD_NESTED  = 50;

    # Set the LR_MIN_MEMORY_TEST to 0 or 1 to force the
    # code path to take
    if ( defined $ENV{LR_MIN_MEMORY_TEST} ) {
	if ( eval_bool( $ENV{LR_MIN_MEMORY_TEST} ) ) {
	    lr_debug( "TEST: will always use minimal memory data structure" );
	    $KEYS_THRESHOLD_TOP	    = 1;
	    $KEYS_THRESHOLD_NESTED  = 1;
	} else {
	    lr_debug( "TEST: will never use minimal memory data structure" );
	    $KEYS_THRESHOLD_TOP	    = 2**31;
	    $KEYS_THRESHOLD_NESTED  = 2**31;
	}
    }


    $LR_SCALE_BYTES = 1;
    if (defined $ENV{LR_SCALE_BYTES}) {
	if ( check_bool( $ENV{LR_SCALE_BYTES}) ) {
	    $LR_SCALE_BYTES = eval_bool( $ENV{LR_SCALE_BYTES} );
	} else {
	    lr_warn( "invalid boolean value for LR_SCALE_BYTES ($ENV{LR_SCALE_BYTES})" );
	}
    }

    $LR_SCALE_NUMBER = 0;
    if (defined $ENV{LR_SCALE_NUMBER}) {
	if ( check_bool( $ENV{LR_SCALE_NUMBER}) ) {
	    $LR_SCALE_NUMBER = eval_bool( $ENV{LR_SCALE_NUMBER} );
	} else {
	    lr_warn( "invalid boolean value for LR_SCALE_NUMBER ($ENV{LR_SCALE_NUMBER})" );
	}
    }

    $LR_SCALE_SEC = 1;
    if (defined $ENV{LR_SCALE_SEC}) {
	if ( check_bool( $ENV{LR_SCALE_SEC}) ) {
	    $LR_SCALE_SEC = eval_bool( $ENV{LR_SCALE_SEC} );
	} else {
	    lr_warn(  "invalid boolean value for LR_SCALE_SEC ($ENV{LR_SCALE_SEC})" );
	}
    }

    $ENV{LR_WEEK_STARTS_ON} ||= "sun";
    if ( $ENV{LR_WEEK_STARTS_ON} =~ /^s(u(n(d(ay?)?)?)?)?$/i) {
	$LR_WEEK_STARTS_ON = 'sun';
    } elsif ( $ENV{LR_WEEK_STARTS_ON} =~ /^m(o(n(d(ay?)?)?)?)?$/i) {
	$LR_WEEK_STARTS_ON = 'mon';
    } else {
	lr_warn( "invalid value in LR_WEEKS_STARTS_ON: ",
		 $ENV{LR_WEEK_STARTS_ON}, ". Using sun." );
	$LR_WEEK_STARTS_ON = 'sun';
    }

    $ENV{LR_IMAGE_FORMAT} ||= "png";
    if ( $ENV{LR_IMAGE_FORMAT} =~ /^png|jpeg|gif$/i) {
	$LR_IMAGE_FORMAT = lc $ENV{LR_IMAGE_FORMAT};
    } else {
	lr_warn( "invalid value in LR_IMAGE_FORMAT: ",
		 $ENV{LR_IMAGE_FORMAT}, ". Using png." );
	$LR_IMAGE_FORMAT = 'png';
    }

    $LR_SQL_MAX_SIZE = 1_000_000;
    if (defined $ENV{LR_SQL_MAX_SIZE}) {
	if ( check_int( $ENV{LR_SQL_MAX_SIZE}) ) {
	    $LR_SQL_MAX_SIZE =  $ENV{LR_SQL_MAX_SIZE} + 0;
	} else {
	    lr_warn(  "invalid integer value for LR_SQL_MAX_SIZE ($ENV{LR_SQL_MAX_SIZE})" );
	}
    }

    @SUPERSERVICES = ();

    # Check all the base-schemas available in the $schemadir
    foreach my $dir ( split /:/, $SCHEMAS_PATH ) {
	next unless -d $dir;

	# Superservice's base schema don't have an hyphen in
	# their name.
	opendir DIR, $dir
	  or lr_err( "can't opendir $dir: $!\n" );
	foreach my $f ( readdir DIR ) {
	    if ( $f =~ /^([a-zA-Z_.]+)\.xml$/ ) {
		push @SUPERSERVICES, $1;
	    }
	}
	closedir DIR;
    }

    # build SERVICES array containing canonicalized service names
    my $dir = "$libexecdir/$PACKAGE/convertors";
    opendir DIR, $dir or lr_err( "can't opendir $dir: $!\n" );

    @SERVICES = grep { -x "$dir/$_" && -f _ && s/2dlf$// } readdir DIR;
    closedir DIR;

    # SERVICE_ALIASES: backwards compatibility.  not in public interface:
    # use check_service
    #
    # A hash, indexed by obsolete (but supported for backwards compatibilty) 
    # names of services.  Values are current official names.
    open ALIAS, $aliasfile or lr_err( "can't open $aliasfile: $!\n" );
    while (<ALIAS>) {
        next if /^#/;
        my ($k,$v) = /^(\S+)\s+(\S+)\s*$/;
        $SERVICE_ALIASES{$k} = $v;
    }
    close ALIAS;

    # static mapping of service to superservice.
    open SERVICE, $servicefile or lr_err( "can't open $servicefile: $!\n" );
    while (<SERVICE>) {
        next if /^#/;
        my ($service, $superservice) = /^(\S+)\s+(\S+)\s*$/;
        # we silently overwrite duplicated entries
        $SERVICE_MAP{$service} = $superservice;
    }
    close SERVICE;

    #
    #
    eval "use DBI";
    $dbi_available = 1 unless $@;
}

sub check_service {
    my $service = shift or die "usage: check_service servicename";

    if (grep { $_ eq $service } @SERVICES) {
        return $service;
    } elsif (defined $SERVICE_ALIASES{$service}) {
        return $SERVICE_ALIASES{$service};
    } else {
        my @a = keys %SERVICE_ALIASES;
        lr_err( "'$service' is not a supported service (it is available " .
          "neither as backwards compatible name).  The list of supported " .
          "services is @SERVICES.  The list of names, offered for backwards " .
          "compatibility is @a.\n" );
    }
}

# report on unknown superservice, unknown services in $servicefile: that's
#  a fatal error: lr_err
# report on known superservices and services not listed: warning, exit 2
# return 0  on success
sub inspect_servicemap {
    my @map_services = keys %SERVICE_MAP;
    my @map_superservices = values %SERVICE_MAP;

    my %S_hash;
    my %map_hash;

    my $return = 0;

    # check @map_services for duplicates, # and uniqize it
    my @dups_map_services;
    # my @uniqs_map_services;
    for my $s (@map_services) {
        if ($map_hash{$s}++) {
            push(@dups_map_services, $s);
        }
        # else {
        #    push(@uniqs_map_services, $s);
        # }
    }
    if (@dups_map_services) {
        lr_err( "Your $servicefile is corrupt: the following services are " .
            "listed more than once: @dups_map_services.\n" );
        # @map_services = @uniqs_map_services;
    }


    # diff map_services and SERVICES
    #
    @S_hash{@SERVICES} = (); # %S_hash has SERVICES as keys, all with value
                             # undef
    @map_hash{@map_services} = ();

    my @only_map; # services found in map_services, but not in SERVICES
    my @only_S;

    for my $s (@map_services, @SERVICES) {
        push(@only_map, $s) unless exists $S_hash{$s};
        push(@only_S, $s) unless exists $map_hash{$s};
    }

    if (@only_S) {
        lr_debug( "The following services are supported by your Lire system, " .
            "but are not registered in your $servicefile.  If these services " .
            "belong to supported Lire superservices, you might want to " .
            "register them in the file.  This will allow you to use full " .
            "Lire capabilities for the service.  The missing services are: " .
            "@only_S.\n" );
        $return = 2;
    }

    if (@only_map) {
        lr_err( "Your $servicefile is corrupt: the following services are " .
            "listed in the file, but are not supported by your Lire system: " .
            "no convertor is installed for it: @only_map.\n" );
    }


    # diff map_superservices and SUPERSERVICES
    #
    @S_hash{@SUPERSERVICES} = ();
    @map_hash{@map_superservices} = ();

    @only_map = ();
    @only_S = ();

    for my $s (@map_superservices, @SUPERSERVICES) {
        push(@only_map, $s) unless exists $S_hash{$s};
        push(@only_S, $s) unless exists $map_hash{$s};
    }

    if (@only_S) {
        lr_debug( "The following superservices are supported by your Lire " .
            "system, but are not listed in your $servicefile.  If any " .
            "supported Lire services belong to these superservices, you " .
            "might want to register them in the file, along with their " .
            "services.  This will allow you to use full " .
            "Lire capabilities for the superservice.  The missing " .
            "superservices are: @only_S.\n" );
        $return = 2;
    }

    if (@only_map) {
        lr_err( "Your $servicefile is corrupt: the following superservices " .
            "are listed in the file, but are not supported by your Lire " .
            "system: no base schema is found for them in a Lire schema " .
            "directory: @only_map.\n" );
    }

    return $return;

}


# map service to superservice, and check $servicefile
sub check_superservice {
    my $arg = shift or die "usage: check_superservice servicename";

    # look up in ../convertors/ and aliases, canonicalize
    my $service = check_service($arg);
    unless ($service) {
        lr_err( "no convertor found for service '$arg', not even after " .
            "canonicalization. no superservice found.\n" );
        return '';
    }

    # check for unknown cruft in $servicefile
    inspect_servicemap();
    # if we get this far, inspect is either 0 (everything fine) or 2
    # (user has been warned)

    unless (defined $SERVICE_MAP{$service}){
        lr_err( "service '$arg' is not listed in $servicefile, neither is " .
            "its canonicalized form '$service'. no superservice found.\n" );
        return '';
    }

    # this superservice is valid: we've run inspect_servicemap
    return $SERVICE_MAP{$service};
}


sub connect_dbi {
    die "DBI isn't available\n" unless $dbi_available;

    die "LR_DBI_URI isn't set\n"
      unless defined $ENV{LR_DBI_URI};

    die "only MySQL database is currently supported\n"
      unless $ENV{LR_DBI_URI} =~ /^DBI:mysql:/;

    die "LR_DBI_USER isn't set\n"
      unless defined $ENV{LR_DBI_USER};

    die "LR_DBI_PASSWD_FILE isn't set\n"
      unless defined $ENV{LR_DBI_PASSWD_FILE};

    open PASSWD, $ENV{LR_DBI_PASSWD_FILE}
      or die "can't open $ENV{LR_DBI_PASSWD_FILE}: $!\n";
    my $passwd = <PASSWD>;
    chomp $passwd;
    close PASSWD;

    DBI->connect( $ENV{LR_DBI_URI}, $ENV{LR_DBI_USER}, $passwd )
      or die "connection to DBI $ENV{LR_DBI_URI} failed: ", $DBI::errstr, "\n" ;
}


# keep perl happy
1;

__END__

=pod

=head1 NAME

Lire::Config - import configure variables to perl

=head1 SYNOPSIS

 use Lire::Config;

 $image_format = $Lire::Config:LR_IMAGE_FORMAT;

 for (my $service in @Lire::Config::SERVICES) {
   ....
 }


=head1 DESCRIPTION

Lire::Config sets perl variables like I<$prefix>, I<$dsssldir>, I<$reportdir>
and I<$convert> to their ./configure equivalents (/usr/local, 
etc.)  This allows us to convert only this file from Config.pm.in to Config.pm;
no need to convert B<all> perl scripts during configure.

Furthermore, variables like $LR_SCALE_BYTES, $LR_ARCHIVE, $LR_IMAGE_FORMAT,
$LR_WEEK_STARTS_ON, $LR_SQL_MAX_SIZE and @SUPERSERVICES are supplied.

Last, but not least, some perl routines are offered.  See below.

=head1 VARIABLES

=over 4

=item B<@SERVICES>

An array consisting of all supported service names.  Build from executable
files in I<${exec_prefix}/libexec/lire/convertors/>, who's names end in `2dlf'.


=item B<@SUPERSERVICES>

An array consisting of all Lire supported superservices, built by looking for
base schemas in Lire schema directories.

=back

=head1 SUBROUTINES

=over 4

=item B<check_service>

The B<check_service> takes a servicename as an argument.  If this names is an
officially supported service, it is returned as-is.  If it's known as a
backwards compatible alias, it's official canonicalized name is returned.  If
it's unknow, an errormessage is printed and the empty string is returned.

See also lr_check_service(1): a commandline interface to this routine.


=item B<check_superservice>

A routine which looks for a superservice, to which the service passed as
argument belongs.  It consults the file I<address.cf> for this.  It does
a consistency-check on this file along the way.

=item B<connect_dbi>

A routine for database interfacing, used by lr_dlf2sql(1).


=back

=head1 SEE ALSO

/usr/share/autoconf/INSTALL, autoconf(1), The Autobook by David MacKenzie

=head1 VERSION

$Id: Config.pm.in,v 1.31 2002/08/18 19:27:49 vanbaal Exp $

=head1 COPYRIGHT

Copyright (C) 2001, 2002 Stichting LogReport Foundation LogReport@LogReport.org

This file is part of Lire.

Lire 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 (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html or write to the Free Software 
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111, USA.

=head1 AUTHOR

Francis J. Lacoste <flacoste@logreport.org> with Joost van Baal
<joostvb@logreport.org>

=cut

# Local Variables:
# mode: cperl
# End:
