指定フォルダ以下の画像を、一辺が指定長の正方形に加工するPerlスクリプト

縦横長がバラバラの画像集合を全部まとめて、
「50x50」とか「100x100」とかの正方形画像に加工したくなりました。

画像フォルダの指定、出力フォルダの指定、一辺の長さの指定、
をするとモリモリと正方形画像を生成します。

とりあえず自分の用途では動いたのでアップ。

#!/usr/bin/perl

use strict;
use warnings;

use App::Options(
  option => {
    indir => "type=string; required; default=Unknown;",
    outdir => "type=string; required; default=Unknown;",
    type => "type=string; required; default=Unknown;",
    width => "type=integer; required; default=Unknown;",
    debug => "type=boolean",
  },
);

use Image::Magick;
use Path::Class;

my $image = Image::Magick->new;

my $dir = Path::Class::Dir->new($App::options{indir});
while (my $file = $dir->next) {
  my $absin = $file->absolute;
  my $image = Image::Magick->new;
  next unless $absin =~ m|$App::options{type}$|;
  $image->Read($absin);
  my ($now_width, $now_height) = $image->Get('width', 'height');
  my ($x_start, $y_start, $x_width, $y_height);
  if ($now_width < $now_height) {
    my $retio = $App::options{width} / $now_width;
    my $new_height = int($now_height * $retio);
    $image->Resize(
      width => int($App::options{width}),
      height => int($new_height),
      blur => 0.9
    );

    ($now_width, $now_height) = $image->Get('width', 'height');
    if ($now_width < $now_height) {
      $x_start = 0;
      $x_width = 0;
      my $margin = int(($new_height - $App::options{width}) / 2);
      $y_start = 0;
      $y_height = $margin ;
      $image->Crop(geometry=> $x_start."x".$y_start."+".$x_width."+".$y_height);
      $image->Crop(geometry=> $x_start."x".$y_start."+".$x_width."-".$y_height);
    }
  }
  else {
    my $retio = $App::options{width} / $now_height;
    my $new_width = int($now_height * $retio);
    $image->Resize(
      width => int($new_width),
      height => int($App::options{width}),
      blur => 0.9
    );

    ($now_width, $now_height) = $image->Get('width', 'height');
    if ($now_width > $now_height) {
      $y_start = 0;
      $y_height = 0;
      my $margin = int(($App::options{width} - $new_width) /2);
      $x_start = 0;
      $x_width = $margin;
      $image->Crop(geometry=> $x_start."x".$y_start."+".$x_width."+".$y_height);
      $image->Crop(geometry=> $x_start."x".$y_start."-".$x_width."+".$y_height);
    }
  }
  if ($absin =~ m|^.+/(.+?)$|) {
    my $filename = $1;
    my $absoutdir = Path::Class::Dir->new($App::options{outdir})->absolute();
    $image->Write("$absoutdir/$filename");
  }
}