Subtitles-1.04/0000755000175000017500000000000011716457771011212 5ustar dkdkSubtitles-1.04/Changes0000644000175000017500000000070211716457736012505 0ustar dkdkRevision history for Perl extension Subtitles. 0.01 Thu May 20 19:30:15 2004 - original version; created by h2xs 1.22 with options -X Subtitles 0.02 - More correct parsing of .smi subs - fix time_parse - fix corner cases of split 0.03 - fix smi timing - s/sub/mdvd/ - fix time2(s)hms 1.01 - many small changes 1.02 Dec 3 2008 - recognize dot in srt codec 1.03 Apr 1 2010 - read u16 text 1.04 Feb 15 2010 - read utf8 text Subtitles-1.04/MANIFEST0000644000175000017500000000022311716457771012340 0ustar dkdkChanges Makefile.PL MANIFEST README Subtitles.pm subs subplay t/1.t META.yml Module meta-data (added by MakeMaker) Subtitles-1.04/t/0000755000175000017500000000000011716457771011455 5ustar dkdkSubtitles-1.04/t/1.t0000644000175000017500000000236211314133075011763 0ustar dkdk# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 1.t' ######################### use Test::More qw(no_plan); BEGIN { use_ok('Subtitles') }; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. use Subtitles; # 2: codecs my @codecs = codecs; ok( scalar @codecs); # 3: object API my $x = Subtitles->new(); ok($x); push @{$x-> {from}}, 1; push @{$x-> {to}}, 2; push @{$x-> {text}}, 'hello'; push @{$x-> {from}}, 10; push @{$x-> {to}}, 11; push @{$x-> {text}}, 'world'; # 4: split my ( $a1, $a2) = $x-> split( 5); ok( $a1 && $a2 && $a1-> length == 2 && $a2-> length == 6); # 5: join $a1-> join( $a2, 0); ok( $a1-> length == 8); # etc, file write, file read my $l = $x-> length; for ( @codecs) { next if m/idx$/; # test separately if ( open F, ">test.sub") { $x-> codec( $_); ok( $x-> save(\*F)); close F; } else { last; } # file read if ( open F, " new; ok( $y-> load(\*F)); close F; ok ( abs($y-> length - $l) < 0.5); } unlink 'test.sub'; } Subtitles-1.04/subs0000755000175000017500000003422511314133075012100 0ustar dkdk#!/usr/bin/perl -w # $Id: subs,v 1.16 2008/03/07 22:24:49 dk Exp $ use strict; use Subtitles; my @in; my $out = 'out.sub'; my $jtime = 2; my $a; my $b; my $d; my @eval; my $split; my $separate; my $verbose; my $codec; my $rate; my @points; my @q = (0, 'end'); my $do_q; my $zip; my $inplace; sub usage { my @codecs = map { s/Subtitles::Codec:://; $_} codecs; print <) USAGE exit(0); } # getopt { my ( $i, $do, $ddash, $set_o); sub nextarg { my $arg = $ARGV[++$i]; die "Option `-$1' requires more parameters\n" unless defined $arg; $arg; } for ( $i = 0; $i < @ARGV; $i++) { if ( !$ddash && $ARGV[$i] =~ /^-(.*)$/) { if ( $1 eq 'h') { usage(); } elsif ( $1 eq 'i') { $inplace = 1; } elsif ( $1 eq 'v') { $verbose = 1; } elsif ( $1 eq '-') { $ddash = 1; } elsif ( $1 eq 'o') { $out = nextarg; $set_o = 1; } elsif ( $1 eq 'O') { $separate = 1; $do = 1; } elsif ( $1 eq 'j') { $jtime = nextarg; die "Invalid -j parameter\n" unless $jtime =~ /^[-+]?\d+(\.\d+)?/; } elsif ( $1 eq 'd') { $d = 1; $do = 1; } elsif ( $1 eq 'e') { push @eval, nextarg; $do = 1; } elsif ( $1 eq 'a') { $a = nextarg; $do = 1; die "Invalid -a parameter `$a'\n" unless $a =~ /^(\-?\d+(?:\.\d+)?)(?:\/(\d+(?:\.\d+)?))?/; if ( defined $2) { die "Divizion by zero\n" if $2 == 0; $a = $1/$2; } } elsif ( $1 eq 'c') { $codec = nextarg; my @c = map { s/Subtitles::Codec:://; $_ } codecs; my %c = map { $_ => 1 } @c; die "Invalid codec name `$codec'; valid are: @c\n" unless exists $c{$codec}; $do = 1; } elsif ( $1 eq 'b') { $b = nextarg; $do = 1; } elsif ( $1 eq 'p' or $1 eq 'P') { die "Too many control points\n" if 2 == @points; my @x = (nextarg, nextarg); @x = reverse @x if $1 eq 'P'; push @points, \@x; $do = 1; } elsif ( $1 eq 'q') { die "Too many brackets\n" if $do_q; @q = (nextarg, nextarg); $do_q = 1; } elsif ( $1 eq 'r') { $rate = nextarg; die "Invalid rate `$rate'\n" unless $rate =~ /^\d+(\.\d+)?$/; } elsif ( $1 eq 's') { $split = nextarg; $do = 1; } elsif ( $1 eq 'z') { $zip = nextarg; $do = 1; } else { die "Unknown option `-$1'\n"; } } else { push @in, $ARGV[$i]; } } usage() unless @in; $do = 1 if 1 < @in; die "Nothing to do!\n" unless $do; if ( $inplace) { die "-i and -o options are mutually exclusive\n" if $set_o; die "Cannot edit in place for more than one input file\n" if 1 < @in; die "Cannot edit in place for stdin input\n" if $in[0] eq '-'; $out = $in[0]; } } # read files my $dest; my @entries; for my $fn ( grep { defined } ( @in, $zip)) { my $entry = Subtitles->new(); $entry-> rate( $rate) if $rate; my $ret; if ( $fn eq '-') { $ret = $entry-> load(\*STDIN); $fn = 'stdin'; } else { open F, "< $fn" or die "Error: cannot open $_:$!\n"; $ret = $entry-> load(\*F); close F; $fn = "'$fn'"; } die "Error loading $fn:$@\n" unless $ret; if ( $verbose) { my ( $c, $l) = ( $entry-> codec, $entry-> lines); $c =~ s/Subtitles::Codec:://; warn "read $l line(s) from $fn, codec=$c\n" if $verbose; } push @entries, $entry; } $zip = pop @entries if $zip; $dest = shift @entries; # validate time-based parameters if ( defined $split) { my $s = $dest-> parse_time( $split); die "Cannot parse time `$split'\n" unless defined $s; die "`$split' is negative\n" if $s < 0; $split = $s; warn "split by ". time2str($s) . "\n" if $verbose; } # points for (@points) { my ( $p1, $p2) = @$_; my ( $s1, $s2); $s1 = (($p1 =~ s/^([-+])//) ? $1 : ''); $s2 = (($p2 =~ s/^([-+])//) ? $1 : ''); my $t = $dest-> parse_time( $p1); die "Cannot parse time `$s1$p1'\n" unless defined $t; $p1 = $t; $t = $dest-> parse_time( $p2); die "Cannot parse time `$s2$p2'\n" unless defined $t; $p2 = $t; die "Both times in control point [$s1$p1,$s2$p2] are relative\n" if length $s1 and length $s2; if ( length $s1) { # $p1 is relative $p1 = $p2 + $p1 * (( $s1 eq '-') ? -1 : 1); } elsif ( length $s2) { # $p2 is relative $p2 = $p1 + $p2 * (( $s2 eq '-') ? -1 : 1); } $_ = [$p1,$p2]; } unshift @points, [0,0] if 1 == @points; if ( 2 == @points) { my ( $t1, $u1) = @{$points[0]}; my ( $t2, $u2) = @{$points[1]}; die "-p option conflicts with -a and -b\n" if defined($a) || defined($b); my ( $dt, $du) = ( $t2 - $t1, $u2 - $u1); die "Point sets refers to the same time\n" if $dt == 0 || $du == 0; # # # |u(subtitles) # | # u2 | * # u1 | * # | t(speech) # ---------------------- # t1 t2 # $a = $dt / $du; $b = $t1 - $u1 * $a; warn "control points [", time2str($t1), ",", time2str($u1), "], [", time2str($t2), ",", time2str($u2), "]\n" if $verbose; $b = time2str( $b); } # a & b $a = 1 unless defined $a; if ( defined $b) { my $bb = $dest-> parse_time( $b); die "Cannot parse time `$b'\n" unless defined $bb; $b = $bb; warn "a=$a,b='". time2str($b) . "'\n" if $verbose; } else { $b = 0; warn "a=$a,b=$b\n" if $verbose; } # process $dest-> join( $_, $jtime) for @entries; # join # zip if ( $zip) { my $f1 = $zip->{from}; my $t1 = $zip->{to}; my $f2 = $dest->{from}; my $t2 = $dest->{to}; my $x2 = $dest->{text}; my $n1 = @$f1; my $n2 = @$f2; if ( $n2 > $n1) { warn "zip: $n1 timeslices available while $n2 found in input -- ". "timeframes after ". time2str( $f2->[$n1] ). ", #$n1, will be left unchanged\n" } elsif ( $n2 < $n1) { warn "zip: $n2 timeslices available while only $n1 found in input -- " . "padding with empty lines\n"; for ( my $i = $n2; $i < $n1; $i++) { push @$f2, $$f1[$i]; push @$t2, $$t1[$i]; push @$x2, ''; } $n1 = $n2; } for ( my $i = 0; $i < $n1; $i++) { ($$f2[$i], $$t2[$i]) = ( $$f1[$i], $$t1[$i]); } } # brackets and transform my $vv_q = "brackets [ "; for ( @q) { if ( $_ eq 'end') { $_ = $dest-> length; } else { my $q = $dest-> parse_time( $_); die "Cannot parse time `$_'\n" unless defined $q; $_ = $q; } $vv_q .= time2str($_) . ' '; } warn "$vv_q ]\n" if $verbose; $dest-> transform( $a, $b, @q); # prolong timing if ( $d) { my $i = 0; my $from = $dest->{from}; my $to = $dest->{to}; my $text = $dest->{text}; my $n = @$from; my $c = 0; my ($qfrom, $qto) = @q; $qfrom = 0 unless defined $qfrom; $qto = $$to[-1] unless defined $qto; for ( $i = 0; $i < $n; $i++) { my @clob = split("\n", $$text[$i]); my $min = 0.8 * @clob; next if $$to[$i] - $$from[$i] > $min; next if $$from[$i] > $qto || $$to[$i] < $qfrom; if ( $i < $n - 1 && $$to[$i] + $min > $$from[$i+1]) { $$to[$i] = $$from[$i+1] - 0.01; } else { $$to[$i] = $$from[$i] + $min; } $c++; } warn "$c lines prolonged\n"; } # -O if ( $separate) { my $from = $dest->{from}; my $to = $dest->{to}; my $text = $dest->{text}; my $n = @$from; my $c = 0; my ($qfrom, $qto) = @q; $qfrom = 0 unless defined $qfrom; $qto = $$to[-1] unless defined $qto; for ( my $i = 0; $i < $n - 1; $i++) { next if $$from[$i] > $qto || $$to[$i + 1] < $qfrom; my $d = $$to[$i] - $$from[$i + 1]; next if $d < 0; $d = 0.002 if $d < 0.002; $d /= 2.0; $$to[$i] -= $d; $$from[$i+1] += $d + 0.001; $c++; } warn "$c overlapped lines separated\n"; } # -e if ( @eval) { my $i = 0; my $from = $dest->{from}; my $to = $dest->{to}; my $text = $dest->{text}; my $n = @$from; my ($qfrom, $qto) = @q; $qfrom = 0 unless defined $qfrom; $qto = $$to[-1] unless defined $qto; my %p; for my $eval ( @eval) { for ( $i = 0; $i < $n; $i++) { local $_ = $$text[$i]; my $b = $$from[$i]; my $e = $$to[$i]; next if $b > $qto || $e < $qfrom; eval $eval; die "error in '$eval': $@" if $@; $$text[$i] = $_; $$from[$i] = $b; $$to[$i] = $e; } } } $dest-> codec( "Subtitles::Codec::$codec") if defined $codec; my @write; if ( defined $split) { # split & save # no inplace logic - original file is never overwritten my ( $s1, $s2) = $dest-> split( $split); my $root = $out; $root =~ s/(\.[^\.]*)$//; my $tail = defined($1) ? $1 : ''; warn "write ".$s1->lines." line(s) in '$root.1$tail'\n" if $verbose; open F, "> $root.1$tail" or die "Cannot open $root.1$tail:$!\n"; $s1-> save(\*F) or die "Error saving $root.2$tail:$@\n"; close F; warn "write ".$s2->lines." line(s) in '$root.2$tail'\n" if $verbose; open F, "> $root.2$tail" or die "Cannot open $root.2$tail:$!\n"; $s2-> save(\*F) or die "Error saving $root.2$tail:$@\n"; close F; } else { # just save warn "write ".$dest->lines." line(s) in '$out'\n" if $verbose; my $rename = $inplace or -f $out; if ( $rename) { rename $out, "$out.bak" or die "Cannot rename $out to $out.bak:$!\n"; } eval { open F, "> $out" or die "Cannot open $out:$!\n"; $dest-> save(\*F) or die "Error saving $out:$@\n"; close F; }; if ( $@) { rename "$out.bak", $out if $rename; die $@; } } # done exit(0); __DATA__ =pod =head1 NAME subs - convert, join, split, and re-time subtitles =head1 FORMAT subs [options] subfile [ subfile ... ] =head1 OPTIONS =over =item -a coeff, -b time a and b coefficients in linear transformation u=at+b, where t and u are src and dest times ( default(identity transform) is [a=1,b=0] ). -a can be set as ratio, f.ex. 23.9/25 =item -c codec Use codec to write file. Run 'subs -h' for list of installed codecs. =item -d Try to prolong duration of quickly disappearing text. 'Quickly' is less than 0.8 second per line of text. =item -e command Run perl code for each line of text in file. On each run, the text and time variables are initialized, and new values, if any, written to the file. The variables are used for: =over =item $_ subtitle text line =item $b cue beginning =item $e cue end =item $i line number =item $n number of lines =item %p persistent data between runs =back The -e option can be specified several times =item -h Display help =item -i Edit files in place ( makes backup in .bak files ) =item -j sec Time interval between joins, seconds (default 2) =item -o file File to save processed subtitles (default out.sub) =item -O Separate overlapped lines =item -p t1 t2 or -P t2 t1 Set a control point, where t1 is time of a phrase spoken in the film and t2 is time when the same phrase as appears in the subtitle. Two points are required for deducing -a and -b coefficients; if only one point is specified, it is assumed that the other one is [0,0]. Times can be relative, f.ex. -p 01:00 +3.5 -p -20 1:00:00 Options -P and -p are the same except the argument sequence is reversed. -P is to be used when arguments to -p were typed manually and in wrong order. =item -q t1 t2 Restrict changes, if any, in time span t1-t2. Word 'end' can be used as an alias to the end of the file. Default values are '0' and 'end'. =item -r rate Force frame-per-second rate for frame-based subs =item -s time Split in two parts by time =item -v Be verbose =item -z file.sub Zip subtitle files so time information is read from file.sub, while text information is read from the input file(s). =back =head1 NOTES The time format is either [[HH:]MM:]SS[.MSEC] or subtitle format-specific =head1 EXAMPLES Warning: -i is a great feature, but use it with certain caution. If subtitles are shown too early ( 5 seconds): subs -i -b 5 file.sub If subtitles are for a movie in 25 fps, need to be for 24 ( actual for frame-based formats only ). subs -i -a 24/25 file.sub If subtitles start ok, but in 1 hour are late in 7 seconds: subs -i -p 0 0 -p 1:00:00 +7 file.sub Join two parts with 15-second gap subs -o joined.sub -j 15 part1.sub part2.sub Split in two after 50 minutes and half a second ( makes basename.1.sub and basename.2.sub ). subs -o basename.sub -s 50:00.5 toobig.sub Remove closed caption-specific comments such as '[Sneezing]' or '[Music playing]' subs -e 's/[\s-]*\[.*\]\s*\n*//gs' sub.sub =head1 BUGS Subtitles written as C<.smi> format may differ from original. =head1 SEE ALSO L - backend module for this program =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =cut Subtitles-1.04/Makefile.PL0000644000175000017500000000107111314133075013141 0ustar dkdk# $Id $ use 5.008; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Subtitles', 'VERSION_FROM' => 'Subtitles.pm', # finds $VERSION 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'Subtitles.pm', # retrieve abstract from module AUTHOR => 'Dmitry Karasik ') : ()), 'EXE_FILES' => ['subs', 'subplay'], ); Subtitles-1.04/subplay0000755000175000017500000001236311314133075012602 0ustar dkdk#!/usr/bin/perl -w # $Id: subplay,v 1.3 2007/03/09 10:07:29 dk Exp $ =pod =head1 NAME subplay - play subtitles file =head1 SYNOSIS subplay my_movie.srt =head1 DESCRIPTION So, you're thinking that my player doesn't display subtitles? No, it does wery well. The reason for this script is there, is that it happened so that I wanted to see a movie with both Danish and English subtitles. Usually, not a problem, if you've text subtitles - but in my case one sub was in .srt text format, while the another in .idx/.sub binary ( dvd-rip? ) format. I couldn't find anything related, so this script was born. =head1 OPTIONS None. Tweak colors, fonts, etc in the source. There are some run-time switches, right-click to get them displayed in a pop-up menu. =head1 PREREQUISTIES Prima - L. =head1 AUTHOR Dmitry Karasik =cut use strict; use Prima qw(Application Sliders Label Buttons); use Subtitles; use Time::HiRes qw(time); # do your local changes here my %font = ( size => 16 ); # style => fs::Bold|fs::Italic, encoding => 'iso8859-5', etc etc my $refresh_rate = 100; # ms my $window_height = 120; my $fore_color = 0xFFFFFF; my $back_color = 0x000000; my $hilite_color = 0x000080; die "format: subplay filename.sub\n" unless @ARGV; my $fn = shift @ARGV; open F, "< $fn" or die "Cannot open $fn:$!\n"; my $subs = Subtitles->new(); $subs-> load(\*F) or die "Cannot load $fn:$@\n"; # convert cues to events my $from = $subs->{from}; my $to = $subs->{to}; my $text = $subs->{text}; my $length = $subs-> length; my ( @cues, @events); push @events, [0, '']; for ( my $i = 0; $i < @$from; $i++) { my @exit_cues = grep { $cues[$_][0] < $$from[$i] } 0..$#cues; if ( @exit_cues) { for ( sort { $cues[$a][0] <=> $cues[$b][0] } @exit_cues) { $cues[$_][1] = undef; my $text = join("\n", map { $$_[1] } grep { defined $$_[1] } @cues ); if ( @events and $events[-1][0] eq $cues[$_][0]) { $events[-1][1] = $text; } else { push @events, [ $cues[$_][0], $text]; } } splice( @cues, $_, 1) for reverse @exit_cues; } my $cue = ''; if ( @cues) { $cue = join("\n", map { $$_[1] } @cues ) . "\n"; } push @events, [ $$from[$i], $cue . $$text[$i]]; push @cues, [ $$to[$i], $$text[$i]]; } push @events, [ $length + 0.1, '']; my $playing = 0; my $start_time; my $ticking; my $current_event = -1; my $w = Prima::MainWindow-> create( packPropagate => 0, height => $window_height, width => $::application-> width - $::application-> get_system_value( sv::XbsSizeable) * 2, bottom => 0, left => $::application-> get_system_value( sv::XbsSizeable), text => $fn, backColor => $back_color, color => $fore_color, popupItems => [ ['Stop/Play' => 'Space' , kb::Space , \&button ], ['Set/clear decorations', 'F1', => kb::F1 , \&set_decorations ], ['Show/hide controls', 'F2', => kb::F2 , \&set_controls ], ['Stay/no stay on top', 'F3', => kb::F3 , \&set_on_top ], [], ['Quit', 'Ctrl+Q', => '^Q' , sub { exit } ], ], ); $text = $w-> insert( 'Label', pack => { fill => 'both', expand => 1 }, text => '', font => \%font, alignment => ta::Center, valignment => ta::Center, ownerColor => 1, ); my $button = $w-> insert( 'Button' => pack => { anchor => 'sw', side => 'left' }, default => 1, text => '~Play', hiliteColor => $fore_color, hiliteBackColor => $back_color, flat => 1, onClick => \&button, ); my $timer = $w-> insert( 'Timer', timeout => $refresh_rate, onTick => \&tick, ); my $slider = $w-> insert( 'Slider', pack => { fill => 'x', side => 'left', expand => 1 }, height => 36, min => 0, max => $length, step => 0.001, ribbonStrip => 1, shaftBreadth => 12, onChange => \&track, hiliteBackColor => $back_color, hiliteColor => $hilite_color, ); sub time2event { my $time = $_[0]; my ( $l, $r) = ( 0, $#events); return $l if $time < 0; return $r if $time >= $length; my $lastt = -1; while ( 1) { my $t = int(( $r + $l) / 2); # print "start $time, $l, $r => $t/$lastt $events[$t]->[0]-".$events[$t+1]->[0]."\n"; return $t if $t == $lastt; return $t if $events[$t]->[0] <= $time and ( !defined $events[$t+1] or $events[$t+1]->[0] > $time); (( $events[$t]->[0] < $time) ? $l : $r) = $lastt = $t; } } sub track { my $v = $slider-> value; my $x; if ( $ticking) { $x = $subs-> time2str( int $v); $x =~ s/\.000//g; } else { $x = $subs-> time2str( $v); } $w-> text( "$fn: $x"); my $e = time2event( $v); $text-> text( $events[$current_event = $e]->[1]) if $e != $current_event; $start_time = time - $slider-> value unless $ticking; } sub button { if ( $playing) { $playing = 0; $timer-> stop; $button-> text('~Play'); } else { $playing = 1; $timer-> start; $start_time = time - $slider-> value; $button-> text('~Stop'); } } sub set_decorations { if ( $w-> borderIcons) { $w-> set( borderIcons => 0, borderStyle => bs::None); } else { $w-> set( borderIcons => bi::All, borderStyle => bs::Sizeable); } } sub set_on_top { return unless $w-> can('onTop'); # 1.17 and higher $w-> onTop( !$w-> onTop); } sub set_controls { if ( $button-> visible) { $button-> hide; $slider-> hide; } else { $button-> show; $slider-> show; } } sub tick { my $t = time - $start_time; $ticking = 1; $slider-> value( $t); $ticking = 0; button() if $playing and $t >= $length; } run Prima; Subtitles-1.04/META.yml0000644000175000017500000000105111716457771012460 0ustar dkdk--- #YAML:1.0 name: Subtitles version: 1.04 abstract: handle video subtitles in various text formats author: - Dmitry Karasik license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: {} no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.56 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Subtitles-1.04/Subtitles.pm0000644000175000017500000005377511716457754013550 0ustar dkdk# $Id: Subtitles.pm,v 1.22 2012/02/14 13:21:48 dk Exp $ package Subtitles; use strict; require Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK @codecs $VERSION); @ISA = qw(Exporter); @EXPORT = qw(codecs time2str); @EXPORT_OK = qw(codecs time2hms time2shms hms2time time2str); $VERSION = '1.04'; use Encode; push @codecs, map { "Subtitles::Codec::$_" } qw( srt mdvd sub2 smi idx); # # package-oriented API # sub time2hms { shift if $#_ == 1; # package and object my $time = $_[0]; $time = 0 if $time < 0; $time += .0005; return int($time/3600),int(($time%3600)/60),int($time%60),int(($time-int($time))*1000), } sub time2shms { shift if $#_ == 1; # package and object my $time = $_[0]; my $sign; if ( $time < 0) { $sign = -1; $time = -$time; } else { $sign = 1; } $time += .0005; return $sign,int($time/3600),int(($time%3600)/60),int($time%60),int(($time-int($time))*1000), } sub hms2time { shift if $#_ == 4; # package and object my ( $h, $m, $s, $ms) = @_; return $h * 3600 + $m * 60 + $s + $ms / 1000; } sub time2str { shift if $#_ == 1; # package and object my $time = $_[0]; my $is_minus = ''; $time = -$time, $is_minus = "-" if $time < 0; return sprintf ( "$is_minus%02d:%02d:%02d.%03d", time2hms($time)); } sub codecs { @codecs } # # object-oriented API # sub new { my $class = shift; return bless { codec => undef, @_, text => [], from => [], to => [], class => $class, }, $class; } sub load { my ( $self, $fh, $codec) = @_; $self-> clear; local $/; my $content = <$fh>; if ( $content =~ s/^(\xff\xfe|\xfe\xff)//) { # found a 16-bit bom my $le = ( $1 eq "\xff\xfe" ) ? 'v*' : 'n*'; $content = join('', map { chr } unpack($le, $content)); } elsif ( $content =~ s/^\xef\xbb\xbf//) { # found a utf-8 bom Encode::_utf8_on($content); } my @content; for ( split "\n", $content) { s/[\s\n\r]+$//; push @content, $_; } unless ( defined $codec) { for ( @content) { my $line = $_; for ( @codecs) { next unless $_-> match( $line); $codec = $_; } } } unless ( defined $codec) { $@ = "No suitable codec is found"; return undef; } my $ret; eval { $ret = $codec-> read( $self, \@content); }; return undef if $@ or !defined $ret; # validate if ( @{$self->{from}} == 0) { $@ = "Empty subtitle"; return undef; } if ( @{$self->{from}} != @{$self->{to}}) { if ( @{$self->{from}} == @{$self->{to}} + 1) { push @{$self->{to}}, $self->{from}->[-1] + 2; # fix a dangling tail } else { my $a = @{$self->{from}}; my $b = @{$self->{to}}; $@ = "Number of 'from' ($a) and 'to' ($b) timeframe positions is different"; return undef; } } if ( @{$self->{from}} != @{$self->{text}}) { if ( @{$self->{from}} == @{$self->{text}} + 1) { push @{$self->{text}}, ''; # fix a dangling tail } else { my $a = @{$self->{from}}; my $b = @{$self->{text}}; $@ = "Number of timeframes ($a) is different from the number of text lines ($b)"; return undef; } } $self->{codec} = $codec; return 1; } sub codec { return $_[0]-> {codec} unless $#_; my ( $self, $codec) = @_; my %c = map { $_ => 1 } @codecs; return unless exists $c{$codec}; return if defined $self->{codec} && $self->{codec} eq $codec; $self->{codec}-> downgrade($self, $codec) if defined $self->{codec}; $self->{codec} = $codec; } sub rate { return $_[0]-> {rate} unless $#_; return if defined $_[1] && $_[1] <= 0; $_[0]->{rate} = $_[1]; } # parses # SS # MM:SS # HH:MM:SS # HH:MM:SS,msec # MM:SS,msec # into time sub parse_time { my ( $self, $time) = @_; my $sign = 1; $sign = -1 if $time =~ s/^-//; if ( $time =~ m/^(?:(\d{1,2}):)?(?:(\d{1,2}):)?(\d{1,2})(?:[\,\.\:](\d{1,3}))?$/) { my ( $h, $m, $s, $ms) = ( $1, $2, $3, $4); ( $h, $m) = ( $m, $h) if defined $h && ! defined $m; $h = 0 unless defined $h; $m = 0 unless defined $m; $ms = '0' unless defined $ms; $ms .= '0' while length($ms) < 3; return $sign * ( $h * 3600 + $m * 60 + $s + $ms / 1000); } elsif ( $self && $self-> {codec}) { my $t = $self->{codec}->time($time); return $sign * $t if defined $t; } undef; } sub shift { $_[0]-> transform( 1, $_[1]) } sub scale { $_[0]-> transform( $_[1], 0) } sub lines { scalar @{$_[0]->{text}} } # applies linear (y = ax+b) transformation within a scope sub transform { my ( $self, $a, $b, $qfrom, $qto) = @_; return if $a == 1 && $b == 0; $qfrom = 0 unless defined $qfrom; $qto = $self->{to}->[-1] unless defined $qto; my $i; my $n = $self-> lines; my $from = $self->{from}; my $to = $self->{to}; for ( $i = 0; $i < $n; $i++) { next if $$from[$i] > $qto || $$to[$i] < $qfrom; $$from[$i] = $a * $$from[$i] + $b; $$to[$i] = $a * $$to[$i] + $b; } } sub dup { my ( $self, $clear) = @_; if ( $clear) { return bless { %$self, text => [], from => [], to => [], }, $self-> {class}; } else { return bless { %$self, text => [ @{$self->{text}}], from => [ @{$self->{from}}], to => [ @{$self->{to}}], }, $self-> {class}; } } sub clear { my $self = $_[0]; $self-> {text} = []; $self-> {from} = []; $self-> {to} = []; } sub join { my ( $self, $guest, $time_between) = @_; $time_between = 2 unless defined $time_between; my $delta = $time_between + $self-> length; push @{$self->{text}}, @{$guest->{text}}; push @{$self->{from}}, map { $_ + $delta } @{$guest->{from}}; push @{$self->{to}}, map { $_ + $delta } @{$guest->{to}}; } sub split { my ( $self, $where) = @_; my ( $s1, $s2) = ( $self-> dup(1), $self-> dup(1)); my $i; my $n = $self->lines; my $t = $self->{to}; my ( $end, $begin); $end = $n - 1; for ( $i = 0; $i < $n; $i++) { next if $$t[$i] <= $where; $begin = $i; $end = $i - 1; last; } if ( defined $end && $end >= 0) { @{$s1->{text}} = @{$self->{text}}[0..$end]; @{$s1->{from}} = @{$self->{from}}[0..$end]; @{$s1->{to}} = @{$self->{to}}[0..$end]; } if ( defined $begin && $begin < $n) { @{$s2->{text}} = @{$self->{text}}[$begin..$n-1]; @{$s2->{from}} = @{$self->{from}}[$begin..$n-1]; @{$s2->{to}} = @{$self->{to}}[$begin..$n-1]; $s2-> shift( -$where); } ($s1,$s2); } sub length { my $self = $_[0]; return @{$self->{to}} ? $self->{to}->[-1] : 0; } sub save { my ( $self, $fh) = @_; my $content; eval { $content = $self-> {codec}-> write( $self); die "no content" unless defined $content and @$content; $content = CORE::join("\n", @$content); if ( Encode::is_utf8($content)) { # bomify print $fh "\xef\xbb\xbf" or die "write error:$!"; binmode $fh, ':utf8'; } print $fh $content, "\n" or die "write error:$!"; }; return $@ ? 0 : 1; } package Subtitles::Codec; use vars qw(@ISA); sub match { my ( $self, $line) = @_; undef; } sub read { my ( $self, $sub, $content) = @_; die "abstract method call"; } sub write { my ( $self, $sub) = @_; die "abstract method call"; } sub time { undef } sub downgrade {} package Subtitles::Codec::srt; use vars qw(@ISA); @ISA=qw(Subtitles::Codec); sub match { $_[1] =~ m/^(\d\d):(\d\d):(\d\d)[.,](\d\d\d)\s*-->\s*(\d\d):(\d\d):(\d\d)[.,](\d\d\d)/; } sub read { my ( $self, $sub, $content) = @_; my $stage = 0; my $num = 1; my $line = 0; # 0: # 1: 1 # 2: 00:00:04,073 --> 00:00:05,781 # 3: Subtitle for ( @$content) { $line++; if ( $stage == 0) { next unless length; die "Invalid line numbering at line $line\n" unless m/^\d+$/; $num++; $stage++; } elsif ( $stage == 1) { die "Invalid timing at line $line\n" unless m/^(\d\d):(\d\d):(\d\d)[.,](\d\d\d)\s*-->\s*(\d\d):(\d\d):(\d\d)[.,](\d\d\d)/; push @{$sub->{from}}, Subtitles::hms2time( $1, $2, $3, $4); push @{$sub->{to}}, Subtitles::hms2time( $5, $6, $7, $8); $stage++; } elsif ( $stage == 2) { if ( length) { push @{$sub->{text}}, $_; $stage++; } else { push @{$sub->{text}}, ''; $stage = 0; } } else { if ( length) { $sub->{text}->[-1] .= "\n$_"; } else { $stage = 0; } } } 1; } sub write { my ( $self, $sub) = @_; my $n = @{$sub->{text}}; my $i; my @ret; my $from = $sub->{from}; my $to = $sub->{to}; my $text = $sub->{text}; for ( $i = 0; $i < $n; $i++) { push @ret, $i + 1, sprintf ( "%02d:%02d:%02d,%03d --> %02d:%02d:%02d,%03d", Subtitles::time2hms($from->[$i]), Subtitles::time2hms($to->[$i]), ), split ("\n", $text->[$i]), '' ; } \@ret; } package Subtitles::Codec::mdvd; use vars qw(@ISA); @ISA=qw(Subtitles::Codec); sub match { $_[1] =~ m/^[{\[]\d+[}\]][{\[]\d*[}\]]/; } sub read { my ( $self, $sub, $content) = @_; my $line = 0; # {3724}{3774}Text my $fps = $sub->{rate} ? $sub->{rate} : 23.976; my $from = $sub->{from}; my $to = $sub->{to}; my $text = $sub->{text}; for ( @$content) { $line++; unless ( m/^[{\[](\d+)[}\]][{\[](\d*)[}\]](.*)$/) { warn "Invalid input at line $line\n"; next; } push @$from, $1/$fps; push @$to, length($2) ? ($2/$fps) : ($1+1)/$fps; my $t = $3; $t=~ s/\|\s*/\n/g; push @$text, $t; } 1; } sub write { my ( $self, $sub) = @_; my $fps = $sub->{rate} ? $sub->{rate} : 23.976; my $n = @{$sub->{text}}; my $i; my @ret; my $from = $sub->{from}; my $to = $sub->{to}; my $text = $sub->{text}; for ( $i = 0; $i < $n; $i++) { my $t = $text->[$i]; $t =~ s/\n/\|/g; push @ret, sprintf ( "{%d}{%d}%s", int( $from->[$i] * $fps + .5), int( $to->[$i] * $fps + .5), $t ); } \@ret; } package Subtitles::Codec::sub2; use vars qw(@ISA); @ISA=qw(Subtitles::Codec); sub match { $_[1] =~ m/^\[(SUBTITLE|COLF)\]/i or $_[1] =~ m/^(\d\d):(\d\d):(\d\d)\.(\d\d),(\d\d):(\d\d):(\d\d)\.(\d\d)/; } sub read { my ( $self, $sub, $content) = @_; my $line = 0; # [INFORMATION] # [AUTHOR] # [SOURCE] # [PRG] # [FILEPATH] # [DELAY] # [CD TRACK] # [COMMENT] # [END INFORMATION] # # [SUBTITLE] # [COLF]&HFFFFFF,[STYLE]no,[SIZE]18,[FONT]Arial # 00:04:10.26,00:04:13.57 # Welcome to Gattaca. my $from = $sub->{from}; my $to = $sub->{to}; my $text = $sub->{text}; my @header; my $read_header = 1; my $state = 0; for ( @$content) { $line++; if ( $read_header) { if ( m/^(\d\d):(\d\d):(\d\d)\.(\d\d)\,(\d\d):(\d\d):(\d\d)\.(\d\d)/) { $read_header = 0; goto BODY; } push @header, $_; } else { BODY: if ( $state == 0) { next unless length; die "Invalid timing at line $line\n" unless m/^(\d\d):(\d\d):(\d\d)\.(\d\d)\,(\d\d):(\d\d):(\d\d)\.(\d\d)/; push @$from, Subtitles::hms2time( $1, $2, $3, $4 * 10); push @$to, Subtitles::hms2time( $5, $6, $7, $8 * 10); $state = 1; } else { s/\[br\]\s*/\n/g; push @$text, $_; $state = 0; } } } $sub->{sub2}->{header} = \@header; 1; } sub write { my ( $self, $sub) = @_; my $n = @{$sub->{text}}; my $i; my @ret; if ( $sub->{sub2}->{header}) { @ret = @{$sub->{sub2}->{header}}; } else { @ret = split "\n", <{from}; my $to = $sub->{to}; my $text = $sub->{text}; for ( $i = 0; $i < $n; $i++) { my ($fh,$fm,$fs,$fms) = Subtitles::time2hms($from->[$i]); my ($th,$tm,$ts,$tms) = Subtitles::time2hms($to->[$i]); $fms = int ( $fms / 10); $tms = int ( $tms / 10); my $t = $text->[$i]; $t =~ s/\n/[br]/g; push @ret, sprintf ( "%02d:%02d:%02d.%02d,%02d:%02d:%02d.%02d", $fh,$fm,$fs,$fms, $th,$tm,$ts,$tms ), $t, '' ; } \@ret; } package Subtitles::Codec::smi; use vars qw(@ISA); @ISA=qw(Subtitles::Codec); sub match { $_[1] =~ m/^/i; } sub read { my ( $self, $sub, $content) = @_; # # # # # # #

