#!/usr/bin/perl # # Copyright (c) 2001,2002 Florent Villard (warly@laposte.net) # Published under the GPL license. # use strict; use vars qw($file $dir $version $WIDTH $LEFT $TOP $P2LEFT $HEADTOP $idx_page $idx_jour); $ARGV[0] or usage(); $file = $ARGV[0]; $dir = $ARGV[1] || './'; $version = '0.0.1'; my $hit = qq{ }; open my $A, "$file" or die "FATAL, could not open $file\n"; open my $INDEX, ">$dir/index.html"; while (<$A>){ /\/style/ and last } ($WIDTH,$LEFT,$TOP,$P2LEFT,$HEADTOP) = (350,20,30,410,10); my $header = qq{ Le Patriarche

}; my $header_page = qq{ Le Patriarche }; my $header_part = qq{ Le Patriarche }; print $INDEX $header; while (<$A>){ /div id="d2"/ and last; s,Le Patriarche,Le Patriarche,; print $INDEX $_ } open my $PAGE, ">$dir/vie-1.html"; print_head($PAGE, 1, $header_page); #print $PAGE qq{$header_page #

1

# #

2

#

Le Patriarche

#
#}; $idx_page = qq{

Index

Pages

\n1 2\n}; $idx_jour = qq{

Jours

\n}; while (<$A>){ /

/ and last; /-- Ancien texte --/ and $_ = 0 and last; print $PAGE $_ } close $PAGE; my $page = 3; if ($_) { print_part(3, $_, m,

, ? '' : get_subtitle($A)); $page += 2 } open my $PAGE, ">$dir/vie-$page.html"; $idx_page .= qq{$page } . ($page+1) . " \n"; my ($line,$new_page); print_head($PAGE, $page,$header_page); $line = 10; print $PAGE "
"x10; while (<$A>) { if ($line > 50 && !$new_page){ print $PAGE "

"; $new_page = 1 } if ($line > 100){ print $PAGE "

$hit\n"; new_page() } if (/

(.+)<\/p>/){ $idx_jour .= qq{ $1} } if (/

Table des matières/){ <$A> } elsif (/

.*<\/a>(.*)/){ $page += 2; print_part($page, $2, get_subtitle($A)); new_page(); $line = 10; print $PAGE "
"x10 } else { $line += 1.3 if /<\/p>/; $line += length() / 53; print $PAGE $_ } } close $PAGE; print $INDEX "$idx_page

$idx_jour

$hit\n"; exit; sub new_page { $page += 2; open $PAGE, ">$dir/vie-$page.html"; print_head($PAGE, $page, $header_page); $idx_page .= qq{$page } . ($page + 1) . "\n"; $line = 0; $new_page = 0 } # replaced because some links where not usable with mozilla sub print_head_old { my ($page, $header) = @_; print $page qq{$header}; print $page qq{

page } . ($page-1) . qq{

} if $page > 1; print $page qq{

} . ($page) . qq{

le patriarche

page } . ($page+2) . qq{

} . ($page+1) . qq{

le patriarche

}; } sub print_head { my ($PAGE, $page, $header) = @_; print $PAGE qq{$header\n}; print $PAGE qq{

}; if ($page > 1) { print $PAGE qq{ \n} } else { print $PAGE qq{ \n} } print $PAGE qq{
page } . ($page-1) . qq{ le patriarche } . ($page) . qq{

} . ($page+1) . qq{ le patriarche page } . ($page+2) . qq{

}; } sub print_part { my ($page, $title, $subtitle) = @_; open $PAGE, ">$dir/vie-$page.html"; $title =~ s,,,; $title =~ s/<.?br>//g; $title =~ s/<.?p[^>]*>//g; print_head($PAGE, $page, $header_part); print $PAGE "

$title
$subtitle

$hit"; $idx_page .= qq{



$title } . (($subtitle !~ /^\s*$/) ? "($subtitle) " : "") . qq{ : $page } . ($page+1) . qq{\n}; close $PAGE } sub get_subtitle { my ($A) = @_; my $sub; while (my $t = <$A>) { $sub .= $t; $t =~ m,

, and last } $sub =~ s,

,,g; $sub } sub usage { print " viediff version $version usage: viediff [] \n"; exit }