libsubtitle-perl/lib/Subtitle/Format/SSA/File.pm

package Subtitle::Format::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;