|  line  | 
 stmt  | 
 bran  | 
 cond  | 
 sub  | 
 pod  | 
 time  | 
 code  | 
| 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # vim: set expandtab ts=4 sw=4 nowrap ft=perl ff=unix :  | 
| 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Plack::Middleware::Image::Dummy;  | 
| 
3
 | 
8
 | 
 
 | 
 
 | 
  
8
  
 | 
 
 | 
76785
 | 
 use strict;  | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
346
 | 
    | 
| 
4
 | 
8
 | 
 
 | 
 
 | 
  
8
  
 | 
 
 | 
46
 | 
 use warnings;  | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
497
 | 
    | 
| 
5
 | 
8
 | 
 
 | 
 
 | 
  
8
  
 | 
 
 | 
226
 | 
 use 5.008005;  | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
34
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
631
 | 
    | 
| 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 our $VERSION = '0.05';  | 
| 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
8
 | 
8
 | 
 
 | 
 
 | 
  
8
  
 | 
 
 | 
4437
 | 
 use parent qw/Plack::Middleware/;  | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1055
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
75
 | 
    | 
| 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
10
 | 
8
 | 
 
 | 
 
 | 
  
8
  
 | 
 
 | 
108105
 | 
 use Imager;  | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
466384
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
71
 | 
    | 
| 
11
 | 
8
 | 
 
 | 
 
 | 
  
8
  
 | 
 
 | 
9177
 | 
 use Plack::Request;  | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
580835
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
326
 | 
    | 
| 
12
 | 
8
 | 
 
 | 
 
 | 
  
8
  
 | 
 
 | 
2964
 | 
 use Plack::MIME;  | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2963
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
226
 | 
    | 
| 
13
 | 
8
 | 
 
 | 
 
 | 
  
8
  
 | 
 
 | 
48
 | 
 use Plack::Util;  | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
220
 | 
    | 
| 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 use Plack::Util::Accessor  | 
| 
15
 | 
8
 | 
 
 | 
 
 | 
  
8
  
 | 
 
 | 
48
 | 
   qw/map_path font_path param_filter max_width max_height/;  | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
88
 | 
    | 
