Re: Командная строка на службе фотографа-линуксоида

Недавно опубликована статья «Командная строка на службе фотографа-линуксоида», где автор пишет о решении разных типовых задач, встающих перед фотографом-линуксоидом, но он рассмотрел явно не всё.

Первая, а точнее, нулевая задача — скопировать изображения. Казалось бы, в ней нет чего-то такого, что бы подлежало оптимизации и автоматизации: всегда можно нажать F5 в mc либо перетащить файлы мышкой или же воспользоваться каким-нибудь менеджером фотографий наподобие digiKam. Можно — но не нужно: слишком много лишних движений. Фотографу-линуксоиду (а точнее, линуксоиду, время от времени занимающемуся фотографией) обычно надо лишь забрать фотографии с карты памяти, аккуратно сложить их на жёсткий диск, рассортировав, например, по времени съёмки и, если лишние буквы раздражают взгляд, убрать их.

Другая задача, о которой говорили в комментариях — пакетное уменьшение фотографий и их подписывание. Один из методов — использовать ImageMagick, к которому доступны различные интерфейсы: как интерфейс командной строки (программы convert, mogrify, montage), так и API для различных языков программирования. В случае с перлом — модуль Image::Magick. ImageMagick позволит и уменьшить фотографию, и подписать её.

Я подобные задачи автоматизировал следующим образом:


Перенос фотографий:

#!/usr/bin/perl -wl

use strict;
use File::Find;
use File::Path qw(make_path);
use File::Copy;
use Image::ExifTool qw(:Public);

# You can change these variables

my $PATH_SRC  = '/media/NIKON/DCIM'; # path to memory card
my $PATH_DST  = $ENV{'HOME'} . '/photo'; # path to destination. Don't use ~ for your homedir
my $PRECISION = 2;    # 0 for year .. 5 for second
my $MODE      = 0644; # for chmod

# Don't touch the rest of file

find( \&wanted, $PATH_SRC );

sub wanted {
    return unless /\.jpg/i;
    my $new_name = lc $_;
       $new_name =~ s/^\D+//;

    my $info = ImageInfo( $File::Find::name );
    my @date = split /\D+/, $info->{'DateTimeOriginal'};
      $#date = $PRECISION;
    my $new_dir = join '/', $PATH_DST, @date;

    make_path $new_dir
        unless -d $new_dir;

    my $new_path = "$new_dir/$new_name";

    -d  $new_dir
    and move $File::Find::name, $new_path
    and chmod $MODE, $new_path
    and print "$File::Find::name => $new_path";
} # sub wanted

Уменьшение и подписывание:

#!/usr/bin/perl -w
use strict;

use Image::ExifTool ':Public';
use Image::Magick;
use Getopt::Long;

# Constants
my %preferred_fonts = (
    'date' => [ qw/ DejaVuSans  DejaVu-Sans Bitstream-Vera-Sans BitstreamVeraSans Verdana / ], # Normal width
    'name' => [ qw/ DejaVuSansC DejaVu-Sans-Condensed Tahoma / ], # Narrow
    'site' => [ qw/ DejaVuSansB BitstreamVeraSansB VerdanaB TahomaB / ], # Bold
);

my $color  = '#fff2';
my $gap    = 10;
my $name   = (getpwuid $>)[6];
   $name   =~ s/,+$//;
my $prefix = 'small.';
my $site   = 'your-site.ru';
my $size   = '50%';


# Override with options
GetOptions(
    'color:s'   => \$color,
    'gap:i'     => \$gap,
    'name:s'    => \$name,
    'prefix:s'  => \$prefix,
    'site:s'    => \$site,
    'size:s'    => \$size,
);


# Try to find suitable fonts
my $image = new Image::Magick;
my @available_fonts = $image->QueryFont();
my ( %seen, %fonts );
map { $seen{$_} = 1 } @available_fonts;

while ( my ( $scope, $list ) = each %preferred_fonts ) {
    foreach ( @$list ) {
        $fonts{ $scope } = $_
            and last
            if $seen{$_};
    } # foreach
} # while


foreach my $file ( @ARGV ) {
    my $info = ImageInfo($file, 'CreateDate');
    my $date = $$info{'CreateDate'};
    my $new_file_name = $file;
    $new_file_name =~ s{([^/]+)$}{$prefix$1};

    $date =~ s/^(\d{4}):(\d{2}):(\d{2}).*/$3.$2.$1/;

    my $p = new Image::Magick or next;
    $p->Read( $file );
    $p->AutoOrient;
    $p->Resize(
        'geometry'  => $size,
        'filter'    => 'Lanczos',
        'blur'      => 0.5,
    );
    my ( $width, $height ) = $p->Get('width', 'height');
    my ( $x, $y ) = ( $width - $gap, $height - $gap );

    $p->Set(
        'pointsize'     => 12,
        'fill'          => $color,
    );


    $p->Annotate(
        'font'          => $fonts{'name'},
        'text'          => $name,
        'rotate'        => -90,
        'x'             => $x,
        'y'             => $y,
    );

    $y -= (
        $p->QueryFontMetrics(
            'font'          => $fonts{'name'},
            'text'          => $name,
        )
    )[4] + $gap;

    $p->Annotate(
        'font'          => $fonts{'site'},
        'text'          => $site,
        'rotate'        => -90,
        'x'             => $x,
        'y'             => $y,
    );

    $y -= (
        $p->QueryFontMetrics(
            'font'          => $fonts{'site'},
            'text'          => $site,
        )
    )[4] + $gap;

    $p->Annotate(
        'font'          => $fonts{'date'},
        'text'          => $date,
        'rotate'        => -90,
        'x'             => $x,
        'y'             => $y,
    );

    $p->Sharpen(
        'radius' => 1,
        'sigma'  => 2,
    );
    $p->Write($new_file_name);

    print "$file - $date\n";

} # foreach

Готовые скрипты и документация к ним выложены на github.com:

• move-images.pl
• resize-mark.pl