Juon - A curse born of a strong grudge held by someone
who died. # #

  # # # my $from = $sub->{from}; my $to = $sub->{to}; my $text = $sub->{text}; my (@header,@footer); my $read_header = 1; my $read_footer = 0; my $body = ''; # extract body to inspect closer for ( @$content) { if ( $read_header) { if ( m//i) { $read_header = 0; } push @header, $_; } elsif ( $read_footer) { push @footer, $_; } else { if ( m/<\/BODY>/) { push @footer, $_; $read_footer = 1; next; } $body .= $_; } } # parse body my $sync = 0; my $line = ''; while ( $body =~ m/\G(?:(?:(\s*)<\s*([^\>]*)\s*>)|([^<>]*))/gcs) { if ( defined $2 and length $2) { my $t = $1; $_ = $2; if ( m/^sync\s+start\s*=\s*(\d+)/i) { $sub->{smi}->{s1gap} = length $t unless defined $sub->{smi}->{s1gap}; my $s = $1; die "Inconsistency near '$_' ( is less than previous sync $sync )\n" if $s < $sync; if ( $line !~ /^[\n\s]*$/s) { $line =~ s/[\n\s]+$//s; push @$from, $sync / 1000; push @$to, $s / 1000; push @$text, $line; } $sync = $s; $line = ''; } elsif ( m/^p\s+class\s*\=\s*(\S+)/i) { $sub->{smi}->{s2gap} = length $t unless defined $sub->{smi}->{s2gap}; $sub-> {smi}-> {class} = $1 unless defined $sub->{smi}->{class}; } elsif ( m/^\s*br\s*/i) { $line .= "\n"; } } elsif ( defined $3 and length $3) { $_ = $3; s/&nsbp;/ /g; $line .= $_; } } $sub->{smi}->{header} = \@header; $sub->{smi}->{footer} = \@footer; return 1; } sub write { my ( $self, $sub) = @_; my $n = @{$sub->{text}}; my $i; my @ret; my $from = $sub->{from}; my $to = $sub->{to}; my $text = $sub->{text}; my $smi_class = defined ($sub->{smi}->{class}) ? $sub->{smi}->{class} : 'SUBTTL'; if ( $sub->{smi}->{header}) { @ret = @{$sub->{smi}->{header}}; } else { @ret = split "\n", < HEADER } my $s1 = ' ' x ( $sub->{smi}->{s1gap} || 0); my $s2 = ' ' x ( $sub->{smi}->{s2gap} || 0); for ( $i = 0; $i < $n; $i++) { my $f = int($$from[$i] * 1000 + .5); my $t = int($$to[$i] * 1000 + .5); my $x = $$text[$i]; $x =~ s/\n/
