avoid ignoring the result of i_io_getc()
[imager.git] / tools / imager
CommitLineData
21351017
TC
1#!/usr/bin/perl -w
2use strict;
3use Imager;
4use Getopt::Long;
5use File::Spec;
6use File::Basename qw(basename);
7use vars qw($VERSION);
8
9$VERSION="0.01_00";
10
11my $help;
12my $verbose;
13my $backup; # backup extension name
14my $directory; # output directory
81483e0f 15my $output;
21351017
TC
16my $type;
17my %write_opts; # options supplied to write()
81483e0f 18my $understand;
21351017
TC
19
20my @collection; # actions/options in order to allow us to set values as needed
21
22# each entry consists of:
23# - ref to action/option handler function
24# - help text
25# - optional ref to value parser function
26
27my %funcs = im_functions();
28my %options = im_options();
29my %all = ( %funcs, %options );
30
31my $action_func =
32 sub {
33 my ($option, $value) = @_;
34 if ($all{$option}[1] && ref $all{$option}[1]) {
35 $value = $all{$option}[1]->($option, $value);
36 }
37 push @collection, [ $option, $value ]
38 };
39
40my $did_help;
41my $help_func =
42 sub {
43 my ($option) = @_;
44
45 $option =~ s/help-//;
46 help_on($option);
47 ++$did_help;
48 };
49
50my @getoptions;
51for my $option_name (keys %all) {
52 my $option = $all{$option_name};
53 my @names = ( $option_name );
54 my @other_names = split /\|/, $option->[2] if $option->[2];
55 push @names, @other_names;
56 my $code = '';
57 if ($option->[1]) {
58 $code = ref $option->[1] ? "=s" : "=".$option->[1];
59 }
60 push @getoptions, join("|", @names) . $code => $action_func;
61 # this would be evil $all{$_} = $option for @other_names;
62 push @getoptions, join("|", map "help-$_", @names) => $help_func;
63}
64
65GetOptions('help' => sub { $help_func->("synopsis") },
66 'verbose|v+' => \$verbose,
67 'backup|i=s' => \$backup,
68 'directory|d=s' => \$directory,
69 'type|t=s' => \$type, # output file type
70 'write-option|wo=s' => \%write_opts,
71 'output|o=s' => \$output,
81483e0f 72 'understand' => \$understand,
21351017
TC
73
74 @getoptions,
75
76 'help-color-spec' => sub { $help_func->("color specifications") },
81483e0f
TC
77 'help-actions' => sub { $help_func->("actions") },
78 'help-options' => sub { $help_func->("processing options") },
79 'help-general' => sub { $help_func->("general options") },
21351017
TC
80 )
81 or usage();
82
83$did_help and exit;
84
81483e0f 85unless ($understand) {
b8a4504c 86 die <<EOS;
81483e0f
TC
87This tool is under-tested and will probably destroy your data.
88
b8a4504c
TC
89If you understand and agree with this use the --understand option to
90avoid this message.
81483e0f
TC
91
92In fact, only the --info and --tags actions have been used at all.
93EOS
81483e0f
TC
94}
95
21351017
TC
96exists $write_opts{file}
97 and die "Illegal write option 'file'\n";
98exists $write_opts{type}
99 and die "Use the --type option to set the output format\n";
100
101delete $write_opts{qw/file fd fh data callback/};
102
103my @actions = grep $funcs{$_->[0]}, @collection;
104
105if ($help) {
106 if (@actions) {
107 print $funcs{$_}[1] for map $_->[0], @actions;
108 exit;
109 }
110 else {
111 usage();
112 }
113}
114
115if (!@actions && !@ARGV) {
116 usage();
117}
118
119unless (@ARGV) {
120 die "No files to process\n";
121}
122
123unless (@actions) {
124 die "Nothing to do, supply at least one action, see $0 --help\n";
125}
126
127my @type;
128push @type, type => $type if $type;
129
130for my $name (@ARGV) {
131 my $im = Imager->new;
132 if ($im->read(file=>$name)) {
133 my %state = ( filename => $name );
134
135 for my $action (@collection) {
136 $im = $all{$action->[0]}[0]->($im, $action->[1], \%state);
137 last unless $im;
138 }
139
140 if ($im) {
141 my $outname = $name;
142 if ($directory) {
143 my $file;
144 (undef, undef, $file) = File::Spec->split_path($outname);
145 $outname = File::Spec->catfile($directory, $file);
146 }
147 if ($backup) {
148 my $backfile = $name . $backup;
149 rename $name, $backfile
150 or die "Couldn't rename source '$name' to backup '$backfile': $!\n";
151 }
152
153 unless ($im->write(file=>$outname, @type)) {
154 die "Could not write result from '$name' to '$outname': ", $im->errstr,"\n";
155 }
156 }
157 }
81483e0f
TC
158 else {
159 print STDERR "Failed reading $name: ",$im->errstr,"\n";
160 }
21351017
TC
161}
162
163sub _replace_codes {
164 my ($im, $state, $format) = @_;
165
166 my %replace =
167 (
168 f => [ 's', $state->{filename} ],
169 b => [ 's', basename($state->{filename}) ],
170 w => [ 'd', $im->getwidth ],
171 h => [ 'd', $im->getheight ],
172 c => [ 'd', $im->getchannels ],
173 t => [ 's', $im->type ],
174 n => [ 'c', ord("\n") ], # a bit of a hack
175 '%' => [ '%' ],
176 );
177 my @values;
178 $format =~ s{%(-?(?:\d+(?:\.\d*)?|\.\d+)?)([fwhctbn%])}
179 {
180 my $which = $replace{$2};
181 push @values, @$which[1..$#$which];
182 "%$1$which->[0]"
183 }eg;
184
185 return sprintf $format, @values;
186}
187
188sub req_info {
189 my ($im, $ignored, $state) = @_;
190
191 my $format = $state->{info_format} || <<EOS;
192Image: %f
193Dimensions: %ww x %hh
194Channels: %c
195Type: %t
196EOS
197
198 print _replace_codes($im, $state, $format);
199
200 return;
201}
202
203sub req_info_format {
204 my ($im, $value, $state) = @_;
205
206 $state->{info_format} = $value;
207
208 $im;
209}
210
81483e0f
TC
211sub req_tags {
212 my ($im, $ignored, $state) = @_;
213
214 print $state->{filename},"\n";
215 my @tags = $im->tags;
216 for my $tag (sort { $a->[0] cmp $b->[0] } @tags) {
217 my $name = shift @$tag;
218 print " $name: @$tag\n";
219 }
220
221 return;
222}
223
08ec4969
TC
224sub req_palette {
225 my ($im, $ignored, $state) = @_;
226
227 print $state->{filename},"\n";
228 if ($im->type eq 'direct') {
229 print " No palette - this is a direct color image\n";
230 }
231 else {
232 my @colors = $im->getcolors;
233 for my $index (0..$#colors) {
234 printf "%3d: (%3d, %3d, %3d)\n", $index, ($colors[$index]->rgba)[0..2];
235 }
236 }
237
238 return;
239}
240
21351017
TC
241sub val_scale {
242 my ($option, $value) = @_;
243
244 my %options;
245 if ($option =~ /^(\d+)\s*x\s*(\d+)$/i) {
246 return { xpixels=>$1, ypixels=>$2 };
247 }
248 elsif ($option =~ /^(\d+(?:\.\d*)?|\.\d+)$/) {
249 return { scalefactor => $option };
250 }
251 elsif ($option =~ /^(\d+)\s*x\s*(\d+)\s*min$/i) {
252 return { xpixels=>$1, ypixels=>$2, type=>'min' };
253 }
254 elsif ($option =~ /^(\d+)\s*(?:w|wide)$/i) {
255 return { xpixels => $1 };
256 }
257 elsif ($option =~ /^(\d+)\s*(?:h|high)$/i) {
258 return { ypixels => $1 };
259 }
260 else {
261 die "Invalid parameter to --scale, try $0 --help-scale\n";
262 }
263}
264
265sub req_scale {
266 my ($im, $args) = @_;
267
268 return $im->scale(%$args);
269}
270
271sub val_rotate {
272 my ($option, $value) = @_;
273
274 if ($value =~ /^[-+]?(?:\d+(?:\.\d*)|\.\d+)$/) {
275 return { degrees => $value };
276 }
277 elsif ($value =~ /^([-+]?(?:\d+(?:\.\d*)|\.\d+))\s*(?:r|radians)$/i) {
278 return { radians => $1 };
279 }
280 else {
281 die "Invalid parameter to --rotate, try $0 --help-rotate\n";
282 }
283}
284
285sub req_rotate {
286 my ($im, $args, $state) = @_;
287
288 my @moreargs;
289 if ($state->{background}) {
290 push @moreargs, back => $state->{background};
291 }
292 return $im->rotate(%$args, @moreargs);
293}
294
295sub req_bg {
296 my ($im, $value, $state) = @_;
297
298 $state->{background} = $value;
299
300 $im;
301}
302
303sub req_fg {
304 my ($im, $value, $state) = @_;
305
306 $state->{foreground} = $value;
307
308 $im;
309}
310
311sub req_font {
312 my ($im, $value, $state) = @_;
313
314 $state->{font} = Imager::Font->new(file=>$value)
315 or die "Could not create font from $value: ", Imager->errstr,"\n";
316
317 $im;
318}
319
320sub val_font_size {
321 my ($option, $value) = @_;
322
323 unless ($value =~ /^\d+$/ && $value > 0) {
324 die "$option must be a positive integer\n";
325 }
326
327 $value;
328}
329
330sub req_font_size {
331 my ($im, $value, $state) = @_;
332
333 $state->{font_size} = $value;
334
335 $im;
336}
337
338sub req_caption {
339 my ($im, $format, $state) = @_;
340
341 my $text = _replace_codes($im, $state, $format);
342
343 my $font = $state->{font}
344 or die "You must supply a --font option before the --caption command\n";
345
346 my $size = $state->{font_size} || 16;
347
348 my $box = $font->bounding_box(size=>$size);
349 $box->total_width <= $im->getwidth
350 or die "Caption text '$text' is wider (", $box->total_width,
351 ") than the image (",$im->getwidth,")\n";
352
353 die "not implemented yet";
354}
355
356sub usage {
357 help_on("SYNOPSIS");
358 exit 1;
359}
360
361sub im_functions {
362 return
363 (
364 info => [ \&req_info ],
81483e0f 365 tags => [ \&req_tags ],
08ec4969 366 palette => [ \&req_palette ],
21351017
TC
367 scale => [ \&req_scale, \&val_scale ],
368 rotate => [ \&req_rotate, \&val_rotate ],
d5a13866 369 # caption => [ \&req_caption ], # not done yet
21351017
TC
370 );
371}
372
373sub val_color {
374 my ($option, $value) = @_;
375
376 if ($value =~ /^rgba\((\d+),(\d+),(\d+),(\d+)\)$/i) {
377 return Imager::Color->new($1,$2,$3,$4);
378 }
379 elsif ($value =~ /^rgb\((\d+),(\d+),(\d+)\)$/i) {
380 return Imager::Color->new($1,$2,$3);
381 }
382 elsif ($value =~ /^\#[\da-f]{3}([\da-f]{3})?$/) {
383 return Imager::Color->new(web=>$value);
384 }
385 elsif ($value =~ /^hsv\((\d+(?:\.\d*)),(\d+\.\d*|\.\d+),(\d+\.\d*|\.\d+)\)$/) {
386 return Imager::Color->new(hsv => [ $1, $2, $3 ]);
387 }
388 elsif ($value =~ /^hsva\((\d+(?:\.\d*)),(\d+\.\d*|\.\d+),(\d+\.\d*|\.\d+),(\d+)\)$/) {
389 return Imager::Color->new(hsv => [ $1, $2, $3 ], alpha=>$4);
390 }
391 else {
392 my $color = Imager::Color->new(name=>$value);
393 return $color if $color;
394
395 die "Unrecognized color specification $value supplied to --$option\n";
396 }
397}
398
399sub im_options {
400 return
401 (
402 background => [ \&req_bg, \&val_color, 'bg' ],
403 foreground => [ \&req_fg, \&val_color, 'fg' ],
404 'info-format' => [ \&req_info_format, 's'],
405 font => [ \&req_font, \&val_font ],
406 'font-size' => [ \&req_font_size, \&val_font_size, 'fs' ],
407 );
408}
409
410sub help_on {
411 my ($topic) = @_;
412
413 open SOURCE, "< $0" or die "Cannot read source for help text: $!\n";
414 my @lines;
415 while (<SOURCE>) {
416 # don't chomp it
417 if (/^=item --$topic\s/) {
418 push @lines, $_;
419 # read any more =items then read text until we see =item or =back
420 while (<SOURCE>) {
421 last unless /^\s*$/ or /^=item /;
422 push @lines, $_;
423 }
424 push @lines, $_;
425 # and any other until another option or =back
426 while (<SOURCE>) {
427 last if /^=(item|cut|back)/;
428 push @lines, $_;
429 }
430 print @lines;
431 return;
432 }
433 elsif (/^=head(\d) $topic\s*$/i) {
434 my $level = $1;
435 push @lines, $_;
436 while (<SOURCE>) {
437 last if /=head[1-$level]/;
438 push @lines, $_;
439 }
440
441 print @lines;
442 return;
443 }
444 }
445 close SOURCE;
446
447 die "No help topic $topic found\n";
448}
449
450
451sub help_color_spec {
452 print <<EOS;
453EOS
454}
455
456=head1 NAME
457
458imager - Imager command-line image manipulation tool
459
460=head1 SYNOPSIS
461
462 imager --help
463 imager [--font-size <size>] [--fs <size>] [--background <color>]
464 [--bg <color>] [--foreground <color>] [--fg <color]
465 [--info-format <format>] [--rotate <angle>] [--scale <scale-spec>]
81483e0f 466 [--caption <text>] [--info] [--tags] [--font fontfile] files ...
21351017 467 imager --help-I<option>
81483e0f
TC
468 imager --help-I<operation>
469 imager --help-options
470 imager --help-actions
471 imager --help-general
b8a4504c 472 imager --help-colorspec
21351017
TC
473
474=head1 DESCRIPTION
475
476=head1 ACTIONS
477
478=over
479
480=item --info
481
482Displays the width, height, channels, type for each image, and any tags
483Imager picks up. No options.
484
485Note: Imager still converts many files into direct images when the source
486is a paletted image, so the displayed image type may not match the
487source image type.
488
489No output image file is produced.
490
81483e0f
TC
491=item --tags
492
493Displays all the tags the Imager reader for that format sets for each
494file.
495
496See L<Imager::Files> for file format specific tags and
497L<Imager::ImageTypes> for common tags.
498
08ec4969
TC
499=item --palette
500
501Dumps the palette of the given file, if it is an indexed image.
502
21351017
TC
503=item --scale <scalefactor>
504
505=item --scale <width>x<height>
506
507=item --scale <width>x<height>min
508
509=item --scale <width>w
510
511=item --scale <height>h
512
513Scale either by the given scaling factor, given as a floating point number,
514or to a given dimension.
515
516The scaling is always proportional, if a dimension is given then the
517scalefactor that results in the larger image that matches either the
518specified width or height is chosen, unless the word "min" is present".
519
520 --scale 0.5 # half size image
521 --scale 100x100 # aim for 100 pixel x 100 pixel image
522 --scale 100x100min # image that fits in 100 x 100 pixel box
523 --scale 100w # 100 pixel wide image
524 --scale 100h # 100 pixel high image
525
526=item --rotate <degrees>
527
528=item --rotate <radians>r
529
530Rotate the image by the given number of degrees or radians.
531
532=item --help
533
534Displays the usage message if no extra parameter is found, otherwise displays
535more detailed help for the given function, if any.
536
537=item --caption text
538
d5a13866
TC
539Not implemented yet.
540
21351017
TC
541Expands the image to create a caption area and draws the given text in the
542current font.
543
544You must set a font with --font before this.
545
546 imager --font arial.ttf --caption "my silly picture"
547
548The text has the same replacements done as the --info command.
549
550 imager --font arial.ttf --caption '%b - %w x %h'
551
552If the caption text is too wide for the image an error is produced.
553
554Any newlines that aren't at the beginning or end of the caption cause
555multiple lines of text to be produced.
556
557The --foreground and --background options can be used to set colors
558for this. By default black text on a white background is produced.
559
560=back
561
562=head1 GENERAL OPTIONS
563
564=over
565
566=item --help
567
568Display the SYNOPSIS from this POD
569
570=item --verbose
571
572=item -v
573
574Increase the verbosity level.
575
576=item --backup <extension>
577
578=item -i <extension>
579
580Input files are renamed to I<filename><extension> before the output
581file is written.
582
583=item --directory <directory>
584
585=item -d <directory>
586
587If this is supplied the output files are written to this directory
588instead of the
589
590=item --type <fileformat>
591
592Specifies an output file format
593
594=item --write-option name=value
595
596=item --wo name=value
597
598Sets the value of an option supplied to the Imager write() function.
599The options available depend on the file format, see
600L<Imager::Files/TYPE SPECIFIC INFORMATION> for file format specific
601options.
602
603You can also supply the L<Imager::ImageTypes/Common Tags>.
604
605If you're writing to a gif file you can also supply the options
606documented as tags under L<Imager::ImageTypes/Quantization options>.
607
608=back
609
610=head1 PROCESSING OPTIONS
611
612These supply extra parameters to the actions
613
614=over
615
616=item --background <color-spec>
617
618=item --bg <color-spec>
619
620Sets the background color for the --rotate and --caption actions, and
621possibly other actions in the future.
622
623See $0 --help-color-spec for possible color specifications.
624
625 --bg red
626 --bg rgba(0,0,0,0)
627
628=item --foreground <color-spec>
629
630=item --fg <color-spec>
631
632Sets the foreground color for the --caption action, and possibly other
633actions in the future.
634
635See $0 --help-color-spec for possible color specifications.
636
637 --fg red
638 --fg 'rgba(0,0,0,0)'
639
640=item --font-size size
641
642=item --fs size
643
644Set the font size used by the --caption command, in pixels.
645
646 --fs 16 # 16 pixels from baseline to top
647 --font-size 40 # a bit bigger
648
649=item --info-format format
650
651Sets the format for the output of the --info command.
652
653The format can contain printf style replacement codes, each value is %
654followed by a sprintf() field width/precision, followed by the value
655code.
656
657The following values can be output:
658 w - image width in pixels
659 h - image height in pixels
660 f - full image filename
661 b - base image filename
662 c - number of channels
663 t - image type (direct vs paletted)
664 n - inserts a newline
665 % - inserts a '%' symbol
666
667The default format is:
668
669 Image: %f%nDimensions: %ww x %hh%nChannels: %c%nType: %t%n
670
671You can use field widths to produce a more table like appearance:
672
673 im --info-format '%4w %4h %4c %-8t %b%n' --info *.jpg
674
675=item --font filename
676
677Gives the name of a font file. Required by actions that render text.
678
679 --font ImUgly.ttf
680 --font arial.ttf
681
682=back
683
684=head1 COLOR SPECIFICATIONS
685
686Possible color specifications:
687 color-name - the name of a built-in color
688 rgb(red,green,blue) - as an RGB triplet
689 #RRGGBB - as a HTML RGB hex triple
690 #RGB - as a HTML CSS RGB hex triple
691 rgba(red,green,blue,alpha) - as an RGBA quad
692 hsv(hue,sat,value) - as an HSV triplet
693 hsva(hue,sat,value,alpha) as an HSVA quad
694
695For example:
696
697 red
698 rgb(255,0,0)
699 #FF0000
700 hsv(180,1,1)
701
702If you use either of the HTML color specifications, or a specification
703using parentheses from a Unix shell you will need to quote it, for
704example:
705
706 --fg '#FF0000'
707 --bg 'rgb(255,0,255)'
708
709=head1 AUTHOR
710
711Tony Cook <tony@develop-help.com>
712
713=cut