File Coverage

blib/lib/EB.pm
Criterion Covered Total %
statement 59 82 71.9
branch 15 34 44.1
condition 4 11 36.3
subroutine 14 16 87.5
pod 0 3 0.0
total 92 146 63.0


line stmt bran cond sub pod time code
1             #! perl -- -*- coding: utf-8 -*-
2              
3 6     6   75042 use utf8;
  6         78  
  6         29  
4              
5             # EB.pm -- EekBoek Base module.
6             # Author : Johan Vromans
7             # Created On : Fri Sep 16 18:38:45 2005
8             # Last Modified By: Johan Vromans
9             # Last Modified On: Thu Aug 31 09:57:36 2017
10             # Update Count : 331
11             # Status : Unknown, Use with caution!
12              
13             package main;
14              
15             our $app;
16             our $cfg;
17              
18             package EB;
19              
20 6     6   337 use strict;
  6         12  
  6         156  
21 6     6   27 use base qw(Exporter);
  6         10  
  6         811  
22              
23 6     6   2097 use EekBoek;
  6         11  
  6         2144  
24              
25             our @EXPORT;
26             our @EXPORT_OK;
27              
28             # Establish location of our run-time resources.
29             my $lib;
30             sub libfile {
31 0     0 0 0 my ($f) = @_;
32              
33 0 0       0 unless ( $lib ) {
34             # Packaged.
35 0 0       0 if ( $App::Packager::PACKAGED ) {
36 0         0 return App::Packager::GetResourcePath()."/$f";
37             }
38             else {
39 0         0 $lib = $INC{"EB.pm"};
40 0         0 $lib =~ s/EB\.pm$//;
41             }
42             }
43 0         0 $lib."EB/res/$f";
44             }
45              
46             sub findlib {
47 22     22 0 4215 my ( $file, $section ) = @_;
48              
49             # The two-argument form supports locale-dependent paths, but
50             # we hard-wire this to 'nl'.
51 22 100       57 if ( $section ) {
52 6         11 my $lang = 'nl';
53 6         23 my $found = findlib( "$section/$lang/$file" );
54 6 50       37 return $found if $found;
55 0         0 $found = findlib( "$section/$file" );
56 0 0       0 return $found if $found;
57 0         0 return undef;
58             }
59              
60             # Packaged.
61 16 50       30 if ( $App::Packager::PACKAGED ) {
62 0         0 my $found = App::Packager::GetUserFile($file);
63 0 0       0 return $found if -e $found;
64 0         0 $found = App::Packager::GetResource($file);
65 0 0       0 return $found if -e $found;
66             }
67              
68 16         32 foreach ( @INC ) {
69 42 100       549 return "$_/EB/user/$file" if -e "$_/EB/user/$file";
70 39 100       421 return "$_/EB/res/$file" if -e "$_/EB/res/$file";
71 38 100       490 return "$_/EB/$file" if -e "$_/EB/$file";
72             }
73 0         0 undef;
74             }
75              
76 6     6   2807 use lib ( grep { defined } findlib("CPAN") );
  6         3873  
  6         19  
  6         44  
77              
78             # Some standard modules (locale-free).
79 6     6   2939 use EB::Globals;
  6         20  
  6         1031  
80 6     6   54 use Carp;
  6         9  
  6         429  
81 6     6   2988 use Data::Dumper;
  6         31813  
  6         410  
82 6     6   2528 use EB::Utils;
  6         16  
  6         642  
83              
84             # We need a glob() that deals with spaces.
85 6 50   6   57 use File::Glob ( $] >= 5.016 ? ":bsd_glob" : ":glob" );
  6         13  
  6         3928  
86              
87             # Even though we do not use translations, most of the code is in place.
88 61     61   228 sub _T { $_[0] }
89              
90             # Export our and the imported globals.
91             @EXPORT = ( @EB::Globals::EXPORT,
92             @EB::Utils::EXPORT,
93             "_T",
94             qw(carp croak confess), # Carp
95             qw(glob), # File::Glob
96             qw(Dumper), # Data::Dumper
97             qw(findlib libfile), #
98             );
99              
100             our $ident;
101             our $imsg;
102             my $imsg_saved;
103             our $url = "http://www.eekboek.nl";
104              
105             sub __init__ {
106 6   50 6   27 $imsg_saved = $imsg || "";
107              
108 6         11 my $year = 2005;
109 6         246 my $thisyear = (localtime(time))[5] + 1900;
110 6 50       43 $year .= "-$thisyear" unless $year == $thisyear;
111 6         35 $ident = __x("{name} {version}",
112             name => $EekBoek::PACKAGE,
113             version => $EekBoek::VERSION);
114 6 50       31 $imsg = __x("{ident}{extra} -- Copyright {year} Squirrel Consultancy",
115             ident => $ident,
116             extra => ($app ? " Wx" : ""),
117             year => $year);
118 6 50 33     57 if ( $imsg ne $imsg_saved
      33        
119             && !( @ARGV && $ARGV[0] =~ /-(P|-?printconfig)$/ )
120             ) {
121 6         453 warn($imsg, "\n");
122             }
123              
124             eval {
125 0         0 require Win32;
126 0         0 my @a = Win32::GetOSVersion();
127 0         0 my ($id, $major) = @a[4,1];
128 0 0       0 die unless defined $id;
129 0         0 warn(_T("EekBoek is VRIJE software, ontwikkeld om vrij over uw eigen gegevens te kunnen beschikken.")."\n");
130 0         0 warn(_T("Met uw keuze voor het Microsoft Windows besturingssysteem geeft u echter alle vrijheden weer uit handen. Dat is erg triest.")."\n");
131 6 50 33     74 } unless $imsg_saved eq $imsg || $ENV{AUTOMATED_TESTING};
132              
133             }
134              
135             sub app_init {
136 6     6 0 12486 shift; # 'EB'
137              
138             # Load a config file.
139 6         1981 require EB::Config;
140 6         19 undef $::cfg;
141 6         48 EB::Config->init_config( @_ );
142              
143             # Main initialisation.
144 6         22 __init__();
145              
146             # Initialise locale-dependent formats.
147 6         2082 require EB::Format;
148 6         52 EB::Format->init_formats();
149              
150 6         18 return $::cfg; # until we've got something better
151             }
152              
153             sub EB::Config::Handler::connect_db {
154             # Connect to the data base.
155 0     0     require EB::DB;
156 0           EB::DB::->connect;
157             }
158              
159             1;
160              
161             __END__