tools/imager

   1 #!/usr/bin/perl -w
   2 use strict;
   3 use Imager;
   4 use Getopt::Long;
   5 use File::Spec;
   6 use File::Basename qw(basename);
   7 use vars qw($VERSION);
   8
   9 $VERSION="0.01_00";
  10
  11 my $help;
  12 my $verbose;
  13 my $backup; # backup extension name
  14 my $directory; # output directory
  15 my $output;
  16 my $type;
  17 my %write_opts; # options supplied to write()
  18 my $understand;
  19
  20 my @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
  27 my %funcs = im_functions();
  28 my %options = im_options();
  29 my %all = ( %funcs, %options );
  30
  31 my $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
  40 my $did_help;
  41 my $help_func =
  42   sub {
  43     my ($option) = @_;
  44
  45     $option =~ s/help-//;
  46     help_on($option);
  47     ++$did_help;
  48   };
  49
  50 my @getoptions;
  51 for 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
  65 GetOptions('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,
  72            'understand' => \$understand,
  73
  74            @getoptions,
  75
  76            'help-color-spec' => sub { $help_func->("color specifications") },
  77            'help-actions' => sub { $help_func->("actions") },
  78            'help-options' => sub { $help_func->("processing options") },
  79            'help-general' => sub { $help_func->("general options") },
  80           )
  81   or usage();
  82
  83 $did_help and exit;
  84
  85 unless ($understand) {
  86   print STDERR <<EOS;
  87 This tool is under-tested and will probably destroy your data.
  88
  89 If you understand and agree with this use the --understand option.
  90
  91 In fact, only the --info and --tags actions have been used at all.
  92 EOS
  93   die;
  94 }
  95
  96 exists $write_opts{file}
  97   and die "Illegal write option 'file'\n";
  98 exists $write_opts{type}
  99   and die "Use the --type option to set the output format\n";
 100
 101 delete $write_opts{qw/file fd fh data callback/};
 102
 103 my @actions = grep $funcs{$_->[0]}, @collection;
 104
 105 if ($help) {
 106   if (@actions) {
 107     print $funcs{$_}[1] for map $_->[0], @actions;
 108     exit;
 109   }
 110   else {
 111     usage();
 112   }
 113 }
 114
 115 if (!@actions && !@ARGV) {
 116   usage();
 117 }
 118
 119 unless (@ARGV) {
 120   die "No files to process\n";
 121 }
 122
 123 unless (@actions) {
 124   die "Nothing to do, supply at least one action, see $0 --help\n";
 125 }
 126
 127 my @type;
 128 push @type, type => $type if $type;
 129
 130 for 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   }
 158   else {
 159     print STDERR "Failed reading $name: ",$im->errstr,"\n";
 160   }
 161 }
 162
 163 sub _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
 188 sub req_info {
 189   my ($im, $ignored, $state) = @_;
 190
 191   my $format = $state->{info_format} || <<EOS;
 192 Image: %f
 193 Dimensions: %ww x %hh
 194 Channels: %c
 195 Type: %t
 196 EOS
 197
 198   print _replace_codes($im, $state, $format);
 199
 200   return;
 201 }
 202
 203 sub req_info_format {
 204   my ($im, $value, $state) = @_;
 205
 206   $state->{info_format} = $value;
 207
 208   $im;
 209 }
 210
 211 sub 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
 224 sub 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
 241 sub 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
 265 sub req_scale {
 266   my ($im, $args) = @_;
 267
 268   return $im->scale(%$args);
 269 }
 270
 271 sub 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
 285 sub 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
 295 sub req_bg {
 296   my ($im, $value, $state) = @_;
 297
 298   $state->{background} = $value;
 299
 300   $im;
 301 }
 302
 303 sub req_fg {
 304   my ($im, $value, $state) = @_;
 305
 306   $state->{foreground} = $value;
 307
 308   $im;
 309 }
 310
 311 sub 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
 320 sub 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
 330 sub req_font_size {
 331   my ($im, $value, $state) = @_;
 332
 333   $state->{font_size} = $value;
 334
 335   $im;
 336 }
 337
 338 sub 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
 356 sub usage {
 357   help_on("SYNOPSIS");
 358   exit 1;
 359 }
 360
 361 sub im_functions {
 362   return
 363     (
 364      info => [ \&req_info ],
 365      tags => [ \&req_tags ],
 366      palette => [ \&req_palette ],
 367      scale => [ \&req_scale, \&val_scale ],
 368      rotate => [ \&req_rotate, \&val_rotate ],
 369      caption => [ \&req_caption ],
 370     );
 371 }
 372
 373 sub 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
 399 sub 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
 410 sub 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
 451 sub help_color_spec {
 452   print <<EOS;
 453 EOS
 454 }
 455
 456 =head1 NAME
 457
 458 imager - 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>]
 466     [--caption <text>] [--info] [--tags] [--font fontfile] files ...
 467  imager --help-I<option>
 468  imager --help-I<operation>
 469  imager --help-options
 470  imager --help-actions
 471  imager --help-general
 472
 473 =head1 DESCRIPTION
 474
 475 =head1 ACTIONS
 476
 477 =over
 478
 479 =item --info
 480
 481 Displays the width, height, channels, type for each image, and any tags
 482 Imager picks up.  No options.
 483
 484 Note: Imager still converts many files into direct images when the source
 485 is a paletted image, so the displayed image type may not match the
 486 source image type.
 487
 488 No output image file is produced.
 489
 490 =item --tags
 491
 492 Displays all the tags the Imager reader for that format sets for each
 493 file.
 494
 495 See L<Imager::Files> for file format specific tags and
 496 L<Imager::ImageTypes> for common tags.
 497
 498 =item --palette
 499
 500 Dumps the palette of the given file, if it is an indexed image.
 501
 502 =item --scale <scalefactor>
 503
 504 =item --scale <width>x<height>
 505
 506 =item --scale <width>x<height>min
 507
 508 =item --scale <width>w
 509
 510 =item --scale <height>h
 511
 512 Scale either by the given scaling factor, given as a floating point number,
 513 or to a given dimension.
 514
 515 The scaling is always proportional, if a dimension is given then the
 516 scalefactor that results in the larger image that matches either the
 517 specified width or height is chosen, unless the word "min" is present".
 518
 519   --scale 0.5         # half size image
 520   --scale 100x100     # aim for 100 pixel x 100 pixel image
 521   --scale 100x100min  # image that fits in 100 x 100 pixel box
 522   --scale 100w        # 100 pixel wide image
 523   --scale 100h        # 100 pixel high image
 524
 525 =item --rotate <degrees>
 526
 527 =item --rotate <radians>r
 528
 529 Rotate the image by the given number of degrees or radians.
 530
 531 =item --help
 532
 533 Displays the usage message if no extra parameter is found, otherwise displays
 534 more detailed help for the given function, if any.
 535
 536 =item --caption text
 537
 538 Expands the image to create a caption area and draws the given text in the
 539 current font.
 540
 541 You must set a font with --font before this.
 542
 543   imager --font arial.ttf --caption "my silly picture"
 544
 545 The text has the same replacements done as the --info command.
 546
 547   imager --font arial.ttf --caption '%b - %w x %h'
 548
 549 If the caption text is too wide for the image an error is produced.
 550
 551 Any newlines that aren't at the beginning or end of the caption cause
 552 multiple lines of text to be produced.
 553
 554 The --foreground and --background options can be used to set colors
 555 for this.  By default black text on a white background is produced.
 556
 557 =back
 558
 559 =head1 GENERAL OPTIONS
 560
 561 =over
 562
 563 =item --help
 564
 565 Display the SYNOPSIS from this POD
 566
 567 =item --verbose
 568
 569 =item -v
 570
 571 Increase the verbosity level.
 572
 573 =item --backup <extension>
 574
 575 =item -i <extension>
 576
 577 Input files are renamed to I<filename><extension> before the output
 578 file is written.
 579
 580 =item --directory <directory>
 581
 582 =item -d <directory>
 583
 584 If this is supplied the output files are written to this directory
 585 instead of the
 586
 587 =item --type <fileformat>
 588
 589 Specifies an output file format
 590
 591 =item --write-option name=value
 592
 593 =item --wo name=value
 594
 595 Sets the value of an option supplied to the Imager write() function.
 596 The options available depend on the file format, see
 597 L<Imager::Files/TYPE SPECIFIC INFORMATION> for file format specific
 598 options.
 599
 600 You can also supply the L<Imager::ImageTypes/Common Tags>.
 601
 602 If you're writing to a gif file you can also supply the options
 603 documented as tags under L<Imager::ImageTypes/Quantization options>.
 604
 605 =back
 606
 607 =head1 PROCESSING OPTIONS
 608
 609 These supply extra parameters to the actions
 610
 611 =over
 612
 613 =item --background <color-spec>
 614
 615 =item --bg <color-spec>
 616
 617 Sets the background color for the --rotate and --caption actions, and
 618 possibly other actions in the future.
 619
 620 See $0 --help-color-spec for possible color specifications.
 621
 622   --bg red
 623   --bg rgba(0,0,0,0)
 624
 625 =item --foreground <color-spec>
 626
 627 =item --fg <color-spec>
 628
 629 Sets the foreground color for the --caption action, and possibly other
 630 actions in the future.
 631
 632 See $0 --help-color-spec for possible color specifications.
 633
 634   --fg red
 635   --fg 'rgba(0,0,0,0)'
 636
 637 =item --font-size size
 638
 639 =item --fs size
 640
 641 Set the font size used by the --caption command, in pixels.
 642
 643   --fs 16  # 16 pixels from baseline to top
 644   --font-size 40 # a bit bigger
 645
 646 =item --info-format format
 647
 648 Sets the format for the output of the --info command.
 649
 650 The format can contain printf style replacement codes, each value is %
 651 followed by a sprintf() field width/precision, followed by the value
 652 code.
 653
 654 The following values can be output:
 655   w - image width in pixels
 656   h - image height in pixels
 657   f - full image filename
 658   b - base image filename
 659   c - number of channels
 660   t - image type (direct vs paletted)
 661   n - inserts a newline
 662   % - inserts a '%' symbol
 663
 664 The default format is:
 665
 666  Image: %f%nDimensions: %ww x %hh%nChannels: %c%nType: %t%n
 667
 668 You can use field widths to produce a more table like appearance:
 669
 670   im --info-format '%4w %4h %4c %-8t %b%n' --info *.jpg
 671
 672 =item --font filename
 673
 674 Gives the name of a font file.  Required by actions that render text.
 675
 676   --font ImUgly.ttf
 677   --font arial.ttf
 678
 679 =back
 680
 681 =head1 COLOR SPECIFICATIONS
 682
 683 Possible color specifications:
 684   color-name - the name of a built-in color
 685   rgb(red,green,blue) - as an RGB triplet
 686   #RRGGBB - as a HTML RGB hex triple
 687   #RGB - as a HTML CSS RGB hex triple
 688   rgba(red,green,blue,alpha) - as an RGBA quad
 689   hsv(hue,sat,value) - as an HSV triplet
 690   hsva(hue,sat,value,alpha) as an HSVA quad
 691
 692 For example:
 693
 694   red
 695   rgb(255,0,0)
 696   #FF0000
 697   hsv(180,1,1)
 698
 699 If you use either of the HTML color specifications, or a specification
 700 using parentheses from a Unix shell you will need to quote it, for
 701 example:
 702
 703   --fg '#FF0000'
 704   --bg 'rgb(255,0,255)'
 705
 706 =head1 AUTHOR
 707
 708 Tony Cook <tony@develop-help.com>
 709
 710 =cut