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 ], # 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
 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 Not implemented yet.
 539
 540 Expands the image to create a caption area and draws the given text in the
 541 current font.
 542
 543 You must set a font with --font before this.
 544
 545   imager --font arial.ttf --caption "my silly picture"
 546
 547 The text has the same replacements done as the --info command.
 548
 549   imager --font arial.ttf --caption '%b - %w x %h'
 550
 551 If the caption text is too wide for the image an error is produced.
 552
 553 Any newlines that aren't at the beginning or end of the caption cause
 554 multiple lines of text to be produced.
 555
 556 The --foreground and --background options can be used to set colors
 557 for this.  By default black text on a white background is produced.
 558
 559 =back
 560
 561 =head1 GENERAL OPTIONS
 562
 563 =over
 564
 565 =item --help
 566
 567 Display the SYNOPSIS from this POD
 568
 569 =item --verbose
 570
 571 =item -v
 572
 573 Increase the verbosity level.
 574
 575 =item --backup <extension>
 576
 577 =item -i <extension>
 578
 579 Input files are renamed to I<filename><extension> before the output
 580 file is written.
 581
 582 =item --directory <directory>
 583
 584 =item -d <directory>
 585
 586 If this is supplied the output files are written to this directory
 587 instead of the
 588
 589 =item --type <fileformat>
 590
 591 Specifies an output file format
 592
 593 =item --write-option name=value
 594
 595 =item --wo name=value
 596
 597 Sets the value of an option supplied to the Imager write() function.
 598 The options available depend on the file format, see
 599 L<Imager::Files/TYPE SPECIFIC INFORMATION> for file format specific
 600 options.
 601
 602 You can also supply the L<Imager::ImageTypes/Common Tags>.
 603
 604 If you're writing to a gif file you can also supply the options
 605 documented as tags under L<Imager::ImageTypes/Quantization options>.
 606
 607 =back
 608
 609 =head1 PROCESSING OPTIONS
 610
 611 These supply extra parameters to the actions
 612
 613 =over
 614
 615 =item --background <color-spec>
 616
 617 =item --bg <color-spec>
 618
 619 Sets the background color for the --rotate and --caption actions, and
 620 possibly other actions in the future.
 621
 622 See $0 --help-color-spec for possible color specifications.
 623
 624   --bg red
 625   --bg rgba(0,0,0,0)
 626
 627 =item --foreground <color-spec>
 628
 629 =item --fg <color-spec>
 630
 631 Sets the foreground color for the --caption action, and possibly other
 632 actions in the future.
 633
 634 See $0 --help-color-spec for possible color specifications.
 635
 636   --fg red
 637   --fg 'rgba(0,0,0,0)'
 638
 639 =item --font-size size
 640
 641 =item --fs size
 642
 643 Set the font size used by the --caption command, in pixels.
 644
 645   --fs 16  # 16 pixels from baseline to top
 646   --font-size 40 # a bit bigger
 647
 648 =item --info-format format
 649
 650 Sets the format for the output of the --info command.
 651
 652 The format can contain printf style replacement codes, each value is %
 653 followed by a sprintf() field width/precision, followed by the value
 654 code.
 655
 656 The following values can be output:
 657   w - image width in pixels
 658   h - image height in pixels
 659   f - full image filename
 660   b - base image filename
 661   c - number of channels
 662   t - image type (direct vs paletted)
 663   n - inserts a newline
 664   % - inserts a '%' symbol
 665
 666 The default format is:
 667
 668  Image: %f%nDimensions: %ww x %hh%nChannels: %c%nType: %t%n
 669
 670 You can use field widths to produce a more table like appearance:
 671
 672   im --info-format '%4w %4h %4c %-8t %b%n' --info *.jpg
 673
 674 =item --font filename
 675
 676 Gives the name of a font file.  Required by actions that render text.
 677
 678   --font ImUgly.ttf
 679   --font arial.ttf
 680
 681 =back
 682
 683 =head1 COLOR SPECIFICATIONS
 684
 685 Possible color specifications:
 686   color-name - the name of a built-in color
 687   rgb(red,green,blue) - as an RGB triplet
 688   #RRGGBB - as a HTML RGB hex triple
 689   #RGB - as a HTML CSS RGB hex triple
 690   rgba(red,green,blue,alpha) - as an RGBA quad
 691   hsv(hue,sat,value) - as an HSV triplet
 692   hsva(hue,sat,value,alpha) as an HSVA quad
 693
 694 For example:
 695
 696   red
 697   rgb(255,0,0)
 698   #FF0000
 699   hsv(180,1,1)
 700
 701 If you use either of the HTML color specifications, or a specification
 702 using parentheses from a Unix shell you will need to quote it, for
 703 example:
 704
 705   --fg '#FF0000'
 706   --bg 'rgb(255,0,255)'
 707
 708 =head1 AUTHOR
 709
 710 Tony Cook <tony@develop-help.com>
 711
 712 =cut