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__ |