+ bin/ssa-info

bin/ssa-info

@@ -0,0 +1,70 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use lib 'lib';
+use utf8;
+
+use Subtitle::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::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));
+}
+
+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;