File Coverage

blib/lib/EAFDSS/Base.pm
Criterion Covered Total %
statement 229 290 78.9
branch 39 82 47.5
condition 2 9 22.2
subroutine 24 28 85.7
pod 11 11 100.0
total 305 420 72.6


line stmt bran cond sub pod time code
1             # EAFDSS - Electronic Fiscal Signature Devices Library
2             # Ειδική Ασφαλής Φορολογική Διάταξη Σήμανσης (ΕΑΦΔΣΣ)
3             #
4             # Copyright (C) 2008 Hasiotis Nikos
5             #
6             # ID: $Id: Base.pm 105 2009-05-18 10:52:03Z hasiotis $
7              
8             package EAFDSS::Base;
9              
10             =head1 NAME
11              
12             EAFDSS::Base - EAFDSS Base Class Driver for all other drivers
13              
14             =head1 DESCRIPTION
15              
16             Read EAFDSS on how to use the module. This manual page is only of use if you want
17             to find out what it needs to develop a driver for a new EAFDSS device. This Base
18             class is to be inherited by any new driver.
19              
20             =cut
21              
22 1     1   17 use 5.006_000;
  1         3  
  1         42  
23 1     1   4 use strict;
  1         2  
  1         25  
24 1     1   4 use warnings;
  1         2  
  1         26  
25 1     1   4 use Carp;
  1         2  
  1         54  
26 1     1   4 use Class::Base;
  1         2  
  1         27  
27              
28 1     1   5 use base qw ( Class::Base );
  1         1  
  1         4025  
