libsubtitle-perl/bin/ssa-info

#!/usr/bin/env perl

use strict;
use warnings;
use lib 'lib';
use utf8;

use Subtitle::Format::SSA;

sub usage {
  my ($msg) = @_;
  print "ssa-info <file>\n";
  exit 1;
}

sub section {
  my ($name) = @_;
  printf "%s %s\n", '#' x 5, $name;
}

sub line {
  my ($name, $value) = @_;
  printf "  %-10s : %s\n", $name, $value;
}

$| = 1;

unless (@ARGV and -f $ARGV[0]) {
  warn "no file given\n";
  usage();
}
my $ssa = Subtitle::Format::SSA->new(debug => 0);
if ($ssa->from_file($ARGV[0]) < 0) {
  warn "Can't parse input file: $ARGV[0]\n";
  exit 1;
}

section('Summary');
line(Version => $ssa->{type});
line(Headers => scalar keys %{ $ssa->{headers} });
line(Styles  => scalar @{ $ssa->{styles} });
line(Events  => scalar @{ $ssa->{events} });
line(Fonts   => scalar @{ $ssa->{fonts}  });

section('Styles');
{
  my $stats = $ssa->style_usage;
  my @sorted = map { sprintf('%s (%d)', $_, $stats->{$_}) }
    sort { $stats->{$b} <=> $stats->{$a} } keys %{ $stats };
  line(Usage => join(', ', @sorted));
  $stats = $ssa->fonts_usage;
  @sorted = map { sprintf('%s (%d)', $_, $stats->{$_}) }
    sort { $stats->{$b} <=> $stats->{$a} } keys %{ $stats };
  line(Fonts => join(', ', @sorted));
}

if (scalar @{ $ssa->{fonts} } > 0) {
  section('Fonts');
  my $i = 1;
  foreach my $font (@{ $ssa->{fonts} }) {
    my $name  = sprintf "Font #%d", $i++;
    my $value = sprintf "%s (%d bytes)", $font->name, $font->size;
    line($name => $value);
  }
}

if (scalar @{ $ssa->{log} } > 0) {
  section('Log records');
  foreach my $line (@{ $ssa->{log} }) {
    printf "%s\n", $line;
  }
}

exit 0;