#!/usr/bin/perl

# bin/peekvideo
#  Determine information about a given media file
#
# $Id: peekvideo 6744 2009-04-29 14:32:07Z FREQUENCY@cpan.org $
#
# This package and its contents are released by the author into the
# Public Domain, to the full extent permissible by law. For additional
# information, please see the included `LICENSE' file.

use strict;
use warnings;

use Pod::Usage;

use Video::Info;
use Video::FourCC::Info;

=head1 NAME

peekvideo - determine a codec used by a given file

=head1 VERSION

Version 1.1 ($Id: peekvideo 6744 2009-04-29 14:32:07Z FREQUENCY@cpan.org $)

=cut

use version; our $VERSION = qv('1.1');

=head1 SYNOPSIS

Usage: peekvideo filename [...]

Given a single path referring to a file containing video data, this script
will determine the codec required for the media to play.

=head1 DESCRIPTION

This is a simple script that determines information such as the common name
of the codec required for the given media to play. It is convenient to use
for troubleshooting video files that do not play for one reason or another.

=cut

my @files = @ARGV;

# if no parameters are passed, give usage information
unless (@files) {
  pod2usage(msg => 'Please supply at least one filename to analyze');
  exit();
}

foreach my $file (@files) {
  my $video;
  eval {
    $video = Video::Info->new(-file => $file);
  };
  if ($@) {
    printf {*STDERR} "Problem determining information about '%s':\n", $file;
    print 'In Video::Info: ', $@;
    next;
  }

  # Check if we have a FourCC
  unless (length($video->vcodec) == 4) {
    printf {*STDERR} "Video::Info returns '%s', which is not a FourCC\n",
      $video->vcodec;
    next;
  }

  my $codec;
  eval {
    $codec = Video::FourCC::Info->new($video->vcodec);
  };
  if ($@) {
    printf {*STDERR} "Codec '%s' is unregistered or unknown\n",
      $video->vcodec;
    next;
  }

  printf "File '%s' uses codec '%s': \n", $file, $video->vcodec;

  # Check if we have description entity information
  if (defined $codec->description) {
    printf "  Description:   %s\n", $codec->description;
  }

  # Check if we have owner entity information
  if (defined $codec->owner) {
    printf "  Registered by: %s\n", $codec->owner;
  }

  # Check if we have registration date information
  if (defined $codec->registered) {
    print '  Registered on: ';
    if (ref($codec->registered)) {
      ## no critic(ProhibitNoisyQuotes)
      # this is incorrectly reported as a noisy quote
      print $codec->registered->ymd('-');
    }
    else {
      print $codec->registered;
    }
    print "\n";
  }

  # Other information from Video::Info
  printf "  Dimensions:    %d x %d\n", $video->width, $video->height;
  printf "  Duration:      %s\n", $video->MMSS;
  printf "  Picture:       %d frames at %.2f frames/sec\n",
    $video->vframes, $video->fps;
  printf "  Audio:         %s, %d kbps at %d Hz\n", $video->acodec,
    $video->arate / 1000, $video->afrequency;
}

=head1 AUTHOR

Jonathan Yu E<lt>frequency@cpan.orgE<gt>

=head1 SUPPORT

For support details, please look at C<perldoc Video::FourCC::Info> and
use the corresponding support methods.

=head1 LICENSE

Copyleft (C) 2009 by Jonathan Yu <frequency@cpan.org>. All rights reversed.

This package and its contents are released by the author into the Public
Domain, to the full extent permissible by law. For additional information,
please see the included `LICENSE' file.

=head1 SEE ALSO

L<Video::Info>,
L<Video::FourCC::Info>

=cut
