2015/01/08(木)pure perl で JPEG の Exif を表示や削除したい
機能
- 対応はJPEGファイルのみ。
- 外部モジュール不要。
- 再圧縮せずにExif情報を削除することができます。
- Exif判別やExif表示はやや手抜きですが、よほど特殊なJPEGでない限り問題にならないと思います。
- ライセンスはWTFPLですが、一言「使ったよ」ってコメントくれると嬉しいです。
バグがあったら具体的なJPEGデータと共にコメントください。
スクリプト
#!/usr/bin/perl
#------------------------------------------------------------------------------
# JpegからExifを削除するプログラム written by nabe@abk
#------------------------------------------------------------------------------
# Software license : WTFPL
#
use strict;
use Fcntl;
###############################################################################
# ●引数解析
###############################################################################
my $c = shift(@ARGV);
if ($c eq '-c') {
foreach(@ARGV) { &check_exif($_); }
} elsif ($c eq '-p') {
foreach(@ARGV) { &print_exif($_); }
} elsif ($c eq '-s') {
foreach(@ARGV) { &strip_jpeg($_); }
} else {
print <<HELP;
Usage: $0 [options] [files]
Available options are:
-c JPEG がExifを持つか確認します。
-p JPEG がExifを持つか確認します。
-s JPEG のExif情報を表示します。
HELP
}
#------------------------------------------------------------------------------
# ●Exifの存在確認
#------------------------------------------------------------------------------
sub check_exif {
my $file = shift;
my $fh;
my $head;
sysopen($fh, $file, O_RDONLY);
binmode($fh);
sysread($fh, $head, 1024);
close($fh);
my $exif = ($head =~ /\xFF\xE1..Exif\x00\x00/s);
print "$file : Exif " . ($exif ? '' : 'not ') . "exists\n";
}
#------------------------------------------------------------------------------
# ●Exifのデータ取得（簡易）
#------------------------------------------------------------------------------
sub print_exif {
my $file = shift;
my @ifd_types = (
{},
{len => 1, sign => 0 }, # 01
{len => 1 }, # 02
{len => 2, sign => 0 }, # 03
{len => 4, sign => 0 }, # 04
{len => 8 }, # 05
{len => 1, sign => 0x80 }, # 06
{len => 1 }, # 07
{len => 2, sign =>0x8000 }, # 08
{len => 4, sign =>0x80000000 }, # 09
{len => 8 }, # 0a
{len => 4 }, # 0b
{len => 8 } # 0c
);
my $fh;
my $data;
sysopen($fh, $file, O_RDONLY);
binmode($fh);
my $len = sysread($fh, $data, 65536);
close($fh);
print "\n*** $file : read $len bytes\n";
if ($data !~ /^(.*?)\xFF\xE1(.)(.)Exif\x00\x00/s) { return ; }
my $p = length($1)+10;
my $size = (ord($2)<<8) + ord($3);
# tiff header
my $base = $p;
my $tiff_h = substr($data, $p, 2);
my $tiffR = sub {
return &tunpack($tiff_h, substr($_[0], $_[1], $_[2]));
};
my $tiff_c = &$tiffR($data, $p+2, 2);
if ($tiff_h ne 'MM' && $tiff_h ne 'II' or $tiff_c != 0x2a) {
return ;
}
$p += &$tiffR($data, $p+4, 4);
my %exif;
my $exif_ifd;
while($p < $len) {
# Tags
my $num = &$tiffR($data, $p, 2);
$p+=2;
for(my $i=0; $i<$num; $i++) {
my $tag = &$tiffR($data, $p , 2);
my $type = &$tiffR($data, $p+2, 2);
my $size = &$tiffR($data, $p+4, 4);
my $offset= &$tiffR($data, $p+8, 4);
my $val = substr($data, $p+8, 4);
$p+=12;
if ($tag == 34665) { # Exif IFD Found
$exif_ifd = $base + $offset;
next;
}
my $tinfo= $ifd_types[ $type ];
my $unit = $tinfo->{len};
my $bytes= $size*$unit;
if ($bytes <= 4) {
$val = substr($val, 0, $bytes);
} else {
$val = substr($data, $base + $offset, $size*$unit);
}
if (exists($tinfo->{sign})) { # 整数データ
$val = &tunpack($tiff_h, $val);
if ($tinfo->{sign} && $val >= $tinfo->{sign}) {
$val = $val - $tinfo->{sign} - $tinfo->{sign};
}
} elsif ($type == 2) { # 文字列
if (substr($val,-1) eq "\x00") { chop($val); }
} elsif ($type == 5 || $type == 0x0A) { # 分数
my $n1 = &$tiffR($val, 0, 4);
my $n2 = &$tiffR($val, 4, 4);
if ($type == 0x0A) {
$n1 = ($n1<0x80000000) ? $n1 : ($n1 - 0x100000000);
$n2 = ($n1<0x80000000) ? $n2 : ($n2 - 0x100000000);
}
$val = "$n1/$n2";
if ($n2 =~ /^10+$/) {
$val = $n1/$n2;
}
} elsif ($type == 0x0B) { # 実数
eval { $val = unpack('F', $val); }
} elsif ($type == 0x0C) { # 倍精度実数
eval { $val = unpack('D', $val); }
}
$exif{$tag} = $val;
if ($type != 7) {
print "$tag\[$type] : $val\n";
}
}
if ($exif_ifd) {
$p = $exif_ifd;
$exif_ifd = 0;
next;
}
last;
}
return \%exif;
}
sub tunpack {
my $type = shift;
my @ary = split('',shift);
if ($type eq 'II') {
@ary = reverse(@ary);
}
my $v=0;
foreach(@ary) {
$v = ($v<<8) + ord($_);
}
return $v;
}
#------------------------------------------------------------------------------
# ●Exifの削除
#------------------------------------------------------------------------------
sub strip_jpeg {
my $file = shift;
my %strip_markers = map { $_ => 1 } split('',
"\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF\xFE"
); # APP1 - 15と、コメントセグメント(0xFE)は無視
my $fh;
my $data;
sysopen($fh, $file, O_RDONLY);
binmode($fh);
sysread($fh, $data, -s $fh);
close($fh);
my $r=0;
my @segs;
my $require_strip;
while(1) {
if (substr($data, 0, 2) ne "\xFF\xD8") { $r=-1; last; }
my $p = 2;
my $len = length($data);
while($p < $len) {
if (substr($data, $p, 1) ne "\xFF") { last; } # err
my $marker = substr($data, $p+1, 1);
if ($strip_markers{$marker}) { $require_strip=1; }
my %h;
$h{marker} = $marker;
$h{offset} = $p;
$h{size} = (ord(substr($data, $p+2, 1))<<8) + ord(substr($data, $p+3, 1)) +2;
$p += $h{size};
push(@segs, \%h);
if ($marker ne "\xDA") { next; }
# SOSマーカー（データの開始）を発見
$h{size} = $h{size} + ($len -$p) +2;
$p = $len-2;
if (substr($data, $p, 2) eq "\xFF\xD9") { $p += 2; } # EOIセグメント
last;
}
if ($p != $len) { $r=-2; last; }
if (!$require_strip) {
print "$file : Strip not require\n";
last;
}
# ファイルの書き出し
$file =~ s/\.jpe?g$//;
$file .= '-strip.jpg';
sysopen($fh, $file, O_WRONLY | O_CREAT);
binmode($fh);
syswrite($fh, $data, 2, 0);
foreach(@segs) {
if ($strip_markers{ $_->{marker} }) { next; }
syswrite($fh, $data, $_->{size}, $_->{offset});
}
close($fh);
print "$file : Stripped\n";
last;
}
if ($r) {
print "$file : Not jpeg\n";
}
return $r;
}