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

package Subtitle::SSA::Header;

use strict;
use warnings;
use utf8;

use overload
  '""' => \&to_string,
;

sub new {
  my ($class, %opts) = @_;
  my $self = {
   _eol   => "\n",
   _vers  => 'ass',
   _error => undef,
   _order => [],
  };
  if ($opts{version} and $opts{version} =~ m{^(ssa|ass)$}oi) {
    $self->{_vers} = lc($opts{version});
  }
  return bless($self, $class);
}

sub error {
  my ($self, $text) = @_;

  if (defined $text) {
    $self->{_error} = $text;
    return;
  }
  return $self->{_error};
}

sub hash_key {
  my ($self, $name) = @_;
  $name = lc($name);
  $name =~ s{[\ \t]}{}go;
  return $name;
}

sub get {
  my ($self, $name) = @_;

  $name = $self->hash_key($name);
  if ($name eq 'scripttype') {
   return ($self->{_vers} eq 'ass') ? 'v4.00+' : 'v4.00' ;
  }
  return if not exists $self->{$name};
  return $self->{$name}->{value};
}

sub set {
  my ($self, $name, $value) = @_;

  my $data = {
    name  => $name,
    value => $value,
  };
  $name = $self->hash_key($name);
  if ($name eq 'scripttype') {
    if ($value =~ m{v4\.00$}o) {
      $self->{_vers} = 'ssa';
    } elsif ($value =~ m{v4\.00\+$}o) {
      $self->{_vers} = 'ass';
    }
    return;
  }
  push @{ $self->{_order} }, $name
    if not exists $self->{$name};
  $self->{$name} = $data;

  return;
}

sub parse {
  my ($self, $line) = @_;

  return unless $line;
  return 1 if $line =~ m{^\s*;}o; # comment

  chomp $line;
  $line =~ s{^\s+}{}o;
  $line =~ s{\s+$}{}o;
  my ($name, $value) = split /\s*:\s*/, $line, 2;

  $self->set($name, $value);
  return 1;
}

sub to_string {
  my ($self) = @_;
  my ($vers, $out);

  $vers = ($self->{_vers} eq 'ass') ? 'v4.00+' : 'v4.00' ;

  $out  = "[Script Info]"                  . $self->{_eol};
  $out .= "; generated with Subtitle::SSA" . $self->{_eol};
  $out .= "ScriptType: $vers"              . $self->{_eol};

  foreach my $key (@{ $self->{_order} }) {
    my $name  = $self->{$key}->{name};
    my $value = $self->{$key}->{value};
    $out .= "$name: $value" . $self->{_eol};
  }
  $out .= $self->{_eol};

  return $out;
}

1;