File Coverage

blib/lib/Parse/SSA.pm
Criterion Covered Total %
statement 43 44 97.7
branch 9 14 64.2
condition n/a
subroutine 4 4 100.0
pod 1 3 33.3
total 57 65 87.6


line stmt bran cond sub pod time code
1             package Parse::SSA;
2             {
3             $Parse::SSA::VERSION = '1.0';
4             }
5              
6             =pod
7             =head NAME
8             Parse::SSA = ASS/SSA subtitle parser
9              
10             =head1 VERSION
11              
12             version 1.0
13              
14             =head1 SYNOPSIS
15              
16             # Simple parsing all texts subtitle
17             my $sub = Parse::SSA->new("./sub.ass");
18             my $row = $sub->subrow();
19             print($row->[5]->{'subtitle'});
20             # subtitle text on 5 line.
21              
22             =head1 DESCRIPTION
23              
24             This module can parse text, time, comments, names from SSA/ASS subtitle fromat.
25              
26             =head1 AUTHOR
27             Konstantin Gromyko Edisinterpreter@protonmail.ch
28              
29             =head1 LICENSE
30              
31             This library is free software; you can redistribute it and/or modify
32             it under the same terms as Perl itself.
33              
34             =head1 SEE ALSO
35              
36             L L
37              
38              
39             =cut
40             #use `5.020_000`;
41 1     1   60666 use warnings FATAL => 'all';
  1         2  
  1         634  
42              
43             my @lines;
44             sub new {
45 1     1 0 77 my ($pkg, $filename) = @_;
46 1         2 my $lineNum = 0;
47 1         2 my $self = {};
48              
49 1         2 my @assfile = ();
50 1 50       38 open( ASSFILE, "<", $filename )
51             or die 'Can not open ".ass" source file:' . $filename . ", please check it!!\n";
52 1         35 while () {
53 56         67 chomp;
54 56 100       139 if (m/^Dialogue:/) {
    100          
55 40         60 $lineNum = extractLine( $lineNum, $_ );
56             }
57             elsif (m/^(Title:|Original)/) {
58             # If a line begins with 'Title' or 'Original', it is the source for the subtitles
59              
60             }
61              
62             }
63 1         8 $self->{'fname'} = $filename;
64 1         5 $self->{'assall'} = \@lines;
65 1         3 bless($self, $pkg);
66              
67 1         7 return $self;
68             }
69              
70             =head2 subrow
71              
72             # Get all parsed data from subtitle
73             my $row = $sub->subrow();
74              
75             The C method gets the data which are present in a Dialogue section: begin time, end time, comment flag, character name, subtitles.
76             =cut
77              
78             sub subrow {
79 1     1 1 9 my ($self) = @_;
80 1         32 return $self->{'assall'};
81             }
82              
83             sub extractLine {
84 40     40 0 52 my ($lineNumber, $content) = @_;
85              
86 40         90 my $begin;
87             my $end;
88 40         0 my $subtitle;
89 40         0 my $name;
90 40         0 my $currentTime;
91              
92 40 50       203 if ( $content
93             =~ m/Dialogue: [^,]*,([^,]*),([^,]*),([^,]*),([^,]*),[^,]*,[^,]*,[^,]*,[^,]*,(.*)$/
94             )
95             {
96 40         69 $begin = $1;
97 40         49 $end = $2;
98 40         45 $name = $4;
99 40         49 $subtitle = $5;
100              
101 40         50 my $isComment = $3;
102 40         81 $begin =~ s/\./,/g;
103 40         72 $end =~ s/\./,/g;
104 40 50       91 if ( $begin =~ m/^\d{1}:/ ) {
105 40         64 $begin = "0" . $begin;
106             }
107              
108 40 50       77 if ( $end =~ m/^\d{1}:/ ) {
109 40         58 $end = "0" . $end;
110             }
111 40         58 $subtitle =~ s/\r$//g;
112 40         53 $subtitle =~ s/\\N/ /g;
113 40         41 $subtitle =~ s/^m\s+\d+.+//g;
114 40         105 $subtitle =~ s/{[^}]*}//g;
115              
116 40 50       62 if ( $isComment eq 'comment' ) {
117 0         0 $subtitle = '(' . $subtitle . ')';
118             }
119 40         116 my %line = ( begin => $begin, end => $end, isComment => $isComment, name=>$name, subtitle => $subtitle );
120 40         63 push @lines, \%line;
121              
122 40         169 return $lineNumber;
123             }
124             }
125              
126             1;