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