view release on metacpan or  search on metacpan

lib/MP3/Tag/ImageExifTool.pm  view on Meta::CPAN

package MP3::Tag::ImageExifTool;

use strict;
use File::Basename;
#use File::Spec;
use vars qw /$VERSION @ISA/;

$VERSION="1.14";
@ISA = 'MP3::Tag::__hasparent';

=pod

=head1 NAME

MP3::Tag::ImageExifTool - extract size info from image files via L<Image::ExifTool|Image::ExifTool>.

=head1 SYNOPSIS

  my $db = MP3::Tag::ImageExifTool->new($filename);	# Name of multimedia file

see L<MP3::Tag>

=head1 DESCRIPTION

MP3::Tag::ImageExifTool is designed to be called from the MP3::Tag module.

It implements the (standard) methods qw(title track artist album year genre comment),
as well as width(), height(), bit_depth(), _duration() and mime_type() methods (sizes in pixels).

Use method C<field('FieldName')> to access a particular field provided by C<Image::ExifTool>.

These methods return C<undef> if C<Image::ExifTool> is not available, or does not return valid data.

=cut


# Constructor

sub new_with_parent {
    my ($class, $f, $p, $e, %seen, @cue) = (shift, shift, shift);
    $f = $f->filename if ref $f;
    bless [$f], $class;
}

sub new {
    my ($class, $f) = (shift, shift);
    $class->new_with_parent($f, undef, @_);
}

# Destructor

sub DESTROY {}

sub __info ($) {
  my $self = shift;
  unless (defined $self->[1]) {
      my $v = eval { require Image::ExifTool;
                     Image::ExifTool->new()->ImageInfo($self->[0], '-id3:*') };
      # How to detect errors?
      $self->[1] = $v->{Error} ? '' : $v;
  }
  return $self->[1];
}

my %tr = qw( mime_type MIMEType year Date width ImageWidth height ImageHeight
	     bit_depth BitDepth );

for my $elt ( qw( title track artist album year genre comment mime_type
		  width height ) ) {
  my $n = ($tr{$elt} or ucfirst $elt);
  my $is_genre = ($elt eq 'genre');
  my $r = sub ($) {
    my $info = shift()->__info;
    return unless $info;
    my $v = $info->{$n};
    $v =~ s/^None$// if $is_genre and $v;
    return $v;
  };
  no strict 'refs';
  *$elt = $r;
}

sub bit_depth ($) {
  my $info = shift()->__info;
  return unless $info;