You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
71 lines
1.4 KiB
71 lines
1.4 KiB
7 years ago
|
#!/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;
|