File Coverage

blib/lib/Catalyst/View/GD/Barcode.pm
Criterion Covered Total %
statement 3 46 6.5
branch 0 22 0.0
condition 0 7 0.0
subroutine 1 4 25.0
pod 2 3 66.6
total 6 82 7.3


line stmt bran cond sub pod time code
1             package Catalyst::View::GD::Barcode;
2              
3 1     1   31737 use strict;
  1         2  
  1         652  
4              
5             our $VERSION = '0.05';
6              
7             my($Revision) = '$Id: Barcode.pm,v 1.5 2006/04/26 13:59:45 yanagisawa Exp $';
8              
9             =head1 NAME
10              
11             Catalyst::View::GD::Barcode - make it easy to use GD::Barcode in Catalyst's View
12              
13             =head1 SYNOPSIS
14              
15             Set string to be converted to barcode.
16              
17             $c->stash->{'barcode_string'} = '123456';
18              
19             Set barcode type. The default is 'NW7'.
20              
21             $c->stash->{'barcode_type'} = 'NW7';
22              
23             COOP2of5 | Code39 | EAN13 | EAN8 | IATA2of5 | ITF | Industrial2of5 | Matrix2of5 | NW7 | QRcode
24              
25             Set barcode size option.
26              
27             $c->stash->{'barcode_size'} = 10;
28              
29             When the number of digit is insufficient, it buries by 0.
30              
31             Set content type option. The default is 'png'.
32              
33             $c->stash->{'content_type'} = 'png';
34              
35             png | gif | jpeg
36              
37             Set any other GD::Barcode options.
38              
39             $c->stash->{'barcode_option'} = {NoText => 1}
40              
41             Print the barcode.
42              
43             $c->forward('Catalyst::View::GD::Barcode');
44              
45             =head1 METHODS
46              
47             =over 2
48              
49             =item gen_barcoed
50              
51             Generate barcode using GD::Barcode.
52             You only need to set string and barcode type and no need to bother anything else.
53             If it fails, it returns the string in plain text.
54              
55             =back
56              
57             =cut
58              
59              
60             sub gen_barcode {
61 0     0 0   my $self = shift;
62 0           my $c = shift;
63 0           my $str = $c->stash->{'barcode_string'};
64 0           my $type = $c->stash->{'barcode_type'};
65 0 0         die "not integer barcode_size" if($c->stash->{'barcode_size'} =~ /\D/);
66 0   0       my $size = sprintf('%%0%ss', $c->stash->{'barcode_size'} || length($c->stash->{'barcode_string'}));
67 0   0       my $content_type = $c->stash->{'content_type'} || 'png';
68 0           my $opt = {};
69 0 0         if($str) {
70             ##### set option
71 0           my $size = sprintf('%%0%ss', $c->stash->{'barcode_size'});
72 0           $opt = $c->stash->{'barcode_option'};
73 0   0       $type ||= 'EAN13';
74 0           my($Barcode);
75 0           my $m_name = "GD::Barcode::$type";
76 0           eval("use $m_name;");
77 0 0         if($@) {
78 0           die "Do not install Barcord module $m_name";
79             }
80 0 0         if ($type eq 'EAN13') {
    0          
    0          
    0          
    0          
81 0           $Barcode = $m_name->new($self->calc_checkdigit(sprintf('%012s', $str)));
82             } elsif ($type eq 'EAN8') {
83 0           $Barcode = $m_name->new($self->calc_checkdigit(sprintf('%07s', $str)));
84             }elsif($type eq 'Code39') {
85 0           $Barcode = $m_name->new('*'. sprintf($size, $str).'*');
86             } elsif($type eq 'NW7') {
87 0           $Barcode = $m_name->new('B'.sprintf($size, $str).'B');
88             } elsif($type eq 'QRcode') {
89 0           $Barcode = $m_name->new(sprintf($size,$str), $opt);
90             }else {
91 0           $Barcode = $m_name->new(sprintf($size,$str));
92             }
93 0 0         unless($Barcode) {
94 0           $c->res->header('Content-Type' => 'text/plain');
95 0           return $GD::Barcode::errStr;
96             } else {
97 0           $c->res->header('Content-Type' => 'image/'.$content_type);
98 0           return $Barcode->plot(%{$opt})->$content_type();
  0            
99             }
100             }else{
101 0           $c->res->header('Content-Type' => 'image/'.$content_type);
102 0           return 'No Barcode String';
103             }
104             }
105              
106             =over 2
107              
108             =item process
109              
110             Set code in $c->res->body().
111              
112             =back
113              
114             =cut
115              
116             sub process{
117 0     0 1   my $self = shift;
118 0           my $c = shift;
119 0           $c->res->body($self->gen_barcode($c));
120 0           return 1;
121             }
122              
123             =over 2
124              
125             =item calc_checkdigit
126              
127             Returns the calculated check digit.
128              
129             =back
130              
131             =cut
132              
133             sub calc_checkdigit {
134 0     0 1   my $self = shift;
135 0           my $str = shift;
136 0           my($checkdigit) = (10 - ((((substr($str, 1, 1) + substr($str, 3, 1) + substr($str, 5, 1) + substr($str, 7, 1) + substr($str, 9, 1) + substr($str, 11, 1)) * 3) + (substr($str, 0, 1) + substr($str, 2, 1) + substr($str, 4, 1) + substr($str, 6, 1) + substr($str, 8, 1) + substr($str, 10, 1))) % 10)) % 10;
137 0 0         if (length($str) == 12) {
    0          
138 0           $str .= $checkdigit;
139             } elsif (length($str) == 13) {
140 0           substr($str, 12, 1) = $checkdigit;
141             }
142 0           return $str;
143             }
144              
145             =head1 SEE ALSO
146              
147             L<Catalyst>
148              
149             =head1 AUTHOR
150              
151             Toshimitu Yanagisawa, C<yanagisawa@shanon.co.jp>
152              
153             =head1 COPYRIGHT AND LICENSE
154              
155             This program is free software, you can redistribute it and/or modify it under
156             the same terms as Perl itself.
157              
158             =cut
159              
160             1;