File Coverage

blib/lib/EB/Globals.pm
Criterion Covered Total %
statement 28 34 82.3
branch 4 10 40.0
condition 3 3 100.0
subroutine 8 14 57.1
pod 0 7 0.0
total 43 68 63.2


line stmt bran cond sub pod time code
1             #! perl
2              
3             # Globals.pm --
4             # Author : Johan Vromans
5             # Created On : Thu Jul 14 12:54:08 200
6             # Last Modified By: Johan Vromans
7             # Last Modified On: Thu Sep 24 22:27:58 2015
8             # Update Count : 113
9             # Status : Unknown, Use with caution!
10              
11 6     6   36 use utf8;
  6         11  
  6         42  
12              
13             package EB::Globals;
14              
15 6     6   239 use strict;
  6         11  
  6         127  
16 6     6   29 use warnings;
  6         8  
  6         193  
17              
18 6     6   28 use base qw(Exporter);
  6         21  
  6         4792  
19              
20             our @EXPORT;
21              
22             # Define new constant subroutine, and add it to @EXPORT.
23             sub _newconst($$) {
24 246     246   303 my $t = $_[1];
25 246 100 100     1067 $t = "'$t'" unless $t =~ /^\d+$/ || $t =~ /^\[.*\]$/;
26             #warn("sub $_[0](){$t}\n");
27 246     0 0 7616 eval("sub $_[0](){$t}");
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0         0  
28 246         908 push(@EXPORT, $_[0]);
29             }
30              
31             # Define an enumeration of constant subroutines.
32             sub _enumconst($@) {
33 24     24   64 my ($pfx, @list) = @_;
34 24         36 my $index = 0;
35 24         48 foreach ( @list ) {
36 102         188 my $key = $pfx.$_;
37 102 100       286 if ( $key =~ /^(.*)=(\d+)$/ ) {
38 24         62 $key = $1;
39 24         55 $index = $2;
40             }
41 102         209 _newconst( $key, $index++ );
42             }
43             }
44              
45             # To defeat gettext. Strings here are not for translation.
46 30     30 0 114 sub N__($) { $_[0] }
47              
48             _newconst("SCM_MAJVERSION", 1);
49             _newconst("SCM_MINVERSION", 0);
50             _newconst("SCM_REVISION", 17);
51              
52             _newconst("AMTPRECISION", 2);
53             _newconst("AMTWIDTH", 9);
54             _newconst("NUMGROUPS", 3);
55             _newconst("BTWPRECISION", 4);
56             _newconst("BTWWIDTH", 5);
57             _newconst("AMTSCALE", 100);
58             _newconst("BTWSCALE", 10000);
59              
60             _newconst("BKY_PREVIOUS", "<<<<");
61              
62             _enumconst("DBKTYPE_", qw(INKOOP=1 VERKOOP BANK KAS MEMORIAAL) );
63             _newconst("DBKTYPES",
64             "[qw(".N__("-- Inkoop Verkoop Bank Kas Memoriaal").")]");
65              
66             _enumconst("BTWTARIEF_", qw(NUL=0 HOOG LAAG PRIV ANDERS) );
67             _newconst("BTWTARIEVEN", "[qw(".N__("Nul Hoog Laag PrivĂ© Anders").")]");
68             _newconst("BTWPERIODES", "[qw(".N__("Geen Jaar 2 3 Kwartaal 5 6 7 8 9 10 11 Maand").")]");
69             _newconst("BTWPER_GEEN", 0);
70             _newconst("BTWPER_JAAR", 1);
71             _newconst("BTWPER_KWARTAAL", 4);
72             _newconst("BTWPER_MAAND", 12);
73             _enumconst("BTWTYPE_", qw(NORMAAL=0 VERLEGD INTRA EXTRA) );
74             _newconst("BTWTYPES", "[qw(".N__("Normaal Verlegd Intra Extra").")]");
75             _newconst("BTWKLASSE_BTW_BIT", 0x200);
76             _newconst("BTWKLASSE_KO_BIT", 0x100);
77             _newconst("BTWKLASSE_TYPE_BITS", 0x0ff);
78              
79             # Starting value for automatically defined BTW codes.
80             _newconst("BTW_CODE_AUTO", 1024);
81              
82             # Eval, since it uses the (run-time defined) subroutines.
83 0 0   0 0   eval( 'sub BTWKLASSE($$$) {'.
    0          
    0          
84             ' ($_[0] ? BTWKLASSE_BTW_BIT : 0)'.
85             ' | ($_[1] ? ($_[1] & BTWKLASSE_TYPE_BITS) : 0)'.
86             ' | ($_[2] ? BTWKLASSE_KO_BIT : 0);'.
87             '}' );
88             push(@EXPORT, qw(BTWKLASSE));
89              
90             _newconst("ATTENCODINGS", "[qw(".N__("none uri base64").")]");
91             _enumconst("ATTENCODING_", qw( NONE=0 URI BASE64 ));
92              
93             unless ( caller ) {
94             print STDOUT ("-- Constants\n\n",
95             "COMMENT ON TABLE Constants IS\n",
96             " 'This is generated from ", __PACKAGE__, ". DO NOT CHANGE.';\n\n",
97             "COPY Constants (name, value) FROM stdin;\n");
98              
99             foreach my $key ( sort(@EXPORT) ) {
100 6     6   47 no strict;
  6         10  
  6         563  
101             next if ref($key->());
102             print STDOUT ("$key\t", $key->(), "\n");
103             }
104             print STDOUT ("\\.\n");
105             }
106              
107             1;