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   die <<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 to
  90 avoid this message.
  91
  92 In fact, only the --info and --tags actions have been used at all.
  93 EOS
  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 ], # not done yet
 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  imager --help-colorspec
 473
 474 =head1 DESCRIPTION
 475
 476 =head1 ACTIONS
 477
 478 =over
 479
 480 =item --info
 481
 482 Displays the width, height, channels, type for each image, and any tags
 483 Imager picks up.  No options.
 484
 485 Note: Imager still converts many files into direct images when the source
 486 is a paletted image, so the displayed image type may not match the
 487 source image type.
 488
 489 No output image file is produced.
 490
 491 =item --tags
 492
 493 Displays all the tags the Imager reader for that format sets for each
 494 file.
 495
 496 See L<Imager::Files> for file format specific tags and
 497 L<Imager::ImageTypes> for common tags.
 498
 499 =item --palette
 500
 501 Dumps the palette of the given file, if it is an indexed image.
 502
 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
 513 Scale either by the given scaling factor, given as a floating point number,
 514 or to a given dimension.
 515
 516 The scaling is always proportional, if a dimension is given then the
 517 scalefactor that results in the larger image that matches either the
 518 specified 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
 530 Rotate the image by the given number of degrees or radians.
 531
 532 =item --help
 533
 534 Displays the usage message if no extra parameter is found, otherwise displays
 535 more detailed help for the given function, if any.
 536
 537 =item --caption text
 538
 539 Not implemented yet.
 540
 541 Expands the image to create a caption area and draws the given text in the
 542 current font.
 543
 544 You must set a font with --font before this.
 545
 546   imager --font arial.ttf --caption "my silly picture"
 547
 548 The text has the same replacements done as the --info command.
 549
 550   imager --font arial.ttf --caption '%b - %w x %h'
 551
 552 If the caption text is too wide for the image an error is produced.
 553
 554 Any newlines that aren't at the beginning or end of the caption cause
 555 multiple lines of text to be produced.
 556
 557 The --foreground and --background options can be used to set colors
 558 for 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
 568 Display the SYNOPSIS from this POD
 569
 570 =item --verbose
 571
 572 =item -v
 573
 574 Increase the verbosity level.
 575
 576 =item --backup <extension>
 577
 578 =item -i <extension>
 579
 580 Input files are renamed to I<filename><extension> before the output
 581 file is written.
 582
 583 =item --directory <directory>
 584
 585 =item -d <directory>
 586
 587 If this is supplied the output files are written to this directory
 588 instead of the
 589
 590 =item --type <fileformat>
 591
 592 Specifies an output file format
 593
 594 =item --write-option name=value
 595
 596 =item --wo name=value
 597
 598 Sets the value of an option supplied to the Imager write() function.
 599 The options available depend on the file format, see
 600 L<Imager::Files/TYPE SPECIFIC INFORMATION> for file format specific
 601 options.
 602
 603 You can also supply the L<Imager::ImageTypes/Common Tags>.
 604
 605 If you're writing to a gif file you can also supply the options
 606 documented as tags under L<Imager::ImageTypes/Quantization options>.
 607
 608 =back
 609
 610 =head1 PROCESSING OPTIONS
 611
 612 These supply extra parameters to the actions
 613
 614 =over
 615
 616 =item --background <color-spec>
 617
 618 =item --bg <color-spec>
 619
 620 Sets the background color for the --rotate and --caption actions, and
 621 possibly other actions in the future.
 622
 623 See $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
 632 Sets the foreground color for the --caption action, and possibly other
 633 actions in the future.
 634
 635 See $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
 644 Set 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
 651 Sets the format for the output of the --info command.
 652
 653 The format can contain printf style replacement codes, each value is %
 654 followed by a sprintf() field width/precision, followed by the value
 655 code.
 656
 657 The 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
 667 The default format is:
 668
 669  Image: %f%nDimensions: %ww x %hh%nChannels: %c%nType: %t%n
 670
 671 You 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
 677 Gives 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
 686 Possible 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
 695 For example:
 696
 697   red
 698   rgb(255,0,0)
 699   #FF0000
 700   hsv(180,1,1)
 701
 702 If you use either of the HTML color specifications, or a specification
 703 using parentheses from a Unix shell you will need to quote it, for
 704 example:
 705
 706   --fg '#FF0000'
 707   --bg 'rgb(255,0,255)'
 708
 709 =head1 AUTHOR
 710
 711 Tony Cook <tony@develop-help.com>
 712
 713 =cut