termimg

   1 #!/usr/bin/perl
   2 use 5.014;
   3
   4 our $VERSION = '1.00';
   5
   6 use Getopt::Long '2.33', qw( :config gnu_getopt );
   7 GetOptions(\my %opt,
   8         'size|s=s',
   9 );
  10 my ($file) = @ARGV;
  11
  12 my @info = eval {
  13         require Image::ExifTool;
  14         my $exif = Image::ExifTool->new->ImageInfo($file, {
  15                 CoordFormat => '%.5f',
  16                 DateFormat => '%Y-%m-%d %H:%M:%S',
  17                 Exclude => 'System:*',
  18         });
  19         die "exiftool: $exif->{Error}\n" if $exif->{Error};
  20         return (
  21                 $exif->{MIMEType},
  22                 $exif->{ImageSize} ? "$exif->{ImageSize} ($exif->{Megapixels}MP)" : (),
  23                 join(' ',
  24                         $exif->{YCbCrSubSampling} // (),
  25                         $exif->{Interlace} // (),
  26                         $exif->{Compression} // $exif->{FileType},
  27                         $exif->{SVGVersion} // $exif->{PDFVersion} // (),
  28                 ),
  29                 $exif->{ColorType} ? "$exif->{BitDepth}bpp $exif->{ColorType}" : (),
  30                 join(' ', 'exif',
  31                         $exif->{ExifVersion},
  32                         sprintf('(%d)', scalar %{$exif}),
  33                 ),
  34                 $exif->{Thumb} ? "thumb $exif->{ThumbnailLength}B" : (),
  35                 (map "@ $_",
  36                         $exif->{DateTimeOriginal} //
  37                         $exif->{DateCreated} //
  38                         $exif->{CircaDateCreated} //
  39                         $exif->{ModifyDate} //
  40                         $exif->{ZipModifyDate} //
  41                         (),
  42                 ),
  43                 join(', ',
  44                         $exif->{GPSPosition} // $exif->{Location} // (),
  45                         $exif->{GPSAltitude} // (),
  46                 ) || (),
  47                 (map "hw $_", join(' ',
  48                         $exif->{Make} // (), $exif->{Model} // (),
  49                         $exif->{FOV} ? "(FOV $exif->{FOV})" : (),
  50                 ) || ()),
  51                 (map "sw $_", $exif->{Software} // $exif->{Application} // ()),
  52                 (map "> $_", $exif->{'Description-nl'} // ()),
  53                 $exif->{Warning} ? "! $exif->{Warning}" : (),
  54         );
  55 };
  56 warn $@ if $@;
  57
  58 my $filesize = (stat $file)[7];
  59 eval {
  60         require Digest::MD5;
  61         open my $bin, '<', $file;
  62         binmode $bin;
  63         my $md5 = Digest::MD5->new->addfile($bin)->b64digest;
  64         push @info, "# $md5 ($filesize)";
  65 } or warn $@;
  66
  67 my $aspect = eval {
  68         require Term::ReadKey;
  69         my ($w, $h, $x, $y) = Term::ReadKey::GetTerminalSize();
  70         return $x/$w / $y*$h;
  71 };
  72
  73 open my $pgm, '-|', convert => (
  74         $file =>
  75         -delete => '1--1',
  76         $aspect ? ('+distort' => SRT => "0,0 1,$aspect 0") : (),
  77         -thumbnail => $opt{size} || '40x12',
  78         -colorspace => 'gray',
  79         '-normalize',
  80         -level => '-1%',
  81         -channel => 'A', -threshold => '50%',
  82         -background => 'black',
  83         -layers => 'flatten',
  84         -compress => 'none',
  85         'pgm:-'
  86 ) or die $!;
  87
  88 if (<$pgm> eq "P2\n") {
  89         my ($width, $height) = split ' ', <$pgm>;
  90         <$pgm>;  # ignore depth
  91         my @ch = split //, " .:oO@";
  92         while (<$pgm>) {
  93                 print !$_ ? '/' : $ch[ $_ * @ch >> 8 ] for /\d+/g;
  94                 print ' ', shift @info if @info;
  95                 print $/;
  96         }
  97         substr $_, 0, 0, ' ' x ($width + 1) for @info;
  98 }
  99 say for @info;
 100
 101 =head1 NAME
 102
 103 termimg - media file fingerprint and metadata
 104
 105 =head1 SYNOPSIS
 106
 107 B<termimg> [<options>] <file>
 108
 109 =head1 DESCRIPTION
 110
 111 Identify given file by ascii image
 112 with a summary of distinctive metadata.
 113
 114 =head1 OPTIONS
 115
 116 =over
 117
 118 =item -s, --size=<width>x<height>
 119
 120 =back
 121
 122 =head1 AUTHOR
 123
 124 Mischa POSLAWSKY <perl@shiar.org>
 125
 126 =head1 LICENSE
 127
 128 AGPL3+