File Coverage

blib/lib/Term/QRCode/Compact.pm
Criterion Covered Total %
statement 17 62 27.4
branch 0 4 0.0
condition 0 2 0.0
subroutine 6 8 75.0
pod 1 2 50.0
total 24 78 30.7


line stmt bran cond sub pod time code
1             package Term::QRCode::Compact;
2 1     1   720 use 5.020;
  1         4  
3 1     1   7 use feature 'signatures';
  1         2  
  1         109  
4 1     1   7 no warnings 'experimental::signatures';
  1         2  
  1         58  
5 1     1   594 use utf8;
  1         16  
  1         5  
6              
7 1     1   35 use Exporter 'import';
  1         3  
  1         30  
8 1     1   511 use Imager::QRCode;
  1         60397  
  1         805  
9              
10             our @EXPORT_OK = ('qr_code_as_text');
11              
12             our $VERSION = '0.01';
13              
14             =encoding utf8
15              
16             =head1 NAME
17              
18             Term::QRCode::Compact - create QR codes for display in the terminal
19              
20             =head1 SYNOPSIS
21              
22             use Term::QRCode::Compact 'qr_code_as_text';
23             print qr_code_as_text(text => 'https://metacpan.org/module/Term::QRCode::Compact');
24              
25             # Output:
26             #
27             #
28             # ██████████████ ████ ██████████ ██ ██████ ██████████████
29             # ██ ██ ██ ████ ████ ██ ██ ██
30             # ██ ██████ ██ ████████ ████ ██████████ ██ ██████ ██
31             # ██ ██████ ██ ██████ ██████ ██ ██ ██ ██████ ██
32             # ██ ██████ ██ ████ ██ ████ ██ ████ ██ ██████ ██
33             # ██ ██ ██ ██ ██ ██ ██ ██ ██
34             # ██████████████ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██████████████
35             # ██ ██ ██ ████████████ ██
36             # ██ ██ ██████ ██ ██████ ████████████████████ ██
37             # ██████ ██ ██ ██████ ██ ██ ██ ████
38             # ██ ████ ██ ████████ ██ ████████████ ██
39             # ████ ████ ████ ██████████ ██
40             # ██████████ ██ ██ ██ ████ ██ ████ ██ ██ ████ ██
41             # ██ ████ ██ ████ ██ ████████ ██ ██ ██
42             # ██ ██ ████ ██ ██ ██ ██████████████ ██████
43             # ██ ██ ██ ██ ██████ ████████ ██ ████
44             # ██ ████ ██ ██████████ ██ ████████ ██ ██ ████████
45             # ██ ██████ ██ ████ ██ ██ ██ ████
46             # ████ ████████ ████ ████████ ██ ██████ ██ ██ ██
47             # ██ ██ ██ ████ ██████ ██ ██████ ██ ██
48             # ████████████████ ██ ██ ██████████ ██████ ████
49             # ████ ██ ██ ██ ██████ ██ ██ ██ ██ ████
50             # ██████ ████████████ ████ ████████ ██ ████ ██
51             # ████ ████ ██ ██ ████████ ██ ████ ██
52             # ████ ██ ██ ████ ██ ██████ ██ ██ ████████████████████
53             # ██ ██ ██ ██████ ████ ██ ████
54             # ██████████████ ██████ ████ ████ ██ ██ ██ ██ ██ ████ ██
55             # ██ ██ ██████ ██████ ██████ ██ ██ ██
56             # ██ ██████ ██ ████ ██████████ ██████ ████████████ ████
57             # ██ ██████ ██ ████ ██ ██████████████ ██████ ██
58             # ██ ██████ ██ ████ ██ ██ ████ ██████████
59             # ██ ██ ██ ██ ████████ ██████ ██ ██
60             # ██████████████ ██ ██████ ██ ████████ ████ ██ ██
61             #
62              
63             use Term::QRCode::Compact 'qr_code_as_text';
64             print qr_code_as_text(
65             charset => 'ascii_1x1',
66             text => 'Hello'
67             );
68              
69             # Output
70              
71             ############################ ################ ############################
72             ############################ ################ ############################
73             #### #### #### #### ####
74             #### #### #### #### ####
75             #### ############ #### #### #### #### #### ############ ####
76             #### ############ #### #### #### #### #### ############ ####
77             #### ############ #### #### #### #### ############ ####
78             #### ############ #### #### #### #### ############ ####
79             #### ############ #### ######## #### #### ############ ####
80             #### ############ #### ######## #### #### ############ ####
81             #### #### ######## #### #### ####
82             #### #### ######## #### #### ####
83             ############################ #### #### #### ############################
84             ############################ #### #### #### ############################
85             #### ####
86             #### ####
87             #### #################### #### #### ####################
88             #### #################### #### #### ####################
89             #### #### ################ ######## ####
90             #### #### ################ ######## ####
91             #################### ######## #### ######## ############
92             #################### ######## #### ######## ############
93             #### #### ######## #################### ########
94             #### #### ######## #################### ########
95             ############ #################### #### #### ####
96             ############ #################### #### #### ####
97             #### #### #### ####
98             #### #### #### ####
99             ############################ #### #### #### #### ########
100             ############################ #### #### #### #### ########
101             #### #### #### #### ####################
102             #### #### #### #### ####################
103             #### ############ #### #### #### #### #### ####
104             #### ############ #### #### #### #### #### ####
105             #### ############ #### ######## #################### ####
106             #### ############ #### ######## #################### ####
107             #### ############ #### ######## #### ######## ####
108             #### ############ #### ######## #### ######## ####
109             #### #### #### ################ ############
110             #### #### #### ################ ############
111             ############################ ######## #### #### ####
112             ############################ ######## #### #### ####
113              
114             =cut
115              
116             our %charset = (
117             ascii => {
118             # ascii_1x1 => {
119             # xfactor => 1,
120             # yfactor => 1,
121             # charset => [ ' ', '#' ],
122             # },
123             '2x1' => {
124             xfactor => 1,
125             yfactor => 1,
126             charset => [ ' ', '##' ],
127             },
128             },
129             utf8 => {
130             '1x2' => {
131             xfactor => 1,
132             yfactor => 2,
133             charset => [ ' ', '▀' ,
134             '▄', '█' ],
135             },
136             },
137             );
138              
139 0     0 0   sub compress_lines( $lines, $xfactor, $yfactor, $charset ) {
  0            
  0            
  0            
  0            
  0            
140 0           my $res;
141              
142 0           my $yofs = 0;
143              
144 0           while( $yofs < @$lines ) {
145 0           my $xofs = 0;
146 0           my $cols = @{$lines->[$yofs]};
  0            
147 0           while ($xofs < $cols) {
148 0           my $bits = 0;
149 0           for my $l (0..$yfactor-1) {
150 0           for my $c (0..$xfactor-1) {
151 0           my $bitpos = $l*$xfactor + $c;
152             #say sprintf '%02d x %02d %04b %d %04b', $xofs+$c, $yofs+$l, $bitpos, $lines->[$yofs+$l]->[$xofs+$c], $bits;
153              
154 0           $bits += $lines->[$yofs+$l]->[$xofs+$c] << $bitpos;
155             }
156             }
157 0           $res .= $charset->[ $bits ];
158 0           $xofs += $xfactor
159             };
160 0           $yofs += $yfactor;
161 0           $res .= "\n";
162             }
163              
164 0           return $res
165             }
166              
167             =head1 FUNCTIONS
168              
169             =head2 C
170              
171             say qr_code_as_text( text => 'hello' );
172              
173             Returns a string with newlines that represents
174             the QR-Code.
175              
176             Options
177              
178             =over 4
179              
180             =item B
181              
182             The text to turn into a QR-Code
183              
184             =item B
185              
186             charset => 'utf8',
187              
188             The charset to use when rendering the QR-Code,
189             default is C.
190              
191             =item B
192              
193             Optional
194              
195             dimensions => '1x2',
196              
197             The number of pixels per returned character.
198             Currently for ASCII the dimensions the dimensions
199             are C<2x1> for ascii and C<2x1> for C.
200              
201             =back
202              
203             =cut
204              
205 0     0 1   sub qr_code_as_text( %options ) {
  0            
  0            
206 0   0       $options{charset} //= 'utf8';
207              
208 0           my $qrcode = Imager::QRCode->new(
209             size => 2,
210             margin => 2,
211             version => 1,
212             level => 'M',
213             casesensitive => 1,
214             lightcolor => Imager::Color->new(255, 255, 255),
215             darkcolor => Imager::Color->new(0, 0, 0),
216             );
217              
218 0           my $charset = $charset{ $options{ charset }};
219              
220 0           my $dimensions = $options{ dimensions };
221 0 0         if( ! $dimensions ) {
222 0           ($dimensions) = keys (%$charset);
223             }
224 0           $charset = $charset->{ $dimensions };
225              
226 0           my $img = $qrcode->plot($options{text});
227 0           my $rows = $img->getheight;
228 0           my $cols = $img->getwidth;
229 0           my $res;
230             my @lines;
231 0           for my $row (0..$rows-1) {
232 0           my $line = [];
233 0           for my $col (0..$cols-1) {
234 0           my $val = $img->getpixel( 'x' => $col, 'y' => $row );
235 0 0         my $is_black = [$val->rgba]->[0] == 0 ? 1 : 0;
236 0           push @$line, $is_black;
237             }
238 0           push @lines, $line;
239              
240             }
241             return compress_lines( \@lines,
242             $charset->{xfactor},
243             $charset->{yfactor},
244             $charset->{charset},
245 0           );
246             }
247              
248             1;
249              
250             =head1 SEE ALSO
251              
252             L - needs an update to support C<.> in C<@INC>
253              
254             L - needs L
255              
256             =cut