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__ |