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

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;