From df7f8b46c5a626b26671b4739381854ccfbff8e9 Mon Sep 17 00:00:00 2001 From: Alex 'AdUser' Z Date: Sun, 22 Jul 2018 21:30:05 +1000 Subject: [PATCH] * Subtitle::SSA::Font : rename & refactor --- lib/Subtitle/SSA/File.pm | 191 +++++++++++++++++++++++++++++++++++++++ lib/Subtitle/SSA/Font.pm | 74 --------------- 2 files changed, 191 insertions(+), 74 deletions(-) create mode 100644 lib/Subtitle/SSA/File.pm delete mode 100644 lib/Subtitle/SSA/Font.pm diff --git a/lib/Subtitle/SSA/File.pm b/lib/Subtitle/SSA/File.pm new file mode 100644 index 0000000..7776a62 --- /dev/null +++ b/lib/Subtitle/SSA/File.pm @@ -0,0 +1,191 @@ +package Subtitle::SSA::File; + +use strict; +use warnings; +use bytes; + +sub new { + my ($class, %opts) = @_; + my $self = { + err => undef, + eol => "\n", + data => '', + type => 'font', + name => 'unnamed_0.ttf', + }; + + return bless($self, $class); +} + +## accessors + +sub size { + my ($self) = @_; + return length $self->{data}; +} + +## accessors / setters + +sub error { + my ($self, $text) = @_; + + if (defined $text) { + $self->{err} = $text; + return; + } + return $self->{err}; +} + +sub type { + my ($self, $type) = @_; + if (defined $type) { + if ($type eq 'file' or $type eq 'font') { + $self->{type} = $type; + } else { + die "wrong 'type' value for ASS file: $type\n"; + } + } + return $self->{type}; +} + +sub name { + my ($self, $name) = @_; + if (defined $name) { + if ($self->type eq 'font') { + if ($name =~ m<^(.+)_(B|BI|I)?(\d+)\.ttf$>i) { + # $1 - fontname, $2 - flags (bold/italic), $3 - encoding + $self->{name} = sprintf '%s_%s%d.ttf', $1, uc($2 // ''), $3; + } else { + die "wrong name format for ASS font: $name\n"; + } + } else { + $self->{name} = $name; + } + } + return $self->{name}; +} + +## import functions + +sub load { + my ($self, $path) = @_; + + open my $FH, '<', $path or + return $self->error("can't open file: $path -- $!"); + local $/ = undef; + $self->{data} = <$FH>; + close $FH; + + return 1; +} + +sub parse_uue_line { + my ($self, $line) = @_; + + # 1-char uue chunk with 6 significant bits can't hold 1 byte with 8 bits + return $self->error("bad uuencoded data (odd length)\n") + if length($line) % 4 == 1; + + # decode uue to binary form + my $bytes = _decode_uue($line); + $self->{data} .= $bytes; + + return length $bytes; +} + +## export functions + +sub binary { + my ($self, $bin) = @_; + if (defined $bin) { + $self->{data} = $bin; + } + return $self->{data}; +} + +sub uue_line { + my ($self) = @_; + return _encode_uue($self->{data}); +} + +sub uue_block { + my ($self) = @_; + + my $uue = $self->uue_line; + my $cap = ($self->{type} eq 'font') ? 'fontname' : 'filename'; + my $out = sprintf '%s: %s%s', $cap, $self->{name}, $self->{eol}; + while (my $line = substr($uue, 0, 80, '')) { + $out .= $line; + $out .= $self->{eol}; + } + + return $out; +} + +## private UUE functions + +sub _decode_uue { + my ($uue) = @_; + my $bytes = ''; + while (1) { + my $chars = substr($uue, 0, 4, ''); + my $cnt = length $chars; + last if $cnt <= 0; + my @chars = split(//, $chars); + if ($cnt == 4) { + my $t = ((ord($chars[0]) - 33) << 18) + + ((ord($chars[1]) - 33) << 12) + + ((ord($chars[2]) - 33) << 6) + + ((ord($chars[3]) - 33)); + $bytes .= pack('C*', ($t & 0xFF0000) >> 16, ($t & 0xFF00) >> 8, ($t & 0xFF)); + } elsif ($cnt == 3) { + my $t = ((ord($chars[0]) - 33) << 18) + + ((ord($chars[1]) - 33) << 12) + + ((ord($chars[2]) - 33) << 6); + $bytes .= pack('C*', ($t & 0xFF0000) >> 16, ($t & 0xFF00) >> 8); + } elsif ($cnt == 2) { + my $t = ((ord($chars[0]) - 33) << 18) + + ((ord($chars[1]) - 33) << 12); + $bytes .= pack('C*', ($t & 0xFF0000) >> 16); + } else { + # $cnt == 1 or >= 5 + die "error in SSA UUE decode: bad chunk length\n"; + } + } + return $bytes; +} + +sub _encode_uue { + my ($binary) = @_; + my $uue = ''; + while (1) { + my $bytes = substr($binary, 0, 3, ''); + my $cnt = length $bytes; + last if $cnt <= 0; + my @bytes = split(//, $bytes); + if ($cnt == 3) { + my $t = (ord($bytes[0]) << 16) + + (ord($bytes[1]) << 8) + + (ord($bytes[2]) << 0); + $uue .= pack('C*', (($t >> 18) & 0x3F) + 33, + (($t >> 12) & 0x3F) + 33, + (($t >> 6) & 0x3F) + 33, + (($t >> 0) & 0x3F) + 33); + } elsif ($cnt == 2) { + my $t = (ord($bytes[0]) << 16) + + (ord($bytes[1]) << 8); + $uue .= pack('C*', (($t >> 18) & 0x3F) + 33, + (($t >> 12) & 0x3F) + 33, + (($t >> 6) & 0x3F) + 33); + } elsif ($cnt == 1) { + my $t = (ord($bytes[0]) << 16); + $uue .= pack('C*', (($t >> 18) & 0x3F) + 33, + (($t >> 12) & 0x3F) + 33); + } else { + die "error in SSA UUE encode: bad chunk length\n"; + } + } + return $uue; +} + +1; diff --git a/lib/Subtitle/SSA/Font.pm b/lib/Subtitle/SSA/Font.pm deleted file mode 100644 index bf3d4ce..0000000 --- a/lib/Subtitle/SSA/Font.pm +++ /dev/null @@ -1,74 +0,0 @@ -package Subtitle::SSA::Font; - -use strict; -use warnings; -use utf8; - -sub new { - my ($class, %opts) = @_; - my $self = { - _eol => "\n", - _data => '', - _name => $opts{name} // '', - _error => undef, - }; - - return bless($self, $class); -} - -sub error { - my ($self, $text) = @_; - - if (defined $text) { - $self->{_error} = $text; - return; - } - return $self->{_error}; -} - -sub parse { - my ($self, $line) = @_; - - return unless $line; - - chomp $line; - $self->error('not like uuencoded line') - if (length($line) > 80); - $self->{_data} .= $line; - - return length($line); -} - -sub save { - my ($self, $path) = @_; - - open my $FH, '>', $path - or return $self->error("can't open file: $path -- $!"); - print $FH pack("u*", $self->{_data}); - close $FH; - - return 1; -} - -sub load { - my ($self, $path) = @_; - - open my $FH, '<', $path - or return $self->error("can't open file: $path -- $!"); - local $/ = undef; - $self->{_data} = unpack("u*", <$FH>); - close $FH; - - return 1; -} - -sub to_string { - my ($self) = @_; - my $out = "fontname: " . $self->{_name} . $self->{_eol}; - my @lines = unpack("A80", $self->{_data}); - $out .= join($self->{_eol}, @lines); - $out .= $self->{_eol}; - return $out; -} - -1;