Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

executable file 714 lines (529 sloc) 15.981 kb
#!/usr/bin/perl -w
use strict;
use Imager;
use Getopt::Long;
use File::Spec;
use File::Basename qw(basename);
use vars qw($VERSION);
$VERSION="0.01_00";
my $help;
my $verbose;
my $backup; # backup extension name
my $directory; # output directory
my $output;
my $type;
my %write_opts; # options supplied to write()
my $understand;
my @collection; # actions/options in order to allow us to set values as needed
# each entry consists of:
# - ref to action/option handler function
# - help text
# - optional ref to value parser function
my %funcs = im_functions();
my %options = im_options();
my %all = ( %funcs, %options );
my $action_func =
sub {
my ($option, $value) = @_;
if ($all{$option}[1] && ref $all{$option}[1]) {
$value = $all{$option}[1]->($option, $value);
}
push @collection, [ $option, $value ]
};
my $did_help;
my $help_func =
sub {
my ($option) = @_;
$option =~ s/help-//;
help_on($option);
++$did_help;
};
my @getoptions;
for my $option_name (keys %all) {
my $option = $all{$option_name};
my @names = ( $option_name );
my @other_names = split /\|/, $option->[2] if $option->[2];
push @names, @other_names;
my $code = '';
if ($option->[1]) {
$code = ref $option->[1] ? "=s" : "=".$option->[1];
}
push @getoptions, join("|", @names) . $code => $action_func;
# this would be evil $all{$_} = $option for @other_names;
push @getoptions, join("|", map "help-$_", @names) => $help_func;
}
GetOptions('help' => sub { $help_func->("synopsis") },
'verbose|v+' => \$verbose,
'backup|i=s' => \$backup,
'directory|d=s' => \$directory,
'type|t=s' => \$type, # output file type
'write-option|wo=s' => \%write_opts,
'output|o=s' => \$output,
'understand' => \$understand,
@getoptions,
'help-color-spec' => sub { $help_func->("color specifications") },
'help-actions' => sub { $help_func->("actions") },
'help-options' => sub { $help_func->("processing options") },
'help-general' => sub { $help_func->("general options") },
)
or usage();
$did_help and exit;
unless ($understand) {
die <<EOS;
This tool is under-tested and will probably destroy your data.
If you understand and agree with this use the --understand option to
avoid this message.
In fact, only the --info and --tags actions have been used at all.
EOS
}
exists $write_opts{file}
and die "Illegal write option 'file'\n";
exists $write_opts{type}
and die "Use the --type option to set the output format\n";
delete $write_opts{qw/file fd fh data callback/};
my @actions = grep $funcs{$_->[0]}, @collection;
if ($help) {
if (@actions) {
print $funcs{$_}[1] for map $_->[0], @actions;
exit;
}
else {
usage();
}
}
if (!@actions && !@ARGV) {
usage();
}
unless (@ARGV) {
die "No files to process\n";
}
unless (@actions) {
die "Nothing to do, supply at least one action, see $0 --help\n";
}
my @type;
push @type, type => $type if $type;
for my $name (@ARGV) {
my $im = Imager->new;
if ($im->read(file=>$name)) {
my %state = ( filename => $name );
for my $action (@collection) {
$im = $all{$action->[0]}[0]->($im, $action->[1], \%state);
last unless $im;
}
if ($im) {
my $outname = $name;
if ($directory) {
my $file;
(undef, undef, $file) = File::Spec->split_path($outname);
$outname = File::Spec->catfile($directory, $file);
}
if ($backup) {
my $backfile = $name . $backup;
rename $name, $backfile
or die "Couldn't rename source '$name' to backup '$backfile': $!\n";
}
unless ($im->write(file=>$outname, @type)) {
die "Could not write result from '$name' to '$outname': ", $im->errstr,"\n";
}
}
}
else {
print STDERR "Failed reading $name: ",$im->errstr,"\n";
}
}
sub _replace_codes {
my ($im, $state, $format) = @_;
my %replace =
(
f => [ 's', $state->{filename} ],
b => [ 's', basename($state->{filename}) ],
w => [ 'd', $im->getwidth ],
h => [ 'd', $im->getheight ],
c => [ 'd', $im->getchannels ],
t => [ 's', $im->type ],
n => [ 'c', ord("\n") ], # a bit of a hack
'%' => [ '%' ],
);
my @values;
$format =~ s{%(-?(?:\d+(?:\.\d*)?|\.\d+)?)([fwhctbn%])}
{
my $which = $replace{$2};
push @values, @$which[1..$#$which];
"%$1$which->[0]"
}eg;
return sprintf $format, @values;
}
sub req_info {
my ($im, $ignored, $state) = @_;
my $format = $state->{info_format} || <<EOS;
Image: %f
Dimensions: %ww x %hh
Channels: %c
Type: %t
EOS
print _replace_codes($im, $state, $format);
return;
}
sub req_info_format {
my ($im, $value, $state) = @_;
$state->{info_format} = $value;
$im;
}
sub req_tags {
my ($im, $ignored, $state) = @_;
print $state->{filename},"\n";
my @tags = $im->tags;
for my $tag (sort { $a->[0] cmp $b->[0] } @tags) {
my $name = shift @$tag;
print " $name: @$tag\n";
}
return;
}
sub req_palette {
my ($im, $ignored, $state) = @_;
print $state->{filename},"\n";
if ($im->type eq 'direct') {
print " No palette - this is a direct color image\n";
}
else {
my @colors = $im->getcolors;
for my $index (0..$#colors) {
printf "%3d: (%3d, %3d, %3d)\n", $index, ($colors[$index]->rgba)[0..2];
}
}
return;
}
sub val_scale {
my ($option, $value) = @_;
my %options;
if ($option =~ /^(\d+)\s*x\s*(\d+)$/i) {
return { xpixels=>$1, ypixels=>$2 };
}
elsif ($option =~ /^(\d+(?:\.\d*)?|\.\d+)$/) {
return { scalefactor => $option };
}
elsif ($option =~ /^(\d+)\s*x\s*(\d+)\s*min$/i) {
return { xpixels=>$1, ypixels=>$2, type=>'min' };
}
elsif ($option =~ /^(\d+)\s*(?:w|wide)$/i) {
return { xpixels => $1 };
}
elsif ($option =~ /^(\d+)\s*(?:h|high)$/i) {
return { ypixels => $1 };
}
else {
die "Invalid parameter to --scale, try $0 --help-scale\n";
}
}
sub req_scale {
my ($im, $args) = @_;
return $im->scale(%$args);
}
sub val_rotate {
my ($option, $value) = @_;
if ($value =~ /^[-+]?(?:\d+(?:\.\d*)|\.\d+)$/) {
return { degrees => $value };
}
elsif ($value =~ /^([-+]?(?:\d+(?:\.\d*)|\.\d+))\s*(?:r|radians)$/i) {
return { radians => $1 };
}
else {
die "Invalid parameter to --rotate, try $0 --help-rotate\n";
}
}
sub req_rotate {
my ($im, $args, $state) = @_;
my @moreargs;
if ($state->{background}) {
push @moreargs, back => $state->{background};
}
return $im->rotate(%$args, @moreargs);
}
sub req_bg {
my ($im, $value, $state) = @_;
$state->{background} = $value;
$im;
}
sub req_fg {
my ($im, $value, $state) = @_;
$state->{foreground} = $value;
$im;
}
sub req_font {
my ($im, $value, $state) = @_;
$state->{font} = Imager::Font->new(file=>$value)
or die "Could not create font from $value: ", Imager->errstr,"\n";
$im;
}
sub val_font_size {
my ($option, $value) = @_;
unless ($value =~ /^\d+$/ && $value > 0) {
die "$option must be a positive integer\n";
}
$value;
}
sub req_font_size {
my ($im, $value, $state) = @_;
$state->{font_size} = $value;
$im;
}
sub req_caption {
my ($im, $format, $state) = @_;
my $text = _replace_codes($im, $state, $format);
my $font = $state->{font}
or die "You must supply a --font option before the --caption command\n";
my $size = $state->{font_size} || 16;
my $box = $font->bounding_box(size=>$size);
$box->total_width <= $im->getwidth
or die "Caption text '$text' is wider (", $box->total_width,
") than the image (",$im->getwidth,")\n";
die "not implemented yet";
}
sub usage {
help_on("SYNOPSIS");
exit 1;
}
sub im_functions {
return
(
info => [ \&req_info ],
tags => [ \&req_tags ],
palette => [ \&req_palette ],
scale => [ \&req_scale, \&val_scale ],
rotate => [ \&req_rotate, \&val_rotate ],
# caption => [ \&req_caption ], # not done yet
);
}
sub val_color {
my ($option, $value) = @_;
if ($value =~ /^rgba\((\d+),(\d+),(\d+),(\d+)\)$/i) {
return Imager::Color->new($1,$2,$3,$4);
}
elsif ($value =~ /^rgb\((\d+),(\d+),(\d+)\)$/i) {
return Imager::Color->new($1,$2,$3);
}
elsif ($value =~ /^\#[\da-f]{3}([\da-f]{3})?$/) {
return Imager::Color->new(web=>$value);
}
elsif ($value =~ /^hsv\((\d+(?:\.\d*)),(\d+\.\d*|\.\d+),(\d+\.\d*|\.\d+)\)$/) {
return Imager::Color->new(hsv => [ $1, $2, $3 ]);
}
elsif ($value =~ /^hsva\((\d+(?:\.\d*)),(\d+\.\d*|\.\d+),(\d+\.\d*|\.\d+),(\d+)\)$/) {
return Imager::Color->new(hsv => [ $1, $2, $3 ], alpha=>$4);
}
else {
my $color = Imager::Color->new(name=>$value);
return $color if $color;
die "Unrecognized color specification $value supplied to --$option\n";
}
}
sub im_options {
return
(
background => [ \&req_bg, \&val_color, 'bg' ],
foreground => [ \&req_fg, \&val_color, 'fg' ],
'info-format' => [ \&req_info_format, 's'],
font => [ \&req_font, \&val_font ],
'font-size' => [ \&req_font_size, \&val_font_size, 'fs' ],
);
}
sub help_on {
my ($topic) = @_;
open SOURCE, "< $0" or die "Cannot read source for help text: $!\n";
my @lines;
while (<SOURCE>) {
# don't chomp it
if (/^=item --$topic\s/) {
push @lines, $_;
# read any more =items then read text until we see =item or =back
while (<SOURCE>) {
last unless /^\s*$/ or /^=item /;
push @lines, $_;
}
push @lines, $_;
# and any other until another option or =back
while (<SOURCE>) {
last if /^=(item|cut|back)/;
push @lines, $_;
}
print @lines;
return;
}
elsif (/^=head(\d) $topic\s*$/i) {
my $level = $1;
push @lines, $_;
while (<SOURCE>) {
last if /=head[1-$level]/;
push @lines, $_;
}
print @lines;
return;
}
}
close SOURCE;
die "No help topic $topic found\n";
}
sub help_color_spec {
print <<EOS;
EOS
}
=head1 NAME
imager - Imager command-line image manipulation tool
=head1 SYNOPSIS
imager --help
imager [--font-size <size>] [--fs <size>] [--background <color>]
[--bg <color>] [--foreground <color>] [--fg <color]
[--info-format <format>] [--rotate <angle>] [--scale <scale-spec>]
[--caption <text>] [--info] [--tags] [--font fontfile] files ...
imager --help-I<option>
imager --help-I<operation>
imager --help-options
imager --help-actions
imager --help-general
imager --help-colorspec
=head1 DESCRIPTION
=head1 ACTIONS
=over
=item --info
Displays the width, height, channels, type for each image, and any tags
Imager picks up. No options.
Note: Imager still converts many files into direct images when the source
is a paletted image, so the displayed image type may not match the
source image type.
No output image file is produced.
=item --tags
Displays all the tags the Imager reader for that format sets for each
file.
See L<Imager::Files> for file format specific tags and
L<Imager::ImageTypes> for common tags.
=item --palette
Dumps the palette of the given file, if it is an indexed image.
=item --scale <scalefactor>
=item --scale <width>x<height>
=item --scale <width>x<height>min
=item --scale <width>w
=item --scale <height>h
Scale either by the given scaling factor, given as a floating point number,
or to a given dimension.
The scaling is always proportional, if a dimension is given then the
scalefactor that results in the larger image that matches either the
specified width or height is chosen, unless the word "min" is present".
--scale 0.5 # half size image
--scale 100x100 # aim for 100 pixel x 100 pixel image
--scale 100x100min # image that fits in 100 x 100 pixel box
--scale 100w # 100 pixel wide image
--scale 100h # 100 pixel high image
=item --rotate <degrees>
=item --rotate <radians>r
Rotate the image by the given number of degrees or radians.
=item --help
Displays the usage message if no extra parameter is found, otherwise displays
more detailed help for the given function, if any.
=item --caption text
Not implemented yet.
Expands the image to create a caption area and draws the given text in the
current font.
You must set a font with --font before this.
imager --font arial.ttf --caption "my silly picture"
The text has the same replacements done as the --info command.
imager --font arial.ttf --caption '%b - %w x %h'
If the caption text is too wide for the image an error is produced.
Any newlines that aren't at the beginning or end of the caption cause
multiple lines of text to be produced.
The --foreground and --background options can be used to set colors
for this. By default black text on a white background is produced.
=back
=head1 GENERAL OPTIONS
=over
=item --help
Display the SYNOPSIS from this POD
=item --verbose
=item -v
Increase the verbosity level.
=item --backup <extension>
=item -i <extension>
Input files are renamed to I<filename><extension> before the output
file is written.
=item --directory <directory>
=item -d <directory>
If this is supplied the output files are written to this directory
instead of the
=item --type <fileformat>
Specifies an output file format
=item --write-option name=value
=item --wo name=value
Sets the value of an option supplied to the Imager write() function.
The options available depend on the file format, see
L<Imager::Files/TYPE SPECIFIC INFORMATION> for file format specific
options.
You can also supply the L<Imager::ImageTypes/Common Tags>.
If you're writing to a gif file you can also supply the options
documented as tags under L<Imager::ImageTypes/Quantization options>.
=back
=head1 PROCESSING OPTIONS
These supply extra parameters to the actions
=over
=item --background <color-spec>
=item --bg <color-spec>
Sets the background color for the --rotate and --caption actions, and
possibly other actions in the future.
See $0 --help-color-spec for possible color specifications.
--bg red
--bg rgba(0,0,0,0)
=item --foreground <color-spec>
=item --fg <color-spec>
Sets the foreground color for the --caption action, and possibly other
actions in the future.
See $0 --help-color-spec for possible color specifications.
--fg red
--fg 'rgba(0,0,0,0)'
=item --font-size size
=item --fs size
Set the font size used by the --caption command, in pixels.
--fs 16 # 16 pixels from baseline to top
--font-size 40 # a bit bigger
=item --info-format format
Sets the format for the output of the --info command.
The format can contain printf style replacement codes, each value is %
followed by a sprintf() field width/precision, followed by the value
code.
The following values can be output:
w - image width in pixels
h - image height in pixels
f - full image filename
b - base image filename
c - number of channels
t - image type (direct vs paletted)
n - inserts a newline
% - inserts a '%' symbol
The default format is:
Image: %f%nDimensions: %ww x %hh%nChannels: %c%nType: %t%n
You can use field widths to produce a more table like appearance:
im --info-format '%4w %4h %4c %-8t %b%n' --info *.jpg
=item --font filename
Gives the name of a font file. Required by actions that render text.
--font ImUgly.ttf
--font arial.ttf
=back
=head1 COLOR SPECIFICATIONS
Possible color specifications:
color-name - the name of a built-in color
rgb(red,green,blue) - as an RGB triplet
#RRGGBB - as a HTML RGB hex triple
#RGB - as a HTML CSS RGB hex triple
rgba(red,green,blue,alpha) - as an RGBA quad
hsv(hue,sat,value) - as an HSV triplet
hsva(hue,sat,value,alpha) as an HSVA quad
For example:
red
rgb(255,0,0)
#FF0000
hsv(180,1,1)
If you use either of the HTML color specifications, or a specification
using parentheses from a Unix shell you will need to quote it, for
example:
--fg '#FF0000'
--bg 'rgb(255,0,255)'
=head1 AUTHOR
Tony Cook <tony@develop-help.com>
=cut
Jump to Line
Something went wrong with that request. Please try again.