File Coverage

blib/lib/Text/FIGlet/Ransom.pm
Criterion Covered Total %
statement 67 101 66.3
branch 24 46 52.1
condition n/a
subroutine 6 7 85.7
pod 2 4 50.0
total 99 158 62.6


line stmt bran cond sub pod time code
1             package Text::FIGlet::Ransom;
2             require 5;
3 4     4   23 use strict;
  4         5  
  4         113  
4 4     4   18 use vars qw/$VERSION @ISA/;
  4         6  
  4         157  
5 4     4   17 use Carp 'croak';
  4         5  
  4         4291  
6             $VERSION = 2.17;
7             @ISA = 'Text::FIGlet::Font';
8              
9             #Roll our own for 5.005, and remove somewhat heavy List::Util dependency
10 12     12 0 48 sub max{ (sort @_)[-1]; }
11 276     276 0 268 sub sum{ my $cnt; $cnt += $_ foreach @_; return $cnt}
  276         511  
  276         336  
12              
13             sub new{
14 4     4 1 7 shift();
15 4         16 my $self = {-U=>0, -v=>'center', -m=>-1, @_};
16 4         8 my(@fonts, %fonts);
17              
18              
19 4 50       15 if( ref($self->{-f}) eq 'HASH' ){
20 4 50       14 croak "No default specified" unless defined($self->{-f}->{undef});
21 4 50       7 croak "Insufficient number of fonts, 2 or more please" unless keys(%{$self->{-f}}) > 1;
  4         16  
22 4         8 $self->{_fonts} = [delete($self->{-f}->{undef}), keys %{$self->{-f}}];
  4         16  
23             }
24             else{
25 0 0       0 croak "Insufficient number of fonts, 2 or more please" unless scalar(@{$self->{-f}}) > 1;
  0         0  
26 0         0 $self->{_fonts} = $self->{-f};
27             }
28              
29              
30             #Load the fonts
31 4         11 my $x =0;
32 4         6 foreach my $font ( @{$self->{_fonts}} ){
  4         12  
33 8         79 push(@fonts, Text::FIGlet::Font->new(%$self, -f=>$font));
34 8         52 $fonts{$font} = $x++;
35             }
36              
37              
38             #Synthesize a header
39             #Hardblank = DEL
40 4         21 $self->{_header}->[0] = "\x7F";
41             #Height
42 4         12 $self->{_header}->[1] = max( map {$_->{_header}->[1]} @fonts );
  8         62  
43             #Base height
44 4         13 $self->{_header}->[2] = max( map {$_->{_header}->[2]} @fonts );
  8         38  
45             #Max glyph width
46 4         12 $self->{_header}->[3] = $self->{_maxLen} = max( map {$_->{_maxLen}} @fonts );
  8         21  
47             #Smush = none
48 4         12 $self->{_header}->[4] = 0;
49             #Comment line count, calculated when dumping @_ ... include chr to font mapping?
50             #R2L = false
51 4         9 $self->{_header}->[6] = 0;
52              
53 4 50       17 if( $self->{-v} eq 'base' ){
54 0         0 my $descender = max( map {$_->{_header}->[1] - $_->{_header}->[2]} @fonts );
  0         0  
55 0         0 $self->{_header}->[1] = $self->{_header}->[2] + $descender;
56             }
57              
58              
59             #Assemble the body
60 4         19 for(my $i=32; $i<127; $i++ ){
61 380         436 my($c, $R);
62 380 50       606 if( ref($self->{-f}) eq 'HASH' ){
63 380         395 while( my($k,$v) = each(%{$self->{-f}}) ){
  656         1389  
64 380 100       1259 if( chr($i) =~ /$v/ ){
65 104         176 $c = $fonts[$R=$fonts{$k}]->{_font}->[$i];
66             #Reset counter, may be more trouble than the short-circuit is worth
67 104         100 keys %{$self->{-f}};
  104         133  
68 104         130 last;
69             }
70             }
71 380 100       722 $c = $fonts[$R=0]->{_font}->[$i] unless $c;
72             }
73             else{
74 0         0 $R = rand(scalar(@fonts));
75 0         0 $c = $fonts[$R]->{_font}->[$i];
76 0         0 $self->{_map}->[$R] .= chr($i);
77             }
78              
79             #Vertical-alignment & padding
80 380 100       631 if( my $delta = $self->{_header}->[1] - $fonts[$R]->{_header}->[1] ){
81             #Parens around qw for 5.005
82             local($self->{-v}) = (qw/top center center bottom/)[rand(4)]
83 276 50       442 if $self->{-v} eq 'random';
84              
85              
86 276 50       560 my $ws = $self->{-m} == 0 ? $c->[0] : sum(@$c[0,1,2]);
87 276 100       534 if( $self->{-v} eq 'top' ){
    100          
    100          
    50          
88 69         153 push(@$c, (' 'x$ws)x$delta);
89             }
90             elsif( $self->{-v} eq 'baseline' ){
91 69         90 my $t = $self->{_header}->[2] - $fonts[$R]->{_header}->[2];
92 69         82 my $b = $self->{_header}->[1] - $fonts[$R]->{_header}->[1] - $t;
93 69 50       171 splice(@$c, 3, 0, (' 'x$ws)x$t) if $t;
94 69 50       134 push(@$c, (' 'x$ws)x$b) if $b;
95             }
96             elsif( $self->{-v} eq 'bottom' ){
97 69         177 splice(@$c, 3, 0, (' 'x$ws)x$delta);
98             }
99             elsif( $self->{-v} eq 'center' ){
100 69         112 my $t = int($delta/2);
101 69         80 my $b = $delta - $t;
102 69 50       167 splice(@$c, 3, 0, (' 'x$ws)x$t) if $t;
103 69 50       145 push(@$c, (' 'x$ws)x$b) if $b;
104             }
105             }
106              
107              
108             #XXX -m... freeze/thaw? horizontally center w/ padding -height..-1
109              
110             #Common hardblank
111 380         483 my $iHard=$fonts[$R]->{_header}->[0];
112 380         561 foreach my $j(-$self->{_header}->[1]..-1){
113 2280         3818 $c->[$j]=~ s/$iHard/$self->{_header}->[0]/g;
114             #$c->[$j].= Text::FIGlet::UTF8len($c->[$j]);
115             }
116              
117 380         815 $self->{_font}->[$i] = $c;
118             }
119              
120 4         206 bless($self);
121             }
122              
123             sub freeze{
124 0     0 1   my $self = shift;
125 0           my $font;
126              
127 0           foreach my $opt ( sort grep {/^-/} keys %{$self} ){
  0            
  0            
128 0           my $val = $self->{$opt};
129 0 0         if( ref($val) eq 'ARRAY' ){
    0          
130 0           $val = '[qw/'. join(' ', @$val) . '/]';
131 0 0         if( $opt eq '-f' ){
132 0           for(my $f=0; $f< scalar @{$self->{_map}}; $f++ ){
  0            
133 0           $val .= "\n#\tfont$f $self->{_map}->[$f]";
134 0           $self->{_header}->[5]++;
135             }
136             }
137             }
138             elsif( ref($val) eq 'HASH' ){
139 0           $val = '{undef,'. $self->{_fonts}->[0] .','. join(',',%{$val}) .'}';
  0            
140             }
141 0           $font .= sprintf "#%s => %s\n", $opt, $val;
142 0           $self->{_header}->[5]++;
143             }
144              
145 0           $font = sprintf("flf2a%s %s %s %s %s %s %s\n", @{$self->{_header}}). $font;
  0            
146              
147 0           for(my $i=32; $i<= scalar @{$self->{_font}}; $i++ ){
  0            
148 0           my $c = $self->{_font}->[$i];
149 0           foreach my $j(-$self->{_header}->[1]..-1){
150 0 0         $font .= $c->[$j] . ($j<-1?"\x1F\n":"\x1F\x1F\n");
151             }
152             }
153 0           return $font;
154             }
155              
156             1;
157             __END__