File Coverage

blib/lib/EB.pm

Criterion	Covered	Total	%
statement	77	96	80.2
branch	24	48	50.0
condition	8	20	40.0
subroutine	14	15	93.3
pod	0	3	0.0
total	123	182	67.5

#! perl --			-*- coding: utf-8 -*-

use utf8;

# EB.pm -- EekBoek Base module.
# Author          : Johan Vromans
# Created On      : Fri Sep 16 18:38:45 2005
# Last Modified By: Johan Vromans
# Last Modified On: Wed Mar 23 11:17:11 2011
# Update Count    : 320
# Status          : Unknown, Use with caution!

package main;

our $app;
our $cfg;

package EB;

use strict;
use base qw(Exporter);

use EekBoek;

our @EXPORT;
our @EXPORT_OK;

# Establish location of our run-time resources.
my $lib;
sub libfile {
    my ($f) = @_;

    unless ( $lib ) {
	# Cava.
	if ( $Cava::Packager::PACKAGED ) {
	    return Cava::Packager::GetResourcePath()."/$f";
	}
	else {
	    $lib = $INC{"EB.pm"};
	    $lib =~ s/EB\.pm$//;
	}
    }
    $lib."EB/res/$f";
}

sub findlib {
    my ($file, $section) = @_;

    # The two-argument form supports locale-dependent paths.
    if ( $section && $cfg ) {
	my $lang = $cfg->val( qw( locale lang ), "" );
	if ( $lang =~ /\./ ) {
	    my $found = findlib( "$section/$lang/$file" );
	    return $found if $found;
	    $lang =~ s/\..*//;	# strip .utf8
	}
	if ( $lang =~ /_/  ) {
	    my $found = findlib( "$section/$lang/$file" );
	    return $found if $found;
	    $lang =~ s/_.*//;	# strip _US
	}
	if ( $lang ) {
	    my $found = findlib( "$section/$lang/$file" );
	    return $found if $found;
	}
	return undef;
    }
    elsif ( $section ) {
	$file = "$section/$file";
    }

    # Cava.
    if ( $Cava::Packager::PACKAGED ) {
	my $found = Cava::Packager::GetUserFile($file);
	return $found if -e $found;
	$found = Cava::Packager::GetResource($file);
	return $found if -e $found;
    }

    foreach ( @INC ) {
	return "$_/EB/user/$file" if -e "$_/EB/user/$file";
	return "$_/EB/res/$file" if -e "$_/EB/res/$file";
	return "$_/EB/$file" if -e "$_/EB/$file";
    }
    undef;
}

use lib ( grep { defined } findlib("CPAN") );

# Some standard modules (locale-free).
use EB::Globals;
use Carp;
use Data::Dumper;
use Carp::Assert;
use EB::Utils;

# Export our and the imported globals.
@EXPORT = ( @EB::Globals::EXPORT,
	    @EB::Utils::EXPORT,
	    "_T",			# @EB::Locale::EXPORT,
	    qw(carp croak),		# Carp
	    qw(Dumper),			# Data::Dumper
	    qw(findlib libfile),	#
	    qw(assert affirm),		# Carp::Assert
	  );

our $ident;
our $imsg;
my $imsg_saved;
our $url = "http://www.eekboek.nl";

sub __init__ {
    $imsg_saved = $imsg || "";

    # The CLI and GUI use different EB::Locale modules.
    if ( $app || $Cava::Packager::PACKAGED && !Cava::Packager::IsLinux() ) {
	# We do not have a good gettext for Windows, so use Wx.
	# It's packaged anyway.
	require EB::Wx::Locale;	# provides EB::Locale, really
    }
    else {
	require EB::Locale;
    }
    EB::Locale::->import;
    EB::Locale->set_language($ENV{LANG});

    my $year = 2005;
    my $thisyear = (localtime(time))[5] + 1900;
    $year .= "-$thisyear" unless $year == $thisyear;
    $ident = __x("{name} {version}",
		 name    => $EekBoek::PACKAGE,
		 version => $EekBoek::VERSION);
    my @locextra;
    push(@locextra, _T("Nederlands")) if $EB::Locale::LOCALISER;
    $imsg = __x("{ident}{extra}{locale} -- Copyright {year} Squirrel Consultancy",
		ident   => $ident,
		extra   => ($app ? " Wx" : ""),
		locale  => (@locextra ? " (".join(", ", @locextra).")" : ""),
		year    => $year);
    if ( $imsg ne $imsg_saved
	 && !( @ARGV && $ARGV[0] =~ /-(P|-?printconfig)$/ )
       ) {
	warn($imsg, "\n");
    }

    eval {
	require Win32;
	my @a = Win32::GetOSVersion();
	my ($id, $major) = @a[4,1];
	die unless defined $id;
	warn(_T("EekBoek is VRIJE software, ontwikkeld om vrij over uw eigen gegevens te kunnen beschikken.")."\n");
	warn(_T("Met uw keuze voor het Microsoft Windows besturingssysteem geeft u echter alle vrijheden weer uit handen. Dat is erg triest.")."\n");
    } unless $imsg_saved eq $imsg || $ENV{AUTOMATED_TESTING};

}

sub app_init {
    shift;			# 'EB'

    # Load a config file.
    require EB::Config;
    undef $::cfg;
    EB::Config->init_config( @_ );

    # Main initialisation.
    __init__();

    # Initialise locale-dependent formats.
    require EB::Format;
    EB::Format->init_formats();

    return $::cfg;		# until we've got something better
}

sub EB::Config::Handler::connect_db {
    # Connect to the data base.
    require EB::DB;
    EB::DB::->connect;
}

1;

__END__