| 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
17
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 our $DEFAULT_TEXT_COLOR       = [ 0,    0,    0 ];  | 
| 
18
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 our $DEFAULT_BACKGROUND_COLOR = [ 0xcc, 0xcc, 0xcc ];  | 
| 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 our $DEFAULT_MIN_FONT_SIZE    = 18;  | 
| 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 our $DEFAULT_MAX_WIDTH        = 2048;  | 
| 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 our $DEFAULT_MAX_HEIGHT       = 2048;  | 
| 
22
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub prepare_app {  | 
| 
24
 | 
5
 | 
 
 | 
 
 | 
  
5
  
 | 
  
1
  
 | 
539
 | 
     my $self = shift;  | 
| 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
26
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
     my @err_msgs;  | 
| 
27
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
28
 | 
5
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
25
 | 
     push @err_msgs, 'Please specify map_path.'  unless $self->map_path;  | 
| 
29
 | 
5
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
509
 | 
     push @err_msgs, 'Please specify font_path.' unless $self->font_path;  | 
| 
30
 | 
5
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
44
 | 
     $self->max_width($DEFAULT_MAX_WIDTH)   unless $self->max_width;  | 
| 
31
 | 
5
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
84
 | 
     $self->max_height($DEFAULT_MAX_HEIGHT) unless $self->max_height;  | 
| 
32
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
33
 | 
5
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
182
 | 
     die join(' ', @err_msgs) if scalar(@err_msgs) > 0;  | 
| 
34
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
35
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
36
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub call {  | 
| 
37
 | 
13
 | 
 
 | 
 
 | 
  
13
  
 | 
  
1
  
 | 
115665
 | 
     my ($self, $env) = @_;  | 
| 
38
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
39
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
87
 | 
     my $path_info = match_path($env->{PATH_INFO}, $self->map_path);  | 
| 
40
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
41
 | 
13
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
36
 | 
     if ($path_info) {  | 
| 
42
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
22
 | 
         my $query;  | 
| 
43
 | 
13
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
63
 | 
         if ($env->{'QUERY_STRING'}) {  | 
| 
44
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
             my $req = Plack::Request->new($env);  | 
| 
45
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
             $query = $req->query_parameters;  | 
| 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
47
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
327
 | 
         my $params = parse_params($path_info, $query);  | 
| 
48
 | 
13
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
44
 | 
         if ($params) {  | 
| 
49
 | 
11
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
51
 | 
             $params = $self->param_filter->($params) if $self->param_filter;  | 
| 
50
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
51
 | 
11
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
119
 | 
             if ($params) {  | 
| 
52
 | 
10
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
40
 | 
                 return return_error(  | 
| 
53
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                     500,  | 
| 
54
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                     "Width is too big. Max is $self->max_width"  | 
| 
55
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 ) if $self->max_width < $params->{width};  | 
| 
56
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
57
 | 
9
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
111
 | 
                 return return_error(  | 
| 
58
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                     500,  | 
| 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                     "Height is too big. Max is $self->max_height"  | 
| 
60
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 ) if $self->max_height < $params->{height};  | 
| 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
62
 | 
8
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
102
 | 
                 return create_image($params, $self->font_path) if $params;  | 
| 
63
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             }  | 
| 
64
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
65
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
         return_error(404, 'Not found.');  | 
| 
66
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     } else {  | 
| 
67
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         $self->app->($env);  | 
| 
68
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
69
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 } ## end sub call  | 
| 
70
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
71
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub match_path {  | 
| 
72
 | 
13
 | 
 
 | 
 
 | 
  
13
  
 | 
  
0
  
 | 
121
 | 
     my ($given_path, $config_path) = @_;  | 
| 
73
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
74
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
36
 | 
     my $ref_config_path = ref $config_path;  | 
| 
75
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
76
 | 
13
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
47
 | 
     if ($ref_config_path eq 'Regexp') {  | 
| 
 
 | 
 
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
77
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
97
 | 
         $given_path =~ s/$config_path//g;  | 
| 
78
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
43
 | 
         $given_path;  | 
| 
79
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     } elsif (defined $config_path) {  | 
| 
80
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         my $match_length = length($config_path);  | 
| 
81
 | 
0
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         if (substr($given_path, 0, $match_length) eq $config_path) {  | 
| 
82
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             substr($given_path, $match_length);  | 
| 
83
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         } else {  | 
| 
84
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             undef;  | 
| 
85
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
86
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     } else {  | 
| 
87
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         undef;  | 
| 
88
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
89
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
90
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
91
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub create_image {  | 
| 
92
 | 
8
 | 
 
 | 
 
 | 
  
8
  
 | 
  
0
  
 | 
56
 | 
     my ($params, $font_path) = @_;  | 
| 
93
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
94
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
131
 | 
     my $img = Imager->new(  | 
| 
95
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         xsize => $params->{width}, ysize => $params->{height},  | 
| 
96
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         type  => 'paletted'  | 
| 
97
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     );  | 
| 
98
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
99
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # draw background  | 
| 
100
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
101
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
628
 | 
         my $background_color =  | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
92
 | 
    | 
| 
102
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
           Imager::Color->new(@{ $params->{background_color} });  | 
| 
103
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
262
 | 
         $img->box(  | 
| 
104
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             color  => $background_color,  | 
| 
105
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             xmin   => 0, ymin => 0,  | 
| 
106
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             xmax   => $params->{width}, ymax => $params->{height},  | 
| 
107
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             filled => 1  | 
| 
108
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         );  | 
| 
109
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
110
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
111
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # draw text  | 
| 
112
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
113
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4521
 | 
         my $text_color = Imager::Color->new(@{ $params->{text_color} });  | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
17
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
39
 | 
    | 
| 
114
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5327
 | 
         my $font       = Imager::Font->new(file => $font_path);  | 
| 
115
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13897
 | 
         my $font_size  = determine_font_size(  | 
| 
116
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             $font,             $params->{text},  $params->{width},  | 
| 
117
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             $params->{height}, $params->{width}, $params->{min_font_size}  | 
| 
118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         );  | 
| 
119
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         $img->align_string(  | 
| 
120
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             size   => $font_size,  | 
| 
121
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             x      => $params->{width} / 2, y => $params->{height} / 2,  | 
| 
122
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             halign => 'center', valign => 'center',  | 
| 
123
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             font   => $font, string => $params->{text}, utf8 => 1, aa => 1,  | 
| 
124
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             color  => $text_color  | 
| 
125
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         );  | 
| 
126
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
127
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
128
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return_image($img, $params->{ext});  | 
| 
129
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 } ## end sub create_image  | 
| 
130
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
131
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub parse_params {  | 
| 
132
 | 
15
 | 
 
 | 
 
 | 
  
15
  
 | 
  
0
  
 | 
2829
 | 
     my ($path_info, $query) = @_;  | 
| 
133
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
134
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # ex.) 600x480.jpg  | 
| 
135
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
74
 | 
     my $path_regex = qr{\A(\d+)x(\d+)\.(jpe?g|png|gif)\z};  | 
| 
136
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
137
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
134
 | 
     my ($width, $height, $ext) = ($path_info =~ $path_regex);  | 
| 
138
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
139
 | 
15
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
57
 | 
     return undef unless $ext;  | 
| 
140
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
141
 | 
13
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
48
 | 
     $ext = 'jpeg' if $ext eq 'jpg';  | 
| 
142
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
143
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
37
 | 
     my $text             = $width . 'x' . $height;  | 
| 
144
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
80
 | 
     my $text_color       = $DEFAULT_TEXT_COLOR;  | 
| 
145
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
27
 | 
     my $background_color = $DEFAULT_BACKGROUND_COLOR;  | 
| 
146
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
24
 | 
     my $min_font_size    = $DEFAULT_MIN_FONT_SIZE;  | 
| 
147
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
148
 | 
13
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
38
 | 
     if ($query) {  | 
| 
149
 | 
3
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
15
 | 
         $text = $query->{'text'} if $query->{'text'};  | 
| 
150
 | 
3
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
16
 | 
         $text_color = parse_color($query->{'color'}) if $query->{'color'};  | 
| 
151
 | 
3
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
20
 | 
         $background_color = parse_color($query->{'bgcolor'})  | 
| 
152
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
           if $query->{'bgcolor'};  | 
| 
153
 | 
3
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
12
 | 
         $min_font_size = $query->{'minsize'} if $query->{'minsize'};  | 
| 
154
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
155
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
156
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     +{  | 
| 
157
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
160
 | 
         text             => $text,  | 
| 
158
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         width            => $width,  | 
| 
159
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         height           => $height,  | 
| 
160
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         ext              => $ext,  | 
| 
161
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         text_color       => $text_color,  | 
| 
162
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         background_color => $background_color,  | 
| 
163
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         min_font_size    => $min_font_size,  | 
| 
164
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     };  | 
| 
165
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 } ## end sub parse_params  | 
| 
166
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
167
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub determine_font_size {  | 
| 
168
 | 
8
 | 
 
 | 
 
 | 
  
8
  
 | 
  
0
  
 | 
132
 | 
     my ($font, $text, $width, $height, $default_size, $min_size) = @_;  | 
| 
169
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
170
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
     my $size     = $default_size;  | 
| 
171
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15
 | 
     my $max_size = $default_size;  | 
| 
172
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
173
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
     DETERMINE: while (1) {  | 
| 
174
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
114
 | 
         my $bounding_box = $font->bounding_box(string => $text, size => $size);  | 
| 
175
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         my $width_ratio = $bounding_box->display_width() / $width;  | 
| 
176
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
177
 | 
0
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         if (($size - $min_size) < 1) {  | 
| 
 
 | 
 
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
 
 | 
 
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
178
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             $size = $min_size;  | 
| 
179
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             last DETERMINE;  | 
| 
180
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         } elsif ($width_ratio > 1) {  | 
| 
181
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             $max_size = $size;  | 
| 
182
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         } elsif ($width_ratio > 0.9) {  | 
| 
183
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             last DETERMINE;  | 
| 
184
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         } else {  | 
| 
185
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             $min_size = $size;  | 
| 
186
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
187
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         $size = ($max_size + $min_size) / 2;  | 
| 
188
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         my $l = $bounding_box->display_width();  | 
| 
189
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
190
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
191
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     $size;  | 
| 
192
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
193
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
194
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub return_image {  | 
| 
195
 | 
0
 | 
 
 | 
 
 | 
  
0
  
 | 
  
0
  
 | 
0
 | 
     my ($img, $type) = @_;  | 
| 
196
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
197
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     my $binary;  | 
| 
198
 | 
0
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     $img->write(data => \$binary, type => $type) or die $img->errstr;  | 
| 
199
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
200
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     my $content_type = Plack::MIME->mime_type(".$type");  | 
| 
201
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     return [  | 
| 
202
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         200,  | 
| 
203
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         [  | 
| 
204
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             'Content-Type' => $content_type, 'Content-Length' => length($binary)  | 
| 
205
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         ],  | 
| 
206
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         [$binary]  | 
| 
207
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     ];  | 
| 
208
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
209
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
210
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub return_error {  | 
| 
211
 | 
5
 | 
 
 | 
 
 | 
  
5
  
 | 
  
0
  
 | 
61
 | 
     my ($response_code, $body) = @_;  | 
| 
212
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     return [  | 
| 
213
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
74
 | 
         $response_code,  | 
| 
214
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         [ 'Content-Type' => 'text/plain', 'Content-Length' => length($body) ],  | 
| 
215
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         [$body]  | 
| 
216
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     ];  | 
| 
217
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
218
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
219
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub parse_color {  | 
| 
220
 | 
7
 | 
 
 | 
 
 | 
  
7
  
 | 
  
0
  
 | 
1293
 | 
     my ($color_str) = @_;  | 
| 
221
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
222
 | 
7
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
51
 | 
     if ($color_str =~ /^([0-9a-fA-F]{6})$/) {  | 
| 
223
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
         my $rgb = hex($1);  | 
| 
224
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
         my $b   = $rgb & 0xff; $rgb >>= 8;  | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
    | 
| 
225
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
         my $g   = $rgb & 0xff; $rgb >>= 8;  | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
    | 
| 
226
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
         my $r   = $rgb;  | 
| 
227
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
         return [ $r, $g, $b ];  | 
| 
228
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
229
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
230
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
231
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 1;  | 
| 
232
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 __END__  |