#! /usr/bin/perl use strict; use FileHandle; &main(); exit 0; sub main { my @array = (); while () { chomp; push(@array, $_); } my $last_title = ''; my $len = 0; my $fh = undef; my $s = ''; my $count = 1; my @file_list = (); my %anchor_list = (); my %anchor_order = (); my $anchor_count = 1; my $file = ''; foreach my $data (sort byrecord @array) { my ($title, $num, $subtitle, $date, $tape, $comment) = split /,/, $data; $title = "$title [$comment]" if $comment eq '再'; if ($title ne $last_title) { if ($last_title ne '') { $s = "\n"; $fh->print($s); $len += length $s; if ($len > 20*1024) { &print_footer($fh); $fh->close; $fh = undef; } } unless ($fh) { $file = sprintf "list-%d.html", $count; $fh = new FileHandle "> $file"; $len = &print_header($fh, $count); $count++; push @file_list, $file; } my $atitle = &title_decode($title); $atitle =~ s/
/ /gi; $atitle =~ s/\s+/ /g; $anchor_list{$atitle} = sprintf "%s#%d", $file, $anchor_count; $anchor_order{$atitle} = $anchor_count; $s = sprintf("

%s

\n", $anchor_count, &title_decode($title)); $anchor_count++; $fh->print($s); $len += length $s; $s = "\n"; $fh->print($s); $len += length $s; } $subtitle = &subtitle_decode($subtitle); $s = "\n"; $fh->print($s); $len += length $s; $last_title = $title; } $fh->close; $fh = new FileHandle ">list.html"; &print_html_header($fh, "Tape List"); $fh->print(< PROLOG foreach my $title (sort {$anchor_order{$a} <=> $anchor_order{$b}} keys %anchor_list) { $fh->printf("

\n", $anchor_list{$title}, $title); } $fh->print(<

戻る

CLOSING $fh->close; } sub subtitle_decode { my $s = shift; $s =~ s/
/ /gi; $s =~ s/

/ /gi; $s =~ s/]*>//gi; $s =~ s/<\/SPAN>//gi; $s = &decode_ruby($s) if $s =~ //i; $s =~ s/\//
/gi; $s =~ s/&comm;/,/g; $s =~ s/&heart;/♡/g; $s; } sub title_decode { my $s = shift; $s = &decode_ruby($s) if $s =~ //i; $s =~ s/

/
/g; $s =~ s/&comm;/,/g; $s =~ s/&heart;/♡/g; $s; } sub decode_ruby { my $s = shift; $s =~ m,^(.*)(.*)(.*)$,i; my ($s1, $s2, $s3) = ($1, $2, $3); my ($rt, $rb); if ($s2 =~ m,^(.*)(.*)$,i) { ($rt, $rb) = ($1, $2); } elsif ($s2 =~ m,^(.*)(.*)$,i) { ($rb, $rt) = ($1, $2); } else { die "Error: Invalid substitle: $s\n"; } return "$s1$rb($rt)$s3"; } sub byrecord { my @x = split(/,/, $a, 6); my @y = split(/,/, $b, 6); return ("$x[0]$x[5]" cmp "$y[0]$y[5]") if ("$x[0]$x[5]" ne "$y[0]$y[5]"); return ($x[1] <=> $y[1]) if ($x[1] != $y[1]); return ($x[3] cmp $y[3]) if ($x[3] ne $y[3]); return ($x[2] cmp $y[2]) if ($x[2] ne $y[2]); return 0; } sub print_header { my $fh = shift; my $count = shift; my $l = &print_html_header($fh, "Tape List -- #$count"); my $s = <

$num	$subtitle	$date	$tape
話	サブタイトル	録画日(放映日)	8mm/VHS - テープ番号 - 位置

HTMLHEAD $fh->print($s); return ($l + length $s); } sub print_html_header { my ($fh, $title) = @_; my $s = < $title

$title

HEAD $fh->print($s); return length $s; } sub print_footer { my $fh = shift; my $s = <

戻る

HTMLFOOT $fh->print($s); return length $s; } # end of sort-prout.pl