File Coverage

blib/lib/PDF/API3/Compat/API2/Resource/XObject/Form/BarCode/int2of5.pm
Criterion Covered Total %
statement 20 46 43.4
branch 0 4 0.0
condition n/a
subroutine 7 9 77.7
pod 1 2 50.0
total 28 61 45.9


line stmt bran cond sub pod time code
1             #=======================================================================
2             # ____ ____ _____ _ ____ ___ ____
3             # | _ \| _ \| ___| _ _ / \ | _ \_ _| |___ \
4             # | |_) | | | | |_ (_) (_) / _ \ | |_) | | __) |
5             # | __/| |_| | _| _ _ / ___ \| __/| | / __/
6             # |_| |____/|_| (_) (_) /_/ \_\_| |___| |_____|
7             #
8             # A Perl Module Chain to faciliate the Creation and Modification
9             # of High-Quality "Portable Document Format (PDF)" Files.
10             #
11             # Copyright 1999-2005 Alfred Reibenschuh .
12             #
13             #=======================================================================
14             #
15             # This library is free software; you can redistribute it and/or
16             # modify it under the terms of the GNU Lesser General Public
17             # License as published by the Free Software Foundation; either
18             # version 2 of the License, or (at your option) any later version.
19             #
20             # This library is distributed in the hope that it will be useful,
21             # but WITHOUT ANY WARRANTY; without even the implied warranty of
22             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23             # Lesser General Public License for more details.
24             #
25             # You should have received a copy of the GNU Lesser General Public
26             # License along with this library; if not, write to the
27             # Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28             # Boston, MA 02111-1307, USA.
29             #
30             # $Id: int2of5.pm,v 2.0 2005/11/16 02:18:23 areibens Exp $
31             #
32             #=======================================================================
33             package PDF::API3::Compat::API2::Resource::XObject::Form::BarCode::int2of5;
34            
35             BEGIN {
36            
37 1     1   9 use PDF::API3::Compat::API2::Util;
  1         3  
  1         313  
38 1     1   10 use PDF::API3::Compat::API2::Basic::PDF::Utils;
  1         3  
  1         212  
39 1     1   806 use PDF::API3::Compat::API2::Resource::XObject::Form::BarCode;
  1         6  
  1         61  
40            
41 1     1   8 use POSIX;
  1         2  
  1         9  
42            
43 1     1   3623 use vars qw(@ISA $VERSION);
  1         4  
  1         205  
44            
45 1     1   35 @ISA = qw( PDF::API3::Compat::API2::Resource::XObject::Form::BarCode );
46            
47 1         42 ( $VERSION ) = sprintf '%i.%03i', split(/\./,('$Revision: 2.0 $' =~ /Revision: (\S+)\s/)[0]); # $Date: 2005/11/16 02:18:23 $
48            
49             }
50 1     1   7 no warnings qw[ deprecated recursion uninitialized ];
  1         3  
  1         526  
51            
52             =item $res = PDF::API3::Compat::API2::Resource::XObject::Form::BarCode::int2of5->new $pdf
53            
54             Returns a 2of5int object.
55            
56             =cut
57            
58             sub new {
59 0     0 1   my ($class,$pdf,%opts) = @_;
60 0           my $self;
61            
62 0 0         $class = ref $class if ref $class;
63            
64 0           $self=$class->SUPER::new($pdf,%opts);
65            
66 0           my @bar = $self->encode($opts{-code});
67            
68 0           $self->drawbar([@bar]);
69            
70 0           return($self);
71             }
72            
73            
74             my @bar25interleaved=qw(
75             11221
76             21112
77             12112
78             22111
79             11212
80             21211
81             12211
82             11122
83             21121
84             12121
85             );
86            
87             sub encode {
88 0     0 0   my $self=shift @_;
89 0           my $string=shift @_;
90 0           $string=~ tr/0123456789//cd;
91 0           my ($enc,@bar);
92            
93 0           push(@bar,'aaaa');
94 0           while(length($string)>0)
95             {
96 0           $string=~ s/^(\d{1,1})(\d{0,1})(\d*?)$/$3/;
97 0           $c1=$1;
98 0           $c2=$2;
99 0 0         $c2='0' if ($c2 eq "");
100 0           $s1=$bar25interleaved[$c1];
101 0           $s2=$bar25interleaved[$c2];
102 0           $o='';
103 0           for($cnt=0;$cnt<5;$cnt++)
104             {
105 0           $o.=substr($s1,$cnt,1);
106 0           $o.=substr($s2,$cnt,1);
107             }
108 0           push(@bar,[$o,($c1 . $c2)]);
109             }
110 0           push(@bar,'baaa');
111 0           return(@bar);
112             }
113            
114             1;
115            
116             __END__