* Subtitle::SSA::Font : rename & refactor

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;

lib/Subtitle/SSA/Font.pm

@@ -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;