+ Subtitle::SSA::Header

lib/Subtitle/SSA/Header.pm

@@ -4,8 +4,108 @@ use strict;
 use warnings;
 use utf8;
 
+use overload
+  '""' => \&to_string,
+;
+
 sub new {
-  return {};
+  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;