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 val_scale {
 225   my ($option, $value) = @_;
 226
 227   my %options;
 228   if ($option =~ /^(\d+)\s*x\s*(\d+)$/i) {
 229     return { xpixels=>$1, ypixels=>$2 };
 230   }
 231   elsif ($option =~ /^(\d+(?:\.\d*)?|\.\d+)$/) {
 232     return { scalefactor => $option };
 233   }
 234   elsif ($option =~ /^(\d+)\s*x\s*(\d+)\s*min$/i) {
 235     return { xpixels=>$1, ypixels=>$2, type=>'min' };
 236   }
 237   elsif ($option =~ /^(\d+)\s*(?:w|wide)$/i) {
 238     return { xpixels => $1 };
 239   }
 240   elsif ($option =~ /^(\d+)\s*(?:h|high)$/i) {
 241     return { ypixels => $1 };
 242   }
 243   else {
 244     die "Invalid parameter to --scale, try $0 --help-scale\n";
 245   }
 246 }
 247
 248 sub req_scale {
 249   my ($im, $args) = @_;
 250
 251   return $im->scale(%$args);
 252 }
 253
 254 sub val_rotate {
 255   my ($option, $value) = @_;
 256
 257   if ($value =~ /^[-+]?(?:\d+(?:\.\d*)|\.\d+)$/) {
 258     return { degrees => $value };
 259   }
 260   elsif ($value =~ /^([-+]?(?:\d+(?:\.\d*)|\.\d+))\s*(?:r|radians)$/i) {
 261     return { radians => $1 };
 262   }
 263   else {
 264     die "Invalid parameter to --rotate, try $0 --help-rotate\n";
 265   }
 266 }
 267
 268 sub req_rotate {
 269   my ($im, $args, $state) = @_;
 270
 271   my @moreargs;
 272   if ($state->{background}) {
 273     push @moreargs, back => $state->{background};
 274   }
 275   return $im->rotate(%$args, @moreargs);
 276 }
 277
 278 sub req_bg {
 279   my ($im, $value, $state) = @_;
 280
 281   $state->{background} = $value;
 282
 283   $im;
 284 }
 285
 286 sub req_fg {
 287   my ($im, $value, $state) = @_;
 288
 289   $state->{foreground} = $value;
 290
 291   $im;
 292 }
 293
 294 sub req_font {
 295   my ($im, $value, $state) = @_;
 296
 297   $state->{font} = Imager::Font->new(file=>$value)
 298     or die "Could not create font from $value: ", Imager->errstr,"\n";
 299
 300   $im;
 301 }
 302
 303 sub val_font_size {
 304   my ($option, $value) = @_;
 305
 306   unless ($value =~ /^\d+$/ && $value > 0) {
 307     die "$option must be a positive integer\n";
 308   }
 309
 310   $value;
 311 }
 312
 313 sub req_font_size {
 314   my ($im, $value, $state) = @_;
 315
 316   $state->{font_size} = $value;
 317
 318   $im;
 319 }
 320
 321 sub req_caption {
 322   my ($im, $format, $state) = @_;
 323
 324   my $text = _replace_codes($im, $state, $format);
 325
 326   my $font = $state->{font}
 327     or die "You must supply a --font option before the --caption command\n";
 328
 329   my $size = $state->{font_size} || 16;
 330
 331   my $box = $font->bounding_box(size=>$size);
 332   $box->total_width <= $im->getwidth
 333     or die "Caption text '$text' is wider (", $box->total_width,
 334       ") than the image (",$im->getwidth,")\n";
 335
 336   die "not implemented yet";
 337 }
 338
 339 sub usage {
 340   help_on("SYNOPSIS");
 341   exit 1;
 342 }
 343
 344 sub im_functions {
 345   return
 346     (
 347      info => [ \&req_info ],
 348      tags => [ \&req_tags ],
 349      scale => [ \&req_scale, \&val_scale ],
 350      rotate => [ \&req_rotate, \&val_rotate ],
 351      caption => [ \&req_caption ],
 352     );
 353 }
 354
 355 sub val_color {
 356   my ($option, $value) = @_;
 357
 358   if ($value =~ /^rgba\((\d+),(\d+),(\d+),(\d+)\)$/i) {
 359     return Imager::Color->new($1,$2,$3,$4);
 360   }
 361   elsif ($value =~ /^rgb\((\d+),(\d+),(\d+)\)$/i) {
 362     return Imager::Color->new($1,$2,$3);
 363   }
 364   elsif ($value =~ /^\#[\da-f]{3}([\da-f]{3})?$/) {
 365     return Imager::Color->new(web=>$value);
 366   }
 367   elsif ($value =~ /^hsv\((\d+(?:\.\d*)),(\d+\.\d*|\.\d+),(\d+\.\d*|\.\d+)\)$/) {
 368     return Imager::Color->new(hsv => [ $1, $2, $3 ]);
 369   }
 370   elsif ($value =~ /^hsva\((\d+(?:\.\d*)),(\d+\.\d*|\.\d+),(\d+\.\d*|\.\d+),(\d+)\)$/) {
 371     return Imager::Color->new(hsv => [ $1, $2, $3 ], alpha=>$4);
 372   }
 373   else {
 374     my $color = Imager::Color->new(name=>$value);
 375     return $color if $color;
 376
 377     die "Unrecognized color specification $value supplied to --$option\n";
 378   }
 379 }
 380
 381 sub im_options {
 382   return
 383     (
 384      background => [ \&req_bg, \&val_color, 'bg' ],
 385      foreground => [ \&req_fg, \&val_color, 'fg' ],
 386      'info-format' => [ \&req_info_format, 's'],
 387      font => [ \&req_font, \&val_font ],
 388      'font-size' => [ \&req_font_size, \&val_font_size, 'fs' ],
 389     );
 390 }
 391
 392 sub help_on {
 393   my ($topic) = @_;
 394
 395   open SOURCE, "< $0" or die "Cannot read source for help text: $!\n";
 396   my @lines;
 397   while (<SOURCE>) {
 398     # don't chomp it
 399     if (/^=item --$topic\s/) {
 400       push @lines, $_;
 401       # read any more =items then read text until we see =item or =back
 402       while (<SOURCE>) {
 403         last unless /^\s*$/ or /^=item /;
 404         push @lines, $_;
 405       }
 406       push @lines, $_;
 407       # and any other until another option or =back
 408       while (<SOURCE>) {
 409         last if /^=(item|cut|back)/;
 410         push @lines, $_;
 411       }
 412       print @lines;
 413       return;
 414     }
 415     elsif (/^=head(\d) $topic\s*$/i) {
 416       my $level = $1;
 417       push @lines, $_;
 418       while (<SOURCE>) {
 419         last if /=head[1-$level]/;
 420         push @lines, $_;
 421       }
 422
 423       print @lines;
 424       return;
 425     }
 426   }
 427   close SOURCE;
 428
 429   die "No help topic $topic found\n";
 430 }
 431
 432
 433 sub help_color_spec {
 434   print <<EOS;
 435 EOS
 436 }
 437
 438 =head1 NAME
 439
 440 imager - Imager command-line image manipulation tool
 441
 442 =head1 SYNOPSIS
 443
 444  imager --help
 445  imager  [--font-size <size>] [--fs <size>] [--background <color>]
 446     [--bg <color>] [--foreground <color>] [--fg <color]
 447     [--info-format <format>] [--rotate <angle>] [--scale <scale-spec>]
 448     [--caption <text>] [--info] [--tags] [--font fontfile] files ...
 449  imager --help-I<option>
 450  imager --help-I<operation>
 451  imager --help-options
 452  imager --help-actions
 453  imager --help-general
 454
 455 =head1 DESCRIPTION
 456
 457 =head1 ACTIONS
 458
 459 =over
 460
 461 =item --info
 462
 463 Displays the width, height, channels, type for each image, and any tags
 464 Imager picks up.  No options.
 465
 466 Note: Imager still converts many files into direct images when the source
 467 is a paletted image, so the displayed image type may not match the
 468 source image type.
 469
 470 No output image file is produced.
 471
 472 =item --tags
 473
 474 Displays all the tags the Imager reader for that format sets for each
 475 file.
 476
 477 See L<Imager::Files> for file format specific tags and
 478 L<Imager::ImageTypes> for common tags.
 479
 480 =item --scale <scalefactor>
 481
 482 =item --scale <width>x<height>
 483
 484 =item --scale <width>x<height>min
 485
 486 =item --scale <width>w
 487
 488 =item --scale <height>h
 489
 490 Scale either by the given scaling factor, given as a floating point number,
 491 or to a given dimension.
 492
 493 The scaling is always proportional, if a dimension is given then the
 494 scalefactor that results in the larger image that matches either the
 495 specified width or height is chosen, unless the word "min" is present".
 496
 497   --scale 0.5         # half size image
 498   --scale 100x100     # aim for 100 pixel x 100 pixel image
 499   --scale 100x100min  # image that fits in 100 x 100 pixel box
 500   --scale 100w        # 100 pixel wide image
 501   --scale 100h        # 100 pixel high image
 502
 503 =item --rotate <degrees>
 504
 505 =item --rotate <radians>r
 506
 507 Rotate the image by the given number of degrees or radians.
 508
 509 =item --help
 510
 511 Displays the usage message if no extra parameter is found, otherwise displays
 512 more detailed help for the given function, if any.
 513
 514 =item --caption text
 515
 516 Expands the image to create a caption area and draws the given text in the
 517 current font.
 518
 519 You must set a font with --font before this.
 520
 521   imager --font arial.ttf --caption "my silly picture"
 522
 523 The text has the same replacements done as the --info command.
 524
 525   imager --font arial.ttf --caption '%b - %w x %h'
 526
 527 If the caption text is too wide for the image an error is produced.
 528
 529 Any newlines that aren't at the beginning or end of the caption cause
 530 multiple lines of text to be produced.
 531
 532 The --foreground and --background options can be used to set colors
 533 for this.  By default black text on a white background is produced.
 534
 535 =back
 536
 537 =head1 GENERAL OPTIONS
 538
 539 =over
 540
 541 =item --help
 542
 543 Display the SYNOPSIS from this POD
 544
 545 =item --verbose
 546
 547 =item -v
 548
 549 Increase the verbosity level.
 550
 551 =item --backup <extension>
 552
 553 =item -i <extension>
 554
 555 Input files are renamed to I<filename><extension> before the output
 556 file is written.
 557
 558 =item --directory <directory>
 559
 560 =item -d <directory>
 561
 562 If this is supplied the output files are written to this directory
 563 instead of the
 564
 565 =item --type <fileformat>
 566
 567 Specifies an output file format
 568
 569 =item --write-option name=value
 570
 571 =item --wo name=value
 572
 573 Sets the value of an option supplied to the Imager write() function.
 574 The options available depend on the file format, see
 575 L<Imager::Files/TYPE SPECIFIC INFORMATION> for file format specific
 576 options.
 577
 578 You can also supply the L<Imager::ImageTypes/Common Tags>.
 579
 580 If you're writing to a gif file you can also supply the options
 581 documented as tags under L<Imager::ImageTypes/Quantization options>.
 582
 583 =back
 584
 585 =head1 PROCESSING OPTIONS
 586
 587 These supply extra parameters to the actions
 588
 589 =over
 590
 591 =item --background <color-spec>
 592
 593 =item --bg <color-spec>
 594
 595 Sets the background color for the --rotate and --caption actions, and
 596 possibly other actions in the future.
 597
 598 See $0 --help-color-spec for possible color specifications.
 599
 600   --bg red
 601   --bg rgba(0,0,0,0)
 602
 603 =item --foreground <color-spec>
 604
 605 =item --fg <color-spec>
 606
 607 Sets the foreground color for the --caption action, and possibly other
 608 actions in the future.
 609
 610 See $0 --help-color-spec for possible color specifications.
 611
 612   --fg red
 613   --fg 'rgba(0,0,0,0)'
 614
 615 =item --font-size size
 616
 617 =item --fs size
 618
 619 Set the font size used by the --caption command, in pixels.
 620
 621   --fs 16  # 16 pixels from baseline to top
 622   --font-size 40 # a bit bigger
 623
 624 =item --info-format format
 625
 626 Sets the format for the output of the --info command.
 627
 628 The format can contain printf style replacement codes, each value is %
 629 followed by a sprintf() field width/precision, followed by the value
 630 code.
 631
 632 The following values can be output:
 633   w - image width in pixels
 634   h - image height in pixels
 635   f - full image filename
 636   b - base image filename
 637   c - number of channels
 638   t - image type (direct vs paletted)
 639   n - inserts a newline
 640   % - inserts a '%' symbol
 641
 642 The default format is:
 643
 644  Image: %f%nDimensions: %ww x %hh%nChannels: %c%nType: %t%n
 645
 646 You can use field widths to produce a more table like appearance:
 647
 648   im --info-format '%4w %4h %4c %-8t %b%n' --info *.jpg
 649
 650 =item --font filename
 651
 652 Gives the name of a font file.  Required by actions that render text.
 653
 654   --font ImUgly.ttf
 655   --font arial.ttf
 656
 657 =back
 658
 659 =head1 COLOR SPECIFICATIONS
 660
 661 Possible color specifications:
 662   color-name - the name of a built-in color
 663   rgb(red,green,blue) - as an RGB triplet
 664   #RRGGBB - as a HTML RGB hex triple
 665   #RGB - as a HTML CSS RGB hex triple
 666   rgba(red,green,blue,alpha) - as an RGBA quad
 667   hsv(hue,sat,value) - as an HSV triplet
 668   hsva(hue,sat,value,alpha) as an HSVA quad
 669
 670 For example:
 671
 672   red
 673   rgb(255,0,0)
 674   #FF0000
 675   hsv(180,1,1)
 676
 677 If you use either of the HTML color specifications, or a specification
 678 using parentheses from a Unix shell you will need to quote it, for
 679 example:
 680
 681   --fg '#FF0000'
 682   --bg 'rgb(255,0,255)'
 683
 684 =head1 AUTHOR
 685
 686 Tony Cook <tony@develop-help.com>
 687
 688 =cut