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_bytes($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 from_binary { my ($self, $bin) = @_; return unless defined $bin and length($bin) > 0; $self->{data} = _encode_uue($bin); return 1; } sub add_uue_line { my ($self, $line) = @_; my $len = length($line); if ($len == 80) { # optimization $self->{data} .= $line; return 60; } elsif ($len % 4 == 1) { # 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"); } elsif ($len == 0) { return 0; } # else... chomp $line; $self->{data} .= $line; return _length_bytes($line); } ## export functions sub to_binary { my ($self) = @_; return _decode_uue($self->{data}); } sub uue_string { my ($self) = @_; return $self->{data}; } sub uue_block { my ($self) = @_; my $uue = $self->uue_string; 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 _length_bytes { my ($uue) = @_; my $len = length $uue; my $tail = $len % 4; my $size = int($len / 4) * 3; return $size + int(($tail * 6) / 8); } 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;