印刷関連

持ち込まれた画像の大きさなどをチェックするスクリプト

仕事ではAdobe Bridgeを使って画像チェックしていますが、サクッと簡易チェックする場合に使います。

MacBookにインストールしておいて、出先などで使うのも便利です。

ソースを公開します。特別なモジュールは使っていません、使っているのはExifToolですので、インストールしておいて下さい。

perl ExifList.pl  調べるファイル名またはホルダー名  >  ~/desktop/list.tsv
このようなコマンドをターミナルで打ち込んであげます

perl ExifList.pl aaa > list.tsv

gg1.png
↑list.tsvの内容


以下 ソースファイル  (ExifList.pl)

#!/usr/bin/perl

#
# 印刷適正可能の画像データーか? Exif Dataのリストを作成する
# ディレクトリ指定なら、ディレクトリ内のデーター全て
# ファイル指定なら、そのファイルのみ
# ExifList ファイル名 > リダイレクトファイル.tsv  タブ区切りデーター
#

our $version = "ExifList Ver1.1.0  20210426";

use FindBin;
use lib $FindBin::Bin;
use strict;
use utf8;
use Jcode;
use Encode;
use File::Basename;

my $enc_os='utf-8';
# binmode STDIN, ":encoding($enc_os)";
# binmode STDOUT, ":encoding($enc_os)";
# binmode STDERR, ":encoding($enc_os)";
sub decin($)  { decode($enc_os, shift) }
sub encout($) { encode($enc_os, shift) }
sub prt_hdr{print encout("File Name\tColor Mode\tColor 
Space\tYOKO(dpi)\tTATE(dpi)\tYOKO(pix)\tTATE(pix)\tPixel(万画素)\tYOKO(mm)\tTATE(mm)\n");}

my $doc1_str = <<"__DOC1STR__";
印刷適正可能の画像データーか?調べて Exif Dataのリスト(タブ区切りリスト)を出力する
 -->ディレクトリ指定なら、ディレクトリ内のデーター全て
 -->ファイル指定なら、そのファイルのみ

起動方法:ExifList ファイル名 > リダイレクトファイル.tsv  タブ区切りデーター

__DOC1STR__

sub help{ print encout("\n使い方***\n$doc1_str\n");}
 

#ファイル指示かディレクトリ指示か

my $in_path = $ARGV[0];
if ((!(-f $in_path)) && (!(-d $in_path))){ help(); exit;}
prt_hdr();
if(-f $in_path){
    $in_path = decin($in_path);
	&print_out(&list($in_path));
}
if(-d $in_path){
	my @dir = glob("$in_path/*");				#ファイル名をすべて取得する(パス付き)	
	foreach my $rec(@dir){
        $rec = decin($rec);
		if(-f $rec){
			&print_out(&list($rec));
		}	
	}
}
#exit;

#----------------------------------------------------------------------

sub print_out{
	my $exif_rec = $_[0];
	    

	print encout("$exif_rec\n");
}

sub list{
	my $f_path = $_[0];
	my $exif_str;
    my ($x_pix2len, $y_pix2len);

    my $const_str = ":";
    $const_str =~ /(.*):(.*)/;

   my $img_mime = `exiftool -MimeType '$f_path'`;
   if( $img_mime !~ /image/){
        my ($name, $dir, $ext) = fileparse($f_path);
        return ("$name 画像ではない");
    }   #画像ファイルで無ければ戻る

	my $exif_buff =  `exiftool '$f_path'`;	#'$f_path'としないとパス名に()などの記号が入っていると動作しない
	$exif_buff = Encode::decode('utf8', $exif_buff);     # utf8フラグ ON	外部入力は encode必要

    $exif_buff =~ m/(File Name\s*:\s*)(.+)\n/i;
    my $file_name = $2;
    $const_str =~ /(.*):(.*)/;

    $exif_buff =~ m/(Color Mode\s*:\s*)(.+)\n/i;
    my $color_mode = $2;
    $const_str =~ /(.*):(.*)/;

    $exif_buff =~ m/(Color Space\s+:\s*)(.+)\n/i;
    my $color_space  = $2;
    $const_str =~ /(.*):(.*)/;

    $exif_buff =~ m/(Color Space Data\s+:\s*)(.+)\n/i;
    my $color_space_data  = $2;
    if($color_space eq ""){$color_space = "*".$color_space_data;}

    $const_str =~ /(.*):(.*)/;

    $exif_buff =~ m/(X Resolution\s*:\s*)(.+)\n/i;
    my $x_reso = $2;
    $const_str =~ /(.*):(.*)/;

   $exif_buff =~ m/(Y Resolution\s*:\s*)(.+)\n/i;
   my $y_reso = $2;
   $const_str =~ /(.*):(.*)/;

   $exif_buff =~ m/(Image Width\s*:\s*)(.+)\n/i;
   my $img_width = $2;
   $const_str =~ /(.*):(.*)/;

   $exif_buff =~ m/(Image Height\s*:\s*)(.+)\n/i;
   my $img_height = $2;
   $const_str =~ /(.*):(.*)/;

   my $img_size = round(($img_width * $img_height / 10000),0);
   $img_size = edit_keta($img_size);
   if($x_reso){$x_pix2len = $img_width * (1 / $x_reso *25.4);}
   $x_pix2len = edit_keta(round($x_pix2len,2));
   if($y_reso){$y_pix2len = $img_height * (1 / $y_reso *25.4);}
   $y_pix2len = edit_keta(round($y_pix2len,2));

   $x_reso = edit_keta($x_reso);
   $y_reso = edit_keta($y_reso);
   $img_width = edit_keta($img_width);
   $img_height = edit_keta($img_height);


   my @exif_list = ($file_name, $color_mode, $color_space, $x_reso, $y_reso, $img_width, $img_height, $img_size, $x_pix2len, $y_pix2len);

#   print ("debug $file_name  $color_mode  $x_reso $y_reso   $img_width  $img_height   $img_size\MB\n");

   return join("\t",@exif_list);

}
 
### 四捨五入 -------------------------------------------------
sub round {
   my $val = shift;    # 四捨五入する数
   my $col = shift;    # 小数点以下のどこまで残すか
   my $r = 10 ** $col;
   my $a = ($val > 0) ? 0.5 : -0.5;
   return int($val * $r + $a) / $r;
}
### 3桁カンマ区切り ----------------------------------------
sub edit_keta{	#999999=>999,999
	my($kingaku)=@_;
	1 while $kingaku =~ s/(.*\d)(\d\d\d)/$1,$2/;
	return $kingaku;
}

添付ファイル: filegg1.png 237件 [詳細] fileggg.png 112件 [詳細]

トップ   編集 凍結 差分 履歴 添付 複製 名前変更 リロード   新規 一覧 検索 最終更新   ヘルプ   最終更新のRSS
Last-modified: 2023-10-31 (火) 09:13:42