File Coverage

blib/lib/Vector/QRCode/EPS.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Vector::QRCode::EPS;
2 3     3   85447 use 5.008005;
  3         10  
  3         122  
3 3     3   17 use strict;
  3         4  
  3         192  
4 3     3   26 use warnings;
  3         4  
  3         90  
5 3     3   4721 use PostScript::Simple;
  3         41085  
  3         200  
6 3     3   3908 use Text::QRCode;
  0            
  0            
7              
8             our $VERSION = "0.07";
9              
10             sub generate {
11             my ($class, %opts) = @_;
12             my $text = $opts{text};
13             my $size = $opts{size} || 10;
14             my $unit = $opts{unit} || 'cm';
15             my $colour = $opts{colour} || [10, 10, 10];
16             my $bgcolour = $opts{bgcolour} || [255,255,255];
17             my $transparent = $opts{transparent};
18              
19             my $qrcode_options = $opts{qrcode_options} || {};
20              
21             my $qrdata = Text::QRCode->new(%$qrcode_options)->plot($text);
22             $qrdata = [reverse @$qrdata]; ### avoid to upside down
23              
24             my $xsize = scalar( @{$qrdata->[0]} );
25             my $ysize = scalar( @{$qrdata} );
26              
27             my $ps = PostScript::Simple->new(
28             colour => 1,
29             eps => 1,
30             units => $unit,
31             xsize => $size,
32             ysize => $size
33             );
34              
35             unless ($transparent) {
36             $ps->setcolour(@$bgcolour);
37             $ps->box({filled => 1}, 0, 0, $size, $size);
38             }
39              
40             $ps->setcolour(@$colour);
41             my ($x, $y);
42             for $y (0 .. $#{$qrdata}) {
43             for $x (0 .. $#{$qrdata->[$y]} ) {
44             if ($qrdata->[$y][$x] eq '*') {
45             $ps->box(
46             {filled => 1},
47             $size/$xsize*$x, $size/$ysize*$y,
48             $size/$xsize*($x+1), $size/$ysize*($y+1)
49             );
50             }
51             }
52             }
53              
54             $ps;
55             }
56              
57             1;
58             __END__