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;