FLV::Info - Extract metadata from Adobe Flash Video files

    use FLV::Info;
    my $reader = FLV::Info->new();
    $reader->parse('video.flv');
    my %info = $reader->get_info();
    print "$info{video_count} video frames\n";
    print $reader->report();

package FLV::Info;

use warnings;
use strict;
use 5.008;
use List::Util qw(max);
use Data::Dumper;

use FLV::File;

our $VERSION = '0.24';

sub new
{
   my $pkg = shift;

   my $self = bless {
      file => undef,
      info => undef,
   }, $pkg;

   return $self;
}

sub parse
{
   my $self     = shift;
   my $filename = shift;

   $self->{info} = undef;
   $self->{file} = FLV::File->new();
   $self->{file}->parse($filename);    # might throw exception
   return;
}

sub get_info
{
   my $self = shift;

   if (!$self->{info})
   {
      my %info;
      if ($self->{file})
      {
         %info = $self->{file}->get_info();
      }
      $self->{info} = \%info;
   }
   return %{ $self->{info} };
}

sub report
{
   my $self = shift;

   my %info = $self->get_info();

   # l = label
   # k = key
   # u = unit (should make sense to pluralize by appending an 's')
   # r = key match regex
   # p = prefix
   # f = filter subroutine
   my @outputs = (
      { l => 'File name', k => 'filename', },
      { l => 'File size', k => 'filesize', u => 'byte', },
      {
         l => 'Duration',
         k => 'duration',
         u => 'second',
         f => sub { return 'about ' . ($_[0] / 1000); },
      },    # convert millisec to sec
      { l => 'Video',          k => 'video_count', u => 'frame', },
      { r => qr/\A video_/xms, p => q{  }, },
      { l => 'Audio',          k => 'audio_count', u => 'packet', },
      { r => qr/\A audio_/xms, p => q{  }, },
      { l => 'Meta',           k => 'meta_count',  u => 'event', },
      { r => qr/\A meta_/xms,  p => q{  }, },
   );

   # Flag keys to ignore in regex matches
   my %seen = map { $_->{k} ? ($_->{k} => 1) : () } @outputs;

   # Apply regex matches
   for my $i (reverse 0 .. $#outputs)
   {
      my $output = $outputs[$i];
      if ($output->{r})
      {
         my @r;
         for my $key (grep { $_ =~ $output->{r} } sort keys %info)
         {
            next if ($seen{$key});
            (my $label = $key) =~ s/$output->{r}//xms;
            push @r, { l => $output->{p} . $label, k => $key };
         }
         splice @outputs, $i, 1, @r;
      }
   }

   # Get the length of the longest label so we can pad the rest
   my $max_label_length = max map { length $_->{l} } @outputs;

   # Accumulate output string here
   my $out = q{};
   for my $output (@outputs)
   {
      my $value = $info{ $output->{k} };
      next if (!$value);

      # Apply filter if any
      if ($output->{f})
      {
         $value = $output->{f}->($value);
      }

      # Append unit(s) if any
      if ($output->{u})
      {
         $value .= q{ } . $output->{u} . ('1' eq $value ? q{} : 's');
      }
      elsif (ref $value)
      {

         # Make multiline output for a complex data structure
         my $d = Data::Dumper->new([$value], ['VAR']);
         (my $label = $output->{l}) =~ s/\S+/  >>>/xms;
         my $varprefix = '$VAR = ';    ##no critic(InterpolationOfMetachars)

         # "+2" is for 2 spaces in normal output
         my $padding
             = q{ } x ($max_label_length + 2 - length $label . $varprefix);

         $d->Pad($label . $padding);
         $value = $d->Dump();
         $value =~ s/\A\s*>>>\s*\Q$varprefix\E//xms;
         $value =~ s/;\s+\z//xms;
      }

      my $label = $output->{l};
      my $padding = q{ } x ($max_label_length - length $label);

      $out .= "$label $padding $value\n";
   }

   return $out;
}

sub get_file
{
   my $self = shift;
   return $self->{file};
}

1;

__END__