29              
30             our($VERSION) = '0.80';
31              
32             =head1 Methods
33              
34             =head2 init
35              
36             This the constructor, were we make sure we get the correct parameters to handle the
37             initialization of device object. Things like the signatures directory, the serial
38             number of the device. Also parameters special to the type of the device, like ip
39             address, or serial port, or baud rate, etc.
40              
41             =cut
42              
43             sub init {
44 4     4 1 8 my($self, $config) = @_;
45              
46 4 50       19 if (! exists $config->{DIR}) {
47 0         0 return $self->error("You need to provide the DIR to save the signnatures!");
48             } else {
49 4         21 $self->{DIR} = $config->{DIR};
50             }
51              
52 4 50       16 if (! exists $config->{SN}) {
53 0         0 return $self->error("You need to provide the Serial Number of the device!");
54             } else {
55 4         11 $self->{SN} = $config->{SN};
56             }
57              
58 4         15 return $self;
59             }
60              
61             =head2 Sign
62              
63             The main job of an EAFDSS device is to produce signatures. Signatures of text files (invoices)
64             or text streams. So in that function we make sure to read the text from the caller of the
65             function in whatever format. Then we feed the text to the device which in return he gives us
66             the signature of that text. The function at tha level handles the saving of the text in the
67             "A file" and of the signature in the "B file", according to the rules set by the law for the
68             filenames of the files.
69              
70             =cut
71              
72             sub Sign {
73 4     4 1 2143 my($self) = shift @_;
74 4         14 my($fname) = shift @_;
75 4         10 my($reply, $totalSigns, $dailySigns, $date, $time, $nextZ, $sign, $fullSign);
76              
77 4         17 $self->debug("Sign operation");
78              
79 4 50 33     81 if ( ($fname eq '-') || (-e $fname) ) {
80 4         22 my($replySignDir, $deviceDir) = $self->_createSignDir();
81 4 50       20 if ($replySignDir != 0) {
82 0         0 return $self->error($replySignDir);
83             }
84              
85             # Slurping the invoice
86 4         127 open(FH, $fname);
87 4         9 my($invoice) = do { local($/); };
  4         16  
  4         121  
88 4         54 close(FH);
89              
90 4         15 $self->debug( " Checking file [%s] for invalid characters", $fname);
91 4         24 my($invalid) = $self->_checkCharacters($invoice);
92 4 50       13 if ($invalid) {
93 0         0 $self->debug(" File contains invalid characters [%s]", $fname);
94 0         0 return $self->error(64+0x10);
95             }
96              
97 4         14 $self->debug( " Signing file [%s]", $fname);
98 4         22 ($reply, $totalSigns, $dailySigns, $date, $time, $nextZ, $sign) = $self->PROTO_GetSign($invoice);
99              
100 4 50       25 if ($reply == 0) {
101 4         19 $fullSign = sprintf("%s %04d %08d %s%s %s",
102             $sign, $dailySigns, $totalSigns, $self->UTIL_date6ToHost($date), substr($time, 0, 4), $self->{SN});
103              
104 4         36 $self->_createFileA($invoice, $deviceDir, $date, $dailySigns, $nextZ);
105 4         26 $self->_createFileB($fullSign, $deviceDir, $date, $dailySigns, $nextZ);
106              
107 4         27 return $fullSign;
108             } else {
109 0         0 return $self->error($reply);
110             }
111             } else {
112 0         0 $self->debug( " No such file [%s]", $fname);
113 0         0 return $self->error(64+2);
114             }
115              
116             }
117              
118             =head2 Status
119              
120             What this function return is a single line containing the values of the following: serial number,
121             the index of the last Z, the total signatures, the daily signatures, the last signature's data size,
122             remaining signatures until the device will force a Z.
123              
124             =cut
125              
126             sub Status {
127 1     1 1 1505 my($self) = shift @_;
128              
129 1         5 $self->debug("Status operation");
130              
131 1         6 my($reply, $status1, $status2, $lastZ, $total, $daily, $signBlock, $remainDaily) = $self->PROTO_ReadSummary();
132 1 50       6 if ($reply == 0) {
133 1         8 my($statusLine) = sprintf("%s %d %d %d %d %d", $self->{SN}, $lastZ, $total, $daily, $signBlock, $remainDaily);
134 1         3 return $statusLine;
135             } else {
136 0         0 return $self->error($reply);
137             }
138             }
139              
140              
141             =head2 GetTime
142              
143             GetTime will return the time in "DD/MM/YY HH:MM:SS" format.
144              
145             =cut
146              
147             sub GetTime {
148 1     1 1 814 my($self) = shift @_;
149              
150 1         4 $self->debug("Read time operation");
151 1         6 my($reply, $time) = $self->PROTO_ReadTime();
152 1 50       5 if ($reply == 0) {
153 1         4 return $time;
154             } else {
155 0         0 return $self->error($reply);
156             }
157             }
158              
159             =head2 SetTime
160              
161             Use this method to set the date/time on the device. Provide the date/time in the "DD/MM/YY HH:MM:SS" format.
162              
163             =cut
164              
165             sub SetTime {
166 0     0 1 0 my($self) = shift @_;
167 0         0 my($time) = shift @_;
168              
169 0         0 $self->debug("Set time operation");
170 0         0 my($reply) = $self->PROTO_SetTime($time);
171 0 0       0 if ($reply == 0) {
172 0         0 return 0;
173             } else {
174 0         0 return $self->error($reply);
175             }
176             }
177              
178             =head2 Info
179              
180             This method will return information about the name of the device and version of it's firmware.
181              
182             =cut
183              
184             sub Info {
185 1     1 1 463 my($self) = shift @_;
186              
187 1         5 $self->debug("Read Info operation");
188 1         5 my($reply, $version) = $self->PROTO_VersionInfo();
189 1 50       6 if ($reply == 0) {
190 1         4 return $version;
191             } else {
192 0         0 return $self->error($reply);
193             }
194             }
195              
196             =head2 Query
197              
198             This method should Query to find available devicess [NOT IMPLEMENTED]
199              
200             =cut
201              
202             sub Query {
203 0     0 1 0 my($self) = shift @_;
204              
205 0         0 $self->debug("Query for devices");
206 0         0 my($reply, $devices) = $self->PROTO_Query();
207 0 0       0 if ($reply == 0) {
208 0 0       0 if ($devices) {
209 0         0 return $devices;
210             } else {
211 0         0 return $self->error(64+0x05);
212             }
213             } else {
214 0         0 return $self->error($reply);
215             }
216             }
217              
218             =head2 GetHeaders
219              
220             This method will return the printing headers of the device. The returned array contains 6 couples of values. One for the
221             type of the printing line, and one for the actual printing message.
222              
223             =cut
224              
225             sub GetHeaders {
226 0     0 1 0 my($self) = shift @_;
227              
228 0         0 $self->debug("Read Headers operation");
229 0         0 my($reply, @headers) = $self->PROTO_GetHeader();
230 0 0       0 if ($reply == 0) {
231 0         0 return @headers;
232             } else {
233 0         0 return $self->error($reply);
234             }
235             }
236              
237             =head2 SetHeaders
238              
239             This method will set the printing headers on the device. The headers are to be provided in the
240             following format
241              
242             Style1/Line1/Style2/Line2/Style3/Line3/Style4/Line4/Style5/Line5/Style6/Line6
243              
244             =cut
245              
246             sub SetHeaders {
247 0     0 1 0 my($self) = shift @_;
248 0         0 my($headers) = shift @_;
249              
250 0         0 $self->debug("Set Headers operation");
251 0         0 my($reply) = $self->PROTO_SetHeader($headers);
252 0 0       0 if ($reply == 0) {
253 0         0 return 0;
254             } else {
255 0         0 return $self->error($reply);
256             }
257             }
258              
259             =head2 Report
260              
261             The second most used function is Z report issuing function. At the end of the day ask for the device to
262             close the fiscal day by issuing the Z report. It will return the signature of the day. The function will
263             also take care to save the signature in the "C file"
264              
265             =cut
266              
267             sub Report {
268 4     4 1 703 my($self) = shift @_;
269              
270 4         24 my($replySignDir, $deviceDir) = $self->_createSignDir();
271 4 50       26 if ($replySignDir != 0) {
272 0         0 return $self->error($replySignDir);
273             }
274              
275 4         26 $self->_validateFilesB();
276 4         23 $self->_validateFilesC();
277              
278 4         16 $self->debug("Issue Report operation");
279              
280 4         22 my($reply1) = $self->PROTO_IssueReport();
281 4 50       19 if ($reply1 != 0) {
282 0         0 return $self->error($reply1);
283             }
284              
285 4         29 my($reply2, $status1, $status2, $totalSigns, $dailySigns, $date, $time, $z, $sn, $closure) = $self->PROTO_ReadClosure(0);
286 4         32 $self->_createFileC($z, $deviceDir, $date, $time, $closure);
287              
288 4         18 return $z;
289             }
290              
291             sub _RecoveryReport {
292 1     1   3 my($self) = shift @_;
293              
294 1         7 my($deviceDir) = sprintf("%s/%s", $self->{DIR}, $self->{SN});
295              
296 1         5 $self->_validateFilesB();
297 1         5 $self->_validateFilesC();
298              
299 1         4 $self->debug("Issue Recovery Report operation");
300              
301 1         6 my($reply1) = $self->PROTO_IssueReport();
302 1 50       7 if ($reply1 != 0) {
303 0         0 return $self->error($reply1);
304             }
305              
306 1         7 my($reply2, $status1, $status2, $totalSigns, $dailySigns, $date, $time, $z, $sn, $closure) = $self->PROTO_ReadClosure(0);
307 1         7 $self->_createFileC($z, $deviceDir, $date, $time, $closure);
308              
309 1         4 return $z;
310             }
311              
312             sub _checkCharacters {
313 4     4   9 my($self) = shift @_;
314 4         11 my($invoice) = shift @_;
315            
316 4         8 my($c);
317 4         35 foreach $c (unpack('C*', $invoice)) {
318 132 50       1391 if (grep $_ == ord($c), qw/0 1 2 3 4 5 6 7 8 11 14 15 16 17 18 19 20 21 22 23 24 25 27 28 29 30 31 127 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 173 210 255/ ) {
319 0         0 $self->debug(" Found invalid character [%d]", ord($c));
320 0         0 return 1;
321             }
322             }
323              
324 4         26 return 0;
325             }
326              
327             sub _createSignDir {
328 8     8   20 my($self) = shift @_;
329              
330 8         55 my($result) = $self->_Recover();
331 8 50       34 if ($result != 0) {
332 0         0 return ($result, undef);
333             }
334              
335             # Create The signs Dir
336 8 100       176 if (! -d $self->{DIR} ) {
337 4         22 $self->debug(" Creating Base Dir [%s]", $self->{DIR});
338 4         363 mkdir($self->{DIR});
339             }
340              
341 8         43 my($deviceDir) = sprintf("%s/%s", $self->{DIR}, $self->{SN});
342 8 100       151 if (! -d $deviceDir ) {
343 5         18 $self->debug(" Creating Device Dir [%s]", $deviceDir);
344 5         314 mkdir($deviceDir);
345             }
346              
347 8         27 return (0, $deviceDir);
348             }
349              
350             sub _Recover {
351 8     8   15 my($self) = shift @_;
352 8         14 my($reply, $status1, $status2, $lastZ, $total, $daily, $signBlock, $remainDaily);
353              
354 8         43 ($reply, $status1, $status2) = $self->PROTO_GetStatus();
355 8 50       44 if ($reply ne "0") { return $reply };
  0         0  
356              
357 8         44 my($busy, $fatal, $paper, $cmos, $printer, $user, $fiscal, $battery) = $self->UTIL_devStatus($status1);
358 8 100       36 if ($cmos != 1) { return 0 };
  7         23  
359              
360 1         7 my($day, $signature, $recovery, $fiscalWarn, $dailyFull, $fiscalFull) = $self->UTIL_appStatus($status1);
361              
362 1         6 $self->debug(" CMOS is set, going for recovery!");
363              
364 1         7 ($reply, $status1, $status2, $lastZ, $total, $daily, $signBlock, $remainDaily) = $self->PROTO_ReadSummary(0);
365 1 50       6 if ($reply != 0) {
366 0         0 $self->debug(" Aborting recovery because of ReadClosure reply [%d]", $reply);
367 0         0 return $reply
368             };
369              
370 1         9 my($regexA) = sprintf("%s\\d{6}%04d\\d{4}_a.txt", $self->{SN}, $lastZ + 1);
371 1         6 my($deviceDir) = sprintf("%s/%s", $self->{DIR}, $self->{SN});
372              
373 1 50       65 opendir(DIR, $deviceDir) || croak "can't opendir $deviceDir: $!";
374 1         44 my(@afiles) = grep { /$regexA/ } readdir(DIR);
  4         44  
375 1         14 closedir(DIR);
376              
377 1         4 foreach my $curA (@afiles) {
378 1         6 $self->debug(" Checking [%s]", $curA);
379 1         5 my($curFileA) = sprintf("%s/%s", $deviceDir, $curA);
380              
381 1         3 my($curFileB) = $curFileA;
382 1         7 $curFileB =~ s/_a/_b/;
383              
384 1         2 my($curB) = $curA; $curB =~ s/_a/_b/;
  1         5  
385 1         5 my($curIndex) = substr($curA, 21, 4); $curIndex =~ s/^0*//;
  1         4  
386              
387 1         3 $self->debug(" Resigning file A [%s]", $curA);
388 1         41 open(FH, $curFileA);
389              
390 1         9 my($reply, $totalSigns, $dailySigns, $date, $time, $nextZ, $sign) = $self->PROTO_GetSign(*FH);
391 1         8 my($fullSign) = sprintf("%s %04d %08d %s%s %s", $sign, $dailySigns, $totalSigns, $self->UTIL_date6ToHost($date), substr($time, 0, 4), $self->{SN});
392 1         11 close(FH);
393              
394 1         6 $self->debug(" Updating file B [%s] -- Index [%d]", $curB, $curIndex);
395 1 50       42 open(FB, ">>", $curFileB) || croak "Error: $!";
396 1         9 print(FB "\n" . $fullSign);
397 1         109 close(FB);
398             }
399              
400 1         12 my($z) = $self->_RecoveryReport();
401 1 50       5 if ($z) {
402 1         7 return(0);
403             } else {
404 0         0 my($errNo) = $self->error();
405 0         0 return $self->error($errNo);
406             }
407              
408             }
409              
410             sub _createFileA {
411 4     4   15 my($self) = shift @_;
412 4         10 my($invoice) = shift @_;
413 4         11 my($dir) = shift @_;
414 4         9 my($date) = shift @_;
415 4         13 my($ds) = shift @_;
416 4         9 my($curZ) = shift @_;
417              
418 4         18 my($fnA) = sprintf("%s/%s%s%04d%04d_a.txt", $dir, $self->{SN}, $self->UTIL_date6ToHost($date), $curZ, $ds);
419 4         18 $self->debug(" Creating File A [%s]", $fnA);
420 4 50       368 open(FA, ">", $fnA) || croak "Error: $!";
421 4         34 print(FA $invoice);
422 4         155 close(FA);
423             }
424              
425             sub _createFileB {
426 4     4   11 my($self) = shift @_;
427 4         10 my($fullSign) = shift @_;
428 4         7 my($dir) = shift @_;
429 4         16 my($date) = shift @_;
430 4         9 my($ds) = shift @_;
431 4         10 my($curZ) = shift @_;
432              
433 4         19 my($fnB) = sprintf("%s/%s%s%04d%04d_b.txt", $dir, $self->{SN}, $self->UTIL_date6ToHost($date), $curZ, $ds);
434 4         16 $self->debug(" Creating File B [%s]", $fnB);
435 4 50       310 open(FB, ">", $fnB) || croak "Error: $!";
436 4         18 print(FB $fullSign);
437 4         146 close(FB);
438             }
439              
440             sub _createFileC {
441 5     5   13 my($self) = shift @_;
442 5         11 my($z) = shift @_;
443 5         11 my($dir) = shift @_;
444 5         8 my($date) = shift @_;
445 5         14 my($time) = shift @_;
446 5         9 my($closure) = shift @_;
447              
448 5         20 my($fnC) = sprintf("%s/%s%s%s%04d_c.txt", $dir, $self->{SN}, $date, $self->UTIL_time6toHost($time), $closure);
449 5         20 $self->debug( " Creating File C [%s]", $fnC);
450              
451 5 50       542 open(FC, ">", $fnC) || croak "Error: $!";
452 5         43 print(FC $z);
453 5         238 close(FC);
454             }
455              
456              
457             sub _validateFilesB {
458 5     5   14 my($self) = shift @_;
459              
460 5         32 my($reply, $status1, $status2, $lastZ, $total, $daily, $signBlock, $remainDaily) = $self->PROTO_ReadSummary();
461 5 50       21 if ($reply != 0) { return $reply};
  0         0  
462              
463 5         35 my($regexA) = sprintf("%s\\d{6}%04d\\d{4}_a.txt", $self->{SN}, $lastZ + 1);
464 5         21 $self->debug( " Validating B Files for #%d Z with regex [%s]", $lastZ + 1 , $regexA);
465 5         24 my($deviceDir) = sprintf("%s/%s", $self->{DIR}, $self->{SN});
466              
467 5 50       172 opendir(DIR, $deviceDir) || croak "can't opendir $deviceDir: $!";
468 5         144 my(@afiles) = grep { /$regexA/ } readdir(DIR);
  13         117  
469 5         62 closedir(DIR);
470              
471 5         15 foreach my $curA (@afiles) {
472 2         7 $self->debug( " Checking [%s]", $curA);
473 2         9 my($curFileA) = sprintf("%s/%s", $deviceDir, $curA);
474              
475 2         3 my($curFileB) = $curFileA;
476 2         12 $curFileB =~ s/_a/_b/;
477              
478 2 100       51 if (! -e $curFileB) { # TODO: Add size Check
479 1         2 my($curB) = $curA; $curB =~ s/_a/_b/;
  1         4  
480 1         4 my($curIndex) = substr($curA, 21, 4); $curIndex =~ s/^0*//;
  1         5  
481 1         3 $self->debug( " Recreating file B [%s] -- Index [%d]", $curB, $curIndex);
482              
483 1         7 my($replyCode, $status1, $status2, $totalSigns, $dailySigns, $date, $time, $sign, $sn, $closure) = $self->PROTO_ReadSignEntry($curIndex);
484 1         7 my($fullSign) = sprintf("%s %04d %08d %s%s %s", $sign, $dailySigns, $totalSigns, $self->UTIL_date6ToHost($date), substr($time, 0, 4), $self->{SN});
485              
486 1 50       115 open(FB, ">", $curFileB) || croak "Error: $!";
487 1         14 print(FB $fullSign);
488 1         56 close(FB);
489             }
490             }
491              
492 5         17 return;
493             }
494              
495             sub _validateFilesC {
496 5     5   13 my($self) = shift @_;
497              
498 5         19 my($reply, $status1, $status2, $lastZ, $total, $daily, $signBlock, $remainDaily) = $self->PROTO_ReadSummary();
499 5 50       77 if ($reply != 0) { return $reply };
  0         0  
500              
501 5         11 my($curClosure, $curFileC, $matched);
502              
503 5         25 my($regexC) = sprintf("%s.*_c.txt", $self->{SN}, $lastZ + 1);
504 5         21 $self->debug( " Validating C Files for, total of [%d]", $lastZ);
505 5         23 my($deviceDir) = sprintf("%s/%s", $self->{DIR}, $self->{SN});
506              
507 5 50       157 opendir(DIR, $deviceDir) || croak "can't opendir $deviceDir: $!";
508 5         88 my(@cfiles) = grep { /$regexC/ } readdir(DIR);
  14         78  
509 5         63 closedir(DIR);
510              
511 5         30 for ($curClosure = 1; $curClosure <= $lastZ; $curClosure++) {
512 1         5 $self->debug( " Searching for [%d]", $curClosure);
513              
514 1         2 $matched = 0;
515 1         5 foreach (@cfiles) {
516 0 0       0 if (/${curClosure}_c\.txt$/) {
517 0         0 $curFileC = $_;
518 0         0 $matched = 1;
519 0         0 last;
520             }
521             }
522              
523 1 50       5 if ($matched) {
524 0         0 $self->debug( " Keeping file C [%s] -- Index [%d]", $curFileC, $curClosure);
525             } else {
526 1         6 my($replyCode, $status1, $status2, $totalSigns, $dailySigns, $date, $time, $z, $sn, $closure) = $self->PROTO_ReadClosure($curClosure);
527 1         10 my($fnC) = sprintf("%s%s%s%04d_c.txt", $sn, $date, $time, $curClosure);
528 1         8 $self->debug( " Recreating file C [%s] -- Index [%d]", $fnC, $curClosure);
529              
530 1 50       154 open(FC, ">", $deviceDir . "/" . $fnC) || croak "Error: $!";
531 1         11 print(FC $z);
532 1         79 close(FC);
533             }
534             }
535             }
536              
537              
538             sub DESTROY {
539 4     4   4962 my($self) = shift;
540             #printfv("Destroying %s %s", $self, $self->name );
541             }
542              
543             =head2 debug
544              
545             This is our handy debuging function
546              
547             =cut
548              
549             sub debug {
550 113     113 1 199 my($self) = shift;
551 113         143 my($flag);
552              
553 113 50 33     670 if (ref $self && defined $self->{ _DEBUG }) {
554 113         193 $flag = $self->{ _DEBUG };
555             } else {
556             # go looking for package variable
557 1     1   10 no strict 'refs';
  1         3  
  1         144  
558 0   0     0 $self = ref $self || $self;
559 0         0 $flag = ${"$self\::DEBUG"};
  0         0  
560             }
561              
562 113 50       326 return unless $flag;
563              
564 0           printf(STDERR "[%s] %s\n", $self->id, sprintf(shift @_, @_));
565             }
566              
567              
568             # Preloaded methods go here.
569              
570             1;
571             __END__