/g; push @ret, "$s1", "$s2

$x"; push @ret, "$s1", "$s2

 " if $i == $n - 1 || int($$from[$i+1] * 1000 + .5) != $t; ; } if ( $sub->{smi}->{footer}) { push @ret, @{$sub->{smi}->{footer}}; } else { push @ret, split "\n", < FOOTER } \@ret; } sub downgrade { for ( @{$_[1]->{text}}) { s/<[^\>]*>//g; s/{[^\}]*}//g; } } package Subtitles::Codec::idx; use vars qw(@ISA); @ISA=qw(Subtitles::Codec); sub match { $_[1] =~ m/^\s*\#\s*VobSub index file/ } sub read { my ( $self, $sub, $content) = @_; my $line = 0; # # VobSub index file, v7 (do not modify this line!) # # # # To repair desyncronization, you can insert gaps this way: # # (it usually happens after vob id changes) # # # # delay: [sign]hh:mm:ss:ms # # # # Where: # # [sign]: +, - (optional) # # hh: hours (0 <= hh) # # mm/ss: minutes/seconds (0 <= mm/ss <= 59) # # ms: milliseconds (0 <= ms <= 999) # # # # Note: You can't position a sub before the previous with a negative value. # # # # You can also modify timestamps or delete a few subs you don't like. # # Just make sure they stay in increasing order. # # # # Settings # # # Original frame size # size: 720x576 # # # Origin, relative to the upper-left corner, can be overloaded by aligment # org: 0, 0 # # # Image scaling (hor,ver), origin is at the upper-left corner or at the alignment coord (x, y) # scale: 100%, 100% # # # Alpha blending # alpha: 100% # # # Smoothing for very blocky images (use OLD for no filtering) # smooth: OFF # # # In millisecs # fadein/out: 50, 50 # # # Force subtitle placement relative to (org.x, org.y) # align: OFF at LEFT TOP # # # For correcting non-progressive desync. (in millisecs or hh:mm:ss:ms) # # Note: Not effective in DirectVobSub, use "delay: ... " instead. # time offset: 0 # # # ON: displays only forced subtitles, OFF: shows everything # forced subs: OFF # # # The original palette of the DVD # palette: 0000e1, e83f07, 000000, fdfdfd, 033a03, ea12eb, faff1a, 095d76, 7c7c7c, e0e0e0, 701f03, 077307, 00006c, cc0ae9, d2ab0f, 730972 # # # Custom colors (transp idxs and the four colors) # custom colors: OFF, tridx: 1000, colors: fdfdfd, 000000, e0e0e0, faff1a # # # Language index in use # langidx: 0 # # # Dansk # id: da, index: 0 # # Decomment next line to activate alternative name in DirectVobSub / Windows Media Player 6.x # # alt: Dansk # # Vob/Cell ID: 3, 1 (PTS: 0) # timestamp: 00:00:44:280, filepos: 000000000 # timestamp: 00:00:50:520, filepos: 000003000 my $from = $sub->{from}; my $to = $sub->{to}; my $text = $sub->{text}; my @header; my $read_header = 1; my $state = 0; my @comments; for ( @$content) { if ( m/^\s*timestamp\:\s*(\d\d)\:(\d\d)\:(\d\d)\:(\d+).*?filepos\:\s*(.*)$/) { push @$from, Subtitles::hms2time( $1, $2, $3, $4); push @$text, $5; } else { push @comments, [ scalar @$from, $_ ]; } $line++; } for ( $line = 0; $line < @$from - 1; $line++) { $$to[$line] = $$from[$line + 1] - 0.002; } push @$to, $$from[-1] + 2.0 if @$from; $sub->{idx}->{comments} = \@comments; 1; } sub write { my ( $self, $sub) = @_; die "The idx format subtitles cannot be created from the other formats\n" unless $sub->{idx}->{comments}; my $from = $sub->{from}; my $to = $sub->{to}; my $text = $sub->{text}; my $c = $sub->{idx}->{comments}; my ( $i, $j); my $n = @$text; my @ret; for ( $i = $j = 0; $i < $n; $i++) { push @ret, $$c[$j++][1] while $j < @$c and $$c[$j][0] <= $i; push @ret, sprintf( "timestamp: %02d:%02d:%02d:%03d, filepos: %s", Subtitles::time2hms($from->[$i]), $text->[$i]); } \@ret; } 1; =pod =head1 NAME Subtitles - handle video subtitles in various text formats =head1 DESCRIPTION Video files (avi mpeg etc) are sometimes accompanied with subtitles, which are currently very popular as text files. C provides means for simple loading, re-timing, and storing these subtitle files. A command-line tool F for the same purpose and using C interface is included in the distribution. The module supports C, C, C, and C subtitle formats. Time values are floats, in seconds with millisecond precision. =head1 SYNOPSIS use Subtitles; my $sub = Subtitles->new(); open F, 'Ichi The Killer.sub' or die "Cannot read:$!"; die "Cannot load:$@\n" unless $sub-> load(\*F); close F; # back two minutes $sub-> shift( $sub-> parse_time('-02:00')); # re-frame from 25 fps $sub-> scale( 23.976 / 25 ); # or both $sub-> transform( -120, 0.96); $sub-> transform( -120, 0.96, 0, $sub-> length - 60); # split in 2 my ( $part1, $part2) = $sub-> split( $self-> length / 2); # join back with 5-second gap $part1-> join( $part2, 5); # save open F, "> out.sub" or die "Cannot write:$!\n"; $part1-> save( \*F); close F; # report print "sub is ", time2str( $sub-> length); =head1 API =head2 Package methods =over =item codecs Returns array of installed codecs. =item hms2time HOURS, MINUTES, SECONDS, MILLISECONDS Combines four parameters into float time in seconds. =item time2hms TIME Splits time into four integers, - hours, minutes, seconds, and milliseconds. If time is less than zero, zero times are returned. =item time2shms Splits time into five integers, - time sign, hours, minutes, seconds, and milliseconds. =item time2str TIME Converts time to a human-readable string. =back =head2 Object methods =over =item clear Removes all content =item codec [ STRING ] If STRING is not defined, returns currently associated codec. Otherwise, sets the new codec in association. The STRING is the codec's package name, such as C. =item dup [ CLEAR ] Duplicates object instance in deep-copy fashion. If CLEAR flag is set, timeframes are not copied. =item join GUEST, GAP Adds content of object GUEST at the end of the list of subtitles with GAP in seconds. =item length Returns length of subtitle span. =item load FH [ CODEC ] Reads subtitle content into object. If successful, returns 1; otherwise undef is returned and C<$@> contains the error. By default, tries to deduce which codec to use; to point the selection explicitly CODEC string is to be used. =item lines Returns number of subtitle cues. =item new Creates a new instance. To force a particular codec, supply C string here. =item parse_time STRING Parses STRING which is either a C<[[HH:]MM:]SS[,MSEC]> string or string in a format specific to a codec, for example, number of a frame. =item rate FPS Forces a particluar frame-per-second rate, if a codec can make use of it. =item save FH Writes content of instance into FH file handle, using the associated codec. =item scale A Changes time-scale. If A is 2, the subtitles go off 2 times slower, if 0.5 - two times faster, etc. =item shift B Shifts timings by B seconds. B can be negative. =item split TIME Splits the content of the instance between two newly created instances of the same class, by TIME, and returns these. The both resulting subtitles begin at time 0. =item transform A, B [FROM, TO] Applies linear transformation to the time-scale, such as C where C is the original time and C is the result. If FROM and TO brackets are set, the changes are applied only to the lines in the timeframe between these. =back =head1 BUGS This is alpha code, more a proof-of-concept rather that anything else, so most surely bugs are lurking. Anyway: not all subtitle types are recognized. The modules doesn't handle multi-language subtitles. =head1 SEE ALSO L - command-line wrapper for this module =head1 THANKS L, L. =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =cut Subtitles-1.04/README0000644000175000017500000000315411314133075012053 0ustar dkdkSubtitles ========= Video files (avi, mpeg etc) are sometimes accompanied with subtitles, which are currently very popular as text files. The command line tool 'subs' and its perl backend Subtitles.pm provide means for simple loading, re-timing, converting, and storing these subtitle files. The supported formats are .srt, .sub, .smi, and .idx. An example of a GUI subtitle player is included. USAGE ===== Warning: -i is a great feature, but use it with certain caution. If subtitles are shown too early ( 5 seconds): subs -i -b 5 file.sub If subtitles are for a movie in 25 fps, need to be for 24 ( actual for frame-based formats only ). subs -i -a 24/25 file.sub If subtitles start 1 second too early, but in 1 hour are late in 7 seconds: subs -i -p 0 -1 -p 1:00:00 +7 file.sub Join two parts with 15-second gap subs -o joined.sub -j 15 part1.sub part2.sub Split in two after 50 minutes and half a second ( makes basename.1.sub and basename.2.sub ). subs -o basename.sub -s 50:00.5 toobig.sub Remove closed caption-specific comments such as '[Sneezing]' or '[Music playing]' subs -e 's/[\s-]*\[.*\]\s*\n*//gs' sub.sub Separate overlapped lines subs -O subs.sub Zip two subtitles together -- read time information from one, text from another subs -z time.sub text.sub INSTALLATION ============ To install this module type the following: perl Makefile.PL make make test make install COPYRIGHT AND LICENCE ===================== Copyright (C) 2004 Dmitry Karasik This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.