|
|
@ -9,103 +9,41 @@ use overload |
|
|
|
; |
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
sub new { |
|
|
|
sub new { |
|
|
|
my ($class, %opts) = @_; |
|
|
|
my ($class) = @_; |
|
|
|
my $self = { |
|
|
|
my $self = { |
|
|
|
_eol => "\n", |
|
|
|
name => undef, |
|
|
|
_vers => 'ass', |
|
|
|
value => '', |
|
|
|
_error => undef, |
|
|
|
|
|
|
|
_order => [], |
|
|
|
|
|
|
|
}; |
|
|
|
}; |
|
|
|
if ($opts{version} and $opts{version} =~ m{^(ssa|ass)$}oi) { |
|
|
|
|
|
|
|
$self->{_vers} = lc($opts{version}); |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
return bless($self, $class); |
|
|
|
return bless($self, $class); |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
sub error { |
|
|
|
|
|
|
|
my ($self, $text) = @_; |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if (defined $text) { |
|
|
|
|
|
|
|
$self->{_error} = $text; |
|
|
|
|
|
|
|
return; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
return $self->{_error}; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub hash_key { |
|
|
|
sub hash_key { |
|
|
|
my ($self, $name) = @_; |
|
|
|
my ($self) = @_; |
|
|
|
$name = lc($name); |
|
|
|
my $key = lc($self->{name}); |
|
|
|
$name =~ s{[\ \t]}{}go; |
|
|
|
$key =~ s{\s+}{}go; |
|
|
|
return $name; |
|
|
|
return $key; |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
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 { |
|
|
|
sub parse { |
|
|
|
my ($self, $line) = @_; |
|
|
|
my ($self, $line) = @_; |
|
|
|
|
|
|
|
|
|
|
|
return unless $line; |
|
|
|
return unless $line; |
|
|
|
return 1 if $line =~ m{^\s*;}o; # comment |
|
|
|
return if $line =~ m{^ \s* ;}xo; # comment |
|
|
|
|
|
|
|
|
|
|
|
chomp $line; |
|
|
|
chomp $line; |
|
|
|
$line =~ s{^\s+}{}o; |
|
|
|
$line =~ s{^\s+}{}o; |
|
|
|
$line =~ s{\s+$}{}o; |
|
|
|
$line =~ s{\s+$}{}o; |
|
|
|
my ($name, $value) = split /\s*:\s*/, $line, 2; |
|
|
|
my ($name, $value) = split /\s*:\s*/, $line, 2; |
|
|
|
|
|
|
|
|
|
|
|
$self->set($name, $value); |
|
|
|
$self->{name} = $name; |
|
|
|
|
|
|
|
$self->{value} = $value; |
|
|
|
return 1; |
|
|
|
return 1; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
sub to_string { |
|
|
|
sub to_string { |
|
|
|
my ($self) = @_; |
|
|
|
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; |
|
|
|
return $self->{name} . ': ' . $self->{value}; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
1; |
|
|
|
1; |
|
|
|