You are viewing a plain text version of this content. The canonical link for it is here.
Posted to docs-cvs@perl.apache.org by st...@apache.org on 2002/01/24 19:11:24 UTC
cvs commit: modperl-docs/lib/DocSet/Source HTML.pm POD.pm
stas 02/01/24 10:11:24
Modified: lib DocSet.pm
lib/DocSet 5005compat.pm Cache.pm Config.pm Doc.pm DocSet.pm
Util.pm
lib/DocSet/Doc POD2HTML.pm
lib/DocSet/DocSet HTML.pm PSPDF.pm
lib/DocSet/Source HTML.pm POD.pm
Added: lib/DocSet/Doc POD2HTMLPS.pm
Log:
+ sync with DocSet 0.09:
- use the first para of a pod DESCRIPTION section on the index page,
as a document abstract.
- fix =head sections pod markup rendering
- split the pod by =head[1-4] sections when handing over to the
template, now the [TOC] appears at the end of each =head[1-4]
sections in the rendered HTML.
- rewrite the overloaded view_head method, to embed the name anchor
properly.
- changed the timestamp to be the output of 'scalar localtime'
- now individual documents are rendered as PDF as well (before only
docsets were rendered as PDF in pdf mode).
- split the copy_as_is functionality into scan and copy, so scan can
detect whether any of the items were modified and mark the docset as
dirty (modified).
- perfect the modification control, now only if at least one of the
items in the docset (chapters, files, docsets, config file) was
modified the docset will be rebuilt, otherwise it'll be skipped,
making the partial rebuild/updates much faster.
- the html pages now link to the pdf and source version of the
document (by prior copying and gzipping these into the same dir).
- Added a 'stitle' attribute in addition to the 'title' attribute. The
former is for use in the menu and nav bars, stands for 'short
title'.
Revision Changes Path
1.2 +1 -1 modperl-docs/lib/DocSet.pm
Index: DocSet.pm
===================================================================
RCS file: /home/cvs/modperl-docs/lib/DocSet.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- DocSet.pm 5 Jan 2002 18:51:58 -0000 1.1
+++ DocSet.pm 24 Jan 2002 18:11:24 -0000 1.2
@@ -1,6 +1,6 @@
package DocSet;
-$VERSION = '0.08';
+$VERSION = '0.10';
=head1 NAME
1.2 +27 -1 modperl-docs/lib/DocSet/5005compat.pm
Index: 5005compat.pm
===================================================================
RCS file: /home/cvs/modperl-docs/lib/DocSet/5005compat.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- 5005compat.pm 5 Jan 2002 18:51:58 -0000 1.1
+++ 5005compat.pm 24 Jan 2002 18:11:24 -0000 1.2
@@ -4,7 +4,6 @@
use Symbol ();
use File::Basename;
use File::Path;
-use Symbol ();
my %compat_files = (
'lib/warnings.pm' => \&warnings_pm,
@@ -67,3 +66,30 @@
}
1;
+
+=head1 NAME
+
+DocSet::5005compat - perl 5.005_03 compatibility module
+
+=head1 SYNOPSIS
+
+ # must be loaded as early as possible
+ use DocSet::5005compat;
+
+=head1 DESCRIPTION
+
+This module encapsulates the functionalities/modules unavailable under
+5.005_03.
+
+Currently it only creates the warnings pragma's shell, so the code like:
+
+ use warnings;
+
+won't fail under 5.005_03.
+
+=head1 ORIGIN
+
+Borrowed from Apache::Test project.
+
+=cut
+
1.2 +6 -4 modperl-docs/lib/DocSet/Cache.pm
Index: Cache.pm
===================================================================
RCS file: /home/cvs/modperl-docs/lib/DocSet/Cache.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- Cache.pm 5 Jan 2002 18:51:58 -0000 1.1
+++ Cache.pm 24 Jan 2002 18:11:24 -0000 1.2
@@ -171,10 +171,12 @@
if (@_) {
# set
- my($id, $title, $abstract) = @_;
- croak "must specify the index_node's id" unless defined $id;
- croak "must specify the index_node's title" unless defined $title;
+ my($id, $stitle, $title, $abstract) = @_;
+ croak "must specify the index_node's id" unless defined $id;
+ croak "must specify the index_node's stitle" unless defined $stitle;
+ croak "must specify the index_node's title" unless defined $title;
$self->{cache}{_index}{id} = $id;
+ $self->{cache}{_index}{stitle} = $stitle;
$self->{cache}{_index}{title} = $title;
$self->{cache}{_index}{abstract} = $abstract;
}
@@ -259,7 +261,7 @@
my @ids = $cache->ordered_ids;
my $total_ids = $cache->total_ids;
- $cache->index_node($id, $title, $abstract);
+ $cache->index_node($id, $stitle, $title, $abstract);
my %index_node = $cache->index_node();
$cache->parent_node($cache_path, $id, $rel_path);
1.2 +76 -14 modperl-docs/lib/DocSet/Config.pm
Index: Config.pm
===================================================================
RCS file: /home/cvs/modperl-docs/lib/DocSet/Config.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- Config.pm 5 Jan 2002 18:51:58 -0000 1.1
+++ Config.pm 24 Jan 2002 18:11:24 -0000 1.2
@@ -20,18 +20,20 @@
map({$_ => 'text/pod' } qw(pod pm)),
);
-my %conv_class= (
+my %conv_class = (
'text/pod' => {
- 'text/html' => 'DocSet::Doc::POD2HTML',
- 'text/ps' => 'DocSet::Doc::POD2PS',
+ 'text/html' => 'DocSet::Doc::POD2HTML',
+ 'text/htmlps' => 'DocSet::Doc::POD2HTMLPS',
+ 'text/ps' => 'DocSet::Doc::POD2PS',
},
'text/html' => {
- 'text/html' => 'DocSet::Doc::HTML2HTML',
- 'text/ps' => 'DocSet::Doc::HTML2PS',
+ 'text/html' => 'DocSet::Doc::HTML2HTML',
+ 'text/htmlps' => 'DocSet::Doc::HTML2HTML',
+ 'text/ps' => 'DocSet::Doc::HTML2PS',
},
'text/plain' => {
- 'text/html' => 'DocSet::Doc::Text2HTML',
- 'text/pdf' => 'DocSet::Doc::Text2PDF',
+ 'text/html' => 'DocSet::Doc::Text2HTML',
+ 'text/pdf' => 'DocSet::Doc::Text2PDF',
},
);
@@ -72,6 +74,9 @@
no strict 'refs';
use vars qw(@c);
*c = \@{"$package\::c"};
+
+#dumper \@c;
+
my @groups = ();
my $current_group = '';
my $group_size;
@@ -102,14 +107,21 @@
}
else {
$self->{$key} = $val;
- #print "$key = $val\n";
+ #dumper [$key => $val];
}
}
if ($current_group) {
push @{ $self->{node_groups} }, $current_group, $group_size;
}
- # merge_config will adjust this value, for nested docsets
+ # - make sure that at least title or stitle were specified
+ # - alias one to another if only one was specified
+ $self->{title} ||= $self->{stitle};
+ $self->{stitle} ||= $self->{title};
+ die "Either 'title' or 'stitle' must appear in $config_file"
+ unless $self->{title};
+
+ # merge_config will adjust this value, for nested docsets
# so this value is relevant only for the real top parent node
$self->{dir}{abs_doc_root} = '.';
@@ -119,6 +131,32 @@
}
+# this sub controls the docset's 'modified' attribute which specifies
+# whether the docset is in a "dirty" state and need to be rebuilt or
+# not.
+#
+# get/set modified status
+# ... if $self->modified();
+# $self->modified(1);
+sub modified {
+ my $self = shift;
+ if (@_) {
+ my $status = shift;
+
+ # protect from modified status reset (once it's set to any
+ #value it cannot be reset to 0), must be a mistake. If we
+ # don't check this, it's possible that in one place the object
+ # is marked as dirty, but somewhere later a logic mistake
+ # resets this value to 0, (non-dirty).
+ if (exists $self->{modified} && !$status) {
+ Carp::croak("Cannot reset the 'modified' status");
+ }
+ $self->{modified} = $status;
+ }
+ return $self->{modified};
+
+}
+
#
# 1. put chapters together, docsets together, links together
# 2. store the normal nodes in the order they were listed in 'ordered_nodes'
@@ -140,18 +178,20 @@
return scalar @values;
}
-# child config inherits from the parent config
+# child config inherits parts from the parent config
# and adjusts its paths
sub merge_config {
my($self, $src_rel_dir) = @_;
my $parent_o = $self->{parent_o};
+ # inherit 'file' attributes if not set in the child
my $files = $self->{file} || {};
while ( my($k, $v) = each %{ $parent_o->{file}||{} }) {
$self->{file}{$k} = $v unless $files->{$k};
}
+ # inherit 'dir' attributes if not set in the child
my $dirs = $self->{dir} || {};
while ( my($k, $v) = each %{ $parent_o->{dir}||{} }) {
$self->{dir}{$k} = $v unless $dirs->{$k};
@@ -177,7 +217,7 @@
}
-# return a list of files to be copied
+# return a list of files potentially to be copied
#
# due to a potentially huge list of files to be copied (e.g. the
# splash library) currently it's assumed that this function is called
@@ -188,8 +228,8 @@
# (directories aren't descended into)
# 2. Shell metachars (*?[]) can be used. e.g. if you want to grab
# directory foo and its contents, make sure to specify foo/*.
-sub files_to_copy {
- my($self) = @_;
+sub files_to_scan_copy {
+ my $self = shift;
my $copy_skip_patterns = $self->{copy_skip} || [];
# build one sub that will match many regex at once.
@@ -211,6 +251,21 @@
return \@files;
}
+# this functions sets/gets a ref to hash of files that need to be
+# copied as is, all the checking were done already. (only the modified
+# files will go here)
+sub files_to_copy {
+ my $self = shift;
+
+ if (@_) {
+ $self->{files_to_copy} = shift;
+ }
+ else {
+ return $self->{files_to_copy} || {};
+ }
+
+}
+
sub expand_dir {
my @files = ();
if ($] >= 5.006) {
@@ -513,9 +568,16 @@
a unique id of the docset. The uniquness should be preserved across
any parallel docsets.
+=item * stitle
+
+the short title of the docset, used in the menu and the navigation
+breadcrumb. If it's not specified the I<title> attribute is used
+instead.
+
=item * title
-the title of the docset
+the title of the docset. If it's not specified the I<stitle> attribute
+is used instead.
=item * abstract
1.2 +7 -3 modperl-docs/lib/DocSet/Doc.pm
Index: Doc.pm
===================================================================
RCS file: /home/cvs/modperl-docs/lib/DocSet/Doc.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- Doc.pm 5 Jan 2002 18:51:58 -0000 1.1
+++ Doc.pm 24 Jan 2002 18:11:24 -0000 1.2
@@ -22,7 +22,7 @@
sub scan {
my($self) = @_;
- note "Scanning $self->{src_uri}";
+ note "+++ Scanning $self->{src_uri}";
$self->src_read();
$self->retrieve_meta_data();
@@ -51,6 +51,9 @@
note "Rendering $dst_path";
$self->convert();
write_file($dst_path, $self->{output});
+
+ # anything that should be done after the target was written?
+ $self->postprocess() if $self->can('postprocess');
}
# read the source and remember the mod time
@@ -73,8 +76,9 @@
$self->{content} = \$content;
# file change timestamp
- my($mon, $day, $year) = (localtime ( (stat($path))[9] ) )[4,3,5];
- $self->{timestamp} = sprintf "%02d/%02d/%04d", ++$mon,$day,1900+$year;
+ # my($mon, $day, $year) = (localtime ( (stat($path))[9] ) )[4,3,5];
+ # $self->{timestamp} = sprintf "%02d/%02d/%04d", ++$mon,$day,1900+$year;
+ $self->{timestamp} = scalar localtime;
}
else {
1.2 +100 -22 modperl-docs/lib/DocSet/DocSet.pm
Index: DocSet.pm
===================================================================
RCS file: /home/cvs/modperl-docs/lib/DocSet/DocSet.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- DocSet.pm 5 Jan 2002 18:51:58 -0000 1.1
+++ DocSet.pm 24 Jan 2002 18:11:24 -0000 1.2
@@ -33,6 +33,20 @@
$self->merge_config($src_rel_dir);
}
+ # we assume that the docset was not modified since the last run.
+ # if at least one source doc was modified, the docset is considered
+ # modified as well and should be rebuild. It's the responsibility
+ # of the modified object to make its parent docset as modified.
+ $self->modified(0);
+
+ # currently there are 4 reasons why the docset is considered
+ # 'modified', if at least one of these is 'modified':
+ # 1. the included docset
+ # 2. the included chapter
+ # 3. the included 'copy as-is' files
+ # 4. config.cfg is newer than corresponding index.html
+ #
+
}
sub scan {
@@ -51,6 +65,7 @@
# cache the index node meta data
$cache->index_node($self->get('id'),
+ $self->get('stitle'),
$self->get('title'),
$self->get('abstract')
);
@@ -77,14 +92,17 @@
my($type, $data) = splice @nodes_by_type, 0, 2;
if ($type eq 'docsets') {
my $docset = $self->docset_scan_n_cache($data, $hidden);
+ $self->modified(1) if $docset->modified();
$self->object_store($docset)
if defined $docset and ref $docset;
} elsif ($type eq 'chapters') {
my $chapter = $self->chapter_scan_n_cache($data, $hidden);
- $self->object_store($chapter)
- if defined $chapter and ref $chapter;
-
+ if (defined $chapter and ref $chapter) {
+ # modified chapter --> modified docset
+ $self->modified(1);
+ $self->object_store($chapter)
+ }
} elsif ($type eq 'links') {
$self->link_scan_n_cache($data, $hidden);
# we don't need to process links
@@ -120,6 +138,17 @@
# sync the cache
$cache->write;
+ # copy non-pod files like images and stylesheets
+ #
+ # META: though this belongs to the 'render' part, we run it here,
+ # since we need to know after the scan() whether the docset is
+ # modified. a cleaner, logic-wise, solution would be only to check
+ # modification times on files that may need to be copied as-is,
+ # but to postpone the copying, if any, only to the render part of
+ # the logic. We could also remove here all the files that don't
+ # need to be copied, since they didn't change.
+ $self->scan_copy_the_rest;
+
}
@@ -134,12 +163,22 @@
# cache the children meta data
my $id = $docset->get('id');
my $meta = {
+ stitle => $docset->get('stitle'),
title => $docset->get('title'),
link => "$src_rel_dir/index.html",
abstract => $docset->get('abstract'),
};
$self->cache->set($id, 'meta', $meta, $hidden);
+ # compare whether the config file is newer than the index.html
+ my $dst_root = $self->get_dir('dst_root');
+ my $dst_index = "$dst_root/$src_rel_dir/index.html";
+ my($should_update, $reason) =
+ should_update($cfg_file, $dst_index);
+ $docset->modified(1) if $should_update;
+
+ note "\n"; # mark the end of scan
+
return $docset;
}
@@ -194,8 +233,11 @@
require_package($conv_class);
my $chapter = $conv_class->new(
+ docset => $self,
tmpl_mode => $self->get('tmpl_mode'),
tmpl_root => $self->get_dir('tmpl'),
+ src_root => $src_root,
+ dst_root => $dst_root,
src_uri => $src_file,
src_path => $src_path,
dst_path => $dst_path,
@@ -214,10 +256,47 @@
}
+####################
+sub scan_copy_the_rest {
+ my($self) = @_;
+
+ my @scan_copy_files = @{ $self->files_to_scan_copy() };
+
+ return unless @scan_copy_files;
+
+ my %to_copy = ();
+
+ my $src_root = $self->get_dir('src_root');
+ my $dst_root = $self->get_dir('dst_root');
+ note "+++ Scanning the copy as-is files. Comparing $src_root with $dst_root";
+ foreach my $src_path (@scan_copy_files){
+ my $dst_path = $src_path;
+# # some OSs's File::Find returns files with no dir prefix root
+# # (that's what ()* is for
+# $dst_path =~ s/(?:$src_root)*/$dst_root/;
+ $dst_path =~ s/$src_root/$dst_root/;
+
+ # to rebuild or not to rebuild
+ my($should_update, $reason) =
+ should_update($src_path, $dst_path);
+ if (!$should_update) {
+ note "--- skipping cp $src_path $dst_path ($reason)";
+ next;
+ }
+ $self->modified(1); # dirty state
+ note "+++ processing $src_path => $dst_path ($reason)";
+ $to_copy{$src_path} = $dst_path;
+ }
+
+ $self->files_to_copy(\%to_copy);
+}
+
sub render {
my($self) = @_;
- # copy non-pod files like images and stylesheets
+ # if the docset wasn't modified, don't render the docset
+ return unless $self->modified();
+
$self->copy_the_rest;
my $src_root = $self->get_dir('src_root');
@@ -240,28 +319,15 @@
sub copy_the_rest {
my($self) = @_;
- my @copy_files = @{ $self->files_to_copy || [] };
+ my %copy_files = %{ $self->files_to_copy };
- return unless @copy_files;
+ return unless %copy_files;
my $src_root = $self->get_dir('src_root');
my $dst_root = $self->get_dir('dst_root');
note "+++ Copying the non-processed files from $src_root to $dst_root";
- foreach my $src_path (@copy_files){
- my $dst_path = $src_path;
-# # some OSs's File::Find returns files with no dir prefix root
-# # (that's what ()* is for
-# $dst_path =~ s/(?:$src_root)*/$dst_root/;
- $dst_path =~ s/$src_root/$dst_root/;
-
- # to rebuild or not to rebuild
- my($should_update, $reason) =
- should_update($src_path, $dst_path);
- if (!$should_update) {
- note "--- skipping cp $src_path $dst_path ($reason)";
- next;
- }
- note "+++ processing cp $src_path $dst_path ($reason)";
+ while (my ($src_path, $dst_path) = each %copy_files) {
+ note "+++ cp $src_path $dst_path";
copy_file($src_path, $dst_path);
}
}
@@ -329,6 +395,17 @@
Scans the docset for meta data and tocs of its items and caches this
information and the item objects.
+=item * scan_copy_the_rest
+
+ $self->scan_copy_the_rest()
+
+Process the files that should be copied as is without processing
+(i.e. images, css files, etc). If any of the items have a timestamp
+newer than the corresponding copy in the target destination, the whole
+docset will be rebuilt.
+
+Only files that were modified will be copied during the render phase.
+
=item * render
$self->render();
@@ -340,7 +417,8 @@
$self->copy_the_rest()
-Copies the items which aren't processed (i.e. images, css files, etc).
+Copies the files which aren't processed (i.e. images, css files, etc.)
+and were modified as-is.
=back
1.2 +49 -6 modperl-docs/lib/DocSet/Util.pm
Index: Util.pm
===================================================================
RCS file: /home/cvs/modperl-docs/lib/DocSet/Util.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- Util.pm 5 Jan 2002 18:51:58 -0000 1.1
+++ Util.pm 24 Jan 2002 18:11:24 -0000 1.2
@@ -15,10 +15,11 @@
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
-@EXPORT = qw(read_file read_file_paras copy_file write_file create_dir
- filename_ext require_package dumper sub_trace note
- get_date get_timestamp proc_tmpl build_matchmany_sub
- banner should_update confess cluck);
+@EXPORT = qw(read_file read_file_paras copy_file gzip_file write_file
+ create_dir filename filename_ext require_package dumper
+ sub_trace note get_date get_timestamp proc_tmpl
+ build_matchmany_sub banner should_update confess cluck
+ format_bytes);
# copy_file($src_path, $dst_path);
# copy a file at $src_path to $dst_path,
@@ -35,6 +36,14 @@
File::Copy::copy($src, $dst);
}
+# gzip_file($src_path);
+# gzip a file at $src_path
+###############
+sub gzip_file {
+ my($src) = @_;
+ system "gzip -f $src";
+}
+
# write_file($filename, $ref_to_array||scalar);
# content will be written to the file from the passed array of
@@ -92,6 +101,12 @@
}
+# return the filename part of the path
+sub filename {
+ my($path) = @_;
+ return File::Basename::basename($path);
+}
+
# return the passed file's extension or '' if there is no one
# note: that '/foo/bar.conf.in' returns an extension: 'conf.in';
# note: a hidden file .foo will be recognized as an extension 'foo'
@@ -111,17 +126,18 @@
sprintf "%02d/%02d/%04d", ++$mon, $day, 1900+$year;
}
+my %require_seen = ();
# convert Foo::Bar into Foo/Bar.pm and require
sub require_package {
my $package = shift;
die "no package passed" unless $package;
+ return if $require_seen{$package};
+ $require_seen{$package} = 1;
$package =~ s|::|/|g;
$package .= '.pm';
require $package;
}
-
-
# convert the template into the release version
# $tmpl_root: a ref to an array of tmpl base dirs
# tmpl_file: which template file to process
@@ -205,6 +221,33 @@
die "Failed in building regex [@$ra_regex]: $@" if $@;
$matchsub;
}
+
+use constant KBYTE => 1024;
+use constant MBYTE => 1048576;
+use constant GBYTE => 1073741824;
+
+# compacts numbers like 1200234 => 1.2M, so they always fit into 4 chars.
+#################
+sub format_bytes {
+ my $bytes = shift || 0;
+
+ if ($bytes < KBYTE) {
+ return sprintf "%5dB", $bytes;
+ }
+ elsif (KBYTE < $bytes and $bytes < MBYTE) {
+ return sprintf "%4.@{[int($bytes/KBYTE) < 10 ? 1 : 0]}fKiB", $bytes/KBYTE;
+ }
+ elsif (MBYTE < $bytes and $bytes < GBYTE) {
+ return sprintf "%4.@{[int($bytes/MBYTE) < 10 ? 1 : 0]}fMiB", $bytes/MBYTE;
+ }
+ elsif (GBYTE < $bytes) {
+ return sprintf "%4.@{[int($bytes/GBYTE) < 10 ? 1 : 0]}fGiB", $bytes/GBYTE;
+ }
+ else {
+ # shouldn't happen
+ }
+}
+
sub dumper {
print Dumper @_;
1.2 +170 -31 modperl-docs/lib/DocSet/Doc/POD2HTML.pm
Index: POD2HTML.pm
===================================================================
RCS file: /home/cvs/modperl-docs/lib/DocSet/Doc/POD2HTML.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- POD2HTML.pm 5 Jan 2002 18:51:59 -0000 1.1
+++ POD2HTML.pm 24 Jan 2002 18:11:24 -0000 1.2
@@ -3,6 +3,8 @@
use strict;
use warnings;
+use File::Spec::Functions;
+
use DocSet::Util;
require Pod::POM;
#require Pod::POM::View::HTML;
@@ -13,38 +15,28 @@
require DocSet::Source::POD;
@ISA = qw(DocSet::Source::POD);
+my %split_by = map {"head".$_ => 1} 1..4;
+
sub convert {
my($self) = @_;
my $pom = $self->{parsed_tree};
-
-# my @sections = $pom->head1();
-# shift @sections; # skip the title
my @sections = $pom->content();
shift @sections; # skip the title
- my @body = ();
- foreach my $node (@sections) {
-# my $type = $node->type();
-# print "$type\n";
- push @body, $node->present($view_mode);
- }
-
-# for my $head1 (@sections) {
-# push @body, $head1->title->present($view_mode);
-# push @body, $head1->content->present($view_mode);
-# for my $head2 ($head1->head2) {
-# push @body, $head2->present($view_mode);
-# for my $head3 ($head2->head3) {
-# push @body, $head3->present($view_mode);
-# for my $head4 ($head3->head4) {
-# push @body, $head4->present($view_mode);
-# }
-# }
-# }
+# my @body = ();
+# foreach my $node (@sections) {
+## my $type = $node->type();
+## print "$type\n";
+# push @body, $node->present($view_mode);
# }
+
+ #dumper $sections[$#sections];
+
+ my @body = slice_by_head(@sections);
+
my $vars = {
meta => $self->{meta},
toc => $self->{toc},
@@ -52,6 +44,8 @@
dir => $self->{dir},
nav => $self->{nav},
last_modified => $self->{timestamp},
+ pdf_doc => $self->pdf_doc,
+ src_doc => $self->src_doc,
};
my $tmpl_file = 'page';
@@ -61,6 +55,91 @@
}
+# search for a pdf version in the parallel tree and copy/gzip it to
+# the same dir as the html version (we link to it from the html)
+sub pdf_doc {
+ my $self = shift;
+
+ my $dst_path = $self->{dst_path};
+ $dst_path =~ s/html$/pdf/;
+
+ my $pdf_path = $dst_path;
+
+ my $docset = $self->{docset};
+ my $ps_root = $docset->get_dir('dst_ps');
+ my $html_root = $docset->get_dir('dst_html');
+
+ $pdf_path =~ s/^$html_root/$ps_root/;
+
+#print "TRYING $dst_path $pdf_path \n";
+
+ my %pdf = ();
+ if (-e $pdf_path) {
+ copy_file($pdf_path, $dst_path);
+ gzip_file($dst_path);
+ my $gzip_path = "$dst_path.gz";
+ %pdf = (
+ size => format_bytes(-s $gzip_path),
+ link => filename($gzip_path),
+ );
+ }
+#dumper \%pdf;
+
+ return \%pdf;
+
+}
+
+# search for the source version in the source tree and copy/gzip it to
+# the same dir as the html version (we link to it from the html)
+sub src_doc {
+ my $self = shift;
+ #$self->src_uri
+
+ my $dst_path = catfile $self->{dst_root}, $self->{src_uri};
+ my $src_path = catfile $self->{src_root}, $self->{src_uri};
+
+#print "TRYING $dst_path $src_path \n";
+
+ my %src = ();
+ if (-e $src_path) {
+ # it's ok if the source file has the same name as the dest,
+ # because the final dest file wasn't created yet.
+ copy_file($src_path, $dst_path);
+ gzip_file($dst_path);
+ my $gzip_path = "$dst_path.gz";
+ %src = (
+ size => format_bytes(-s $gzip_path),
+ link => filename($gzip_path),
+ );
+ }
+#dumper \%src;
+
+ return \%src;
+die;
+}
+
+
+sub slice_by_head {
+ my @sections = @_;
+ my @body = ();
+ for my $node (@sections) {
+ my @next = ();
+ # assumption, after the first 'headX' section, there can only
+ # be other 'headX' sections
+ my $count = scalar $node->content;
+ my $id = -1;
+ for ($node->content) {
+ $id++;
+ next unless exists $split_by{ $_->type };
+ @next = splice @{$node->content}, $id;
+ last;
+ }
+ push @body, $node->present($view_mode), slice_by_head(@next);
+ }
+ return @body;
+}
+
+
1;
@@ -71,31 +150,91 @@
@ISA = qw( Pod::POM::View::HTML);
sub view_head1 {
- my ($self, $node) = @_;
- return $self->anchor($node->title) . $self->SUPER::view_head1($node);
+ my ($self, $head1) = @_;
+ return "<h1>" . $self->anchor($head1->title) . "</h1>\n\n" .
+ $head1->content->present($self);
}
sub view_head2 {
- my ($self, $node) = @_;
- return $self->anchor($node->title) . $self->SUPER::view_head2($node);
+ my ($self, $head2) = @_;
+ return "<h2>" . $self->anchor($head2->title) . "</h2>\n\n" .
+ $head2->content->present($self);
}
sub view_head3 {
- my ($self, $node) = @_;
- return $self->anchor($node->title) . $self->SUPER::view_head3($node);
+ my ($self, $head3) = @_;
+ return "<h3>" . $self->anchor($head3->title) . "</h3>\n\n" .
+ $head3->content->present($self);
}
sub view_head4 {
- my ($self, $node) = @_;
- return $self->anchor($node->title) . $self->SUPER::view_head4($node);
+ my ($self, $head4) = @_;
+ return "<h4>" . $self->anchor($head4->title) . "</h4>\n\n" .
+ $head4->content->present($self);
}
sub anchor {
my($self, $title) = @_;
my $anchor = "$title";
$anchor =~ s/\W/_/g;
- return qq{<a name="$anchor"></a>\n};
+ my $link = $title->present($self);
+ return qq{<a name="$anchor">$link</a>};
}
+
+
+sub view_seq_link {
+ my ($self, $link) = @_;
+
+ # full-blown URL's are emitted as-is
+ if ($link =~ m{^\w+://}s ){
+ return make_href($link);
+ }
+
+ $link =~ s/\n/ /g; # undo word-wrapped tags
+
+ my $orig_link = $link;
+ my $linktext;
+ # strip the sub-title and the following '|' char
+ if ( $link =~ s/^ ([^|]+) \| //x ) {
+ $linktext = $1;
+ }
+
+ # make sure sections start with a /
+ $link =~ s|^"|/"|;
+
+ my $page;
+ my $section;
+ if ($link =~ m|^ (.*?) / "? (.*?) "? $|x) { # [name]/"section"
+ ($page, $section) = ($1, $2);
+ }
+ elsif ($link =~ /\s/) { # this must be a section with missing quotes
+ ($page, $section) = ('', $link);
+ }
+ else {
+ ($page, $section) = ($link, '');
+ }
+
+ # warning; show some text.
+ $linktext = $orig_link unless defined $linktext;
+
+ my $url = '';
+ if (defined $page && length $page) {
+ $url = $page;
+ $url =~ s|::|/|g;
+ }
+
+ # append the #section if exists
+ $url .= "#$section" if defined $section and length $section;
+
+ return make_href($url, $linktext);
+}
+
+sub make_href {
+ my($url, $title) = @_;
+ $title = $url unless defined $title;
+ return qq{<a href="$url">$title</a>};
+}
+
1;
1.1 modperl-docs/lib/DocSet/Doc/POD2HTMLPS.pm
Index: POD2HTMLPS.pm
===================================================================
package DocSet::Doc::POD2HTMLPS;
use strict;
use warnings;
use DocSet::Util;
require Pod::POM;
#require Pod::POM::View::HTML;
#my $view_mode = 'Pod::POM::View::HTML';
my $view_mode = 'DocSet::Doc::POD2HTML::View::HTMLPS';
use vars qw(@ISA);
require DocSet::Source::POD;
@ISA = qw(DocSet::Source::POD);
my %split_by = map {"head".$_ => 1} 1..4;
sub convert {
my($self) = @_;
my $pom = $self->{parsed_tree};
my @sections = $pom->content();
shift @sections; # skip the title
# foreach my $node (@sections) {
## my $type = $node->type();
## print "$type\n";
# push @body, $node->present($view_mode);
# }
my @body = slice_by_head(@sections);
my $vars = {
meta => $self->{meta},
toc => $self->{toc},
body => \@body,
dir => $self->{dir},
nav => $self->{nav},
last_modified => $self->{timestamp},
};
my $tmpl_file = 'page';
my $mode = $self->{tmpl_mode};
my $tmpl_root = $self->{tmpl_root};
$self->{output} = proc_tmpl($tmpl_root, $tmpl_file, $mode, {doc => $vars} );
}
sub postprocess {
my $self = shift;
# convert to ps
my $html2ps_exec = DocSet::RunTime::can_create_ps();
my $html2ps_conf = $self->{docset}->get_file('html2ps_conf');
my $dst_path = $self->{dst_path};
(my $dst_base = $dst_path) =~ s/\.html//;
my $dst_root = $self->{dst_root};
my $command = "$html2ps_exec -f $html2ps_conf -o ${dst_base}.ps ${dst_base}.html";
note "% $command";
system $command;
# convert to pdf
$command = "ps2pdf ${dst_base}.ps ${dst_base}.pdf";
note "% $command";
system $command;
# META: can delete the .ps now
}
sub slice_by_head {
my @sections = @_;
my @body = ();
for my $node (@sections) {
my @next = ();
# assumption, after the first 'headX' section, there can only
# be other 'headX' sections
my $count = scalar $node->content;
my $id = -1;
for ($node->content) {
$id++;
next unless exists $split_by{ $_->type };
@next = splice @{$node->content}, $id;
last;
}
push @body, $node->present($view_mode), slice_by_head(@next);
}
return @body;
}
1;
package DocSet::Doc::POD2HTML::View::HTMLPS;
use vars qw(@ISA);
require Pod::POM::View::HTML;
@ISA = qw( Pod::POM::View::HTML);
# we want the PDF to be layouted in a way that the chapter title comes
# as h1 and the real h1 sections as h2, h2 as h3, and so on.
sub view_head1 {
my ($self, $head1) = @_;
return "<h2>" . $self->anchor($head1->title) . "</h2>\n\n" .
$head1->content->present($self);
}
sub view_head2 {
my ($self, $head2) = @_;
return "<h3>" . $self->anchor($head2->title) . "</h3>\n\n" .
$head2->content->present($self);
}
sub view_head3 {
my ($self, $head3) = @_;
return "<h4>" . $self->anchor($head3->title) . "</h4>\n\n" .
$head3->content->present($self);
}
sub view_head4 {
my ($self, $head4) = @_;
return "<h5>" . $self->anchor($head4->title) . "</h5>\n\n" .
$head4->content->present($self);
}
sub anchor {
my($self, $title) = @_;
my $anchor = "$title";
$anchor =~ s/\W/_/g;
my $link = $title->present($self);
return qq{<a name="$anchor">$link</a>};
}
sub view_seq_link {
my ($self, $link) = @_;
# full-blown URL's are emitted as-is
if ($link =~ m{^\w+://}s ){
return make_href($link);
}
$link =~ s/\n/ /g; # undo word-wrapped tags
my $orig_link = $link;
my $linktext;
# strip the sub-title and the following '|' char
if ( $link =~ s/^ ([^|]+) \| //x ) {
$linktext = $1;
}
# make sure sections start with a /
$link =~ s|^"|/"|;
my $page;
my $section;
if ($link =~ m|^ (.*?) / "? (.*?) "? $|x) { # [name]/"section"
($page, $section) = ($1, $2);
}
elsif ($link =~ /\s/) { # this must be a section with missing quotes
($page, $section) = ('', $link);
}
else {
($page, $section) = ($link, '');
}
# warning; show some text.
$linktext = $orig_link unless defined $linktext;
my $url = '';
if (defined $page && length $page) {
$url = $page;
$url =~ s|::|/|g;
}
# append the #section if exists
$url .= "#$section" if defined $section and length $section;
return make_href($url, $linktext);
}
sub make_href {
my($url, $title) = @_;
$title = $url unless defined $title;
return qq{<a href="$url">$title</a>};
}
1;
__END__
=head1 NAME
C<DocSet::Doc::POD2HTMLPS> - POD source to PS (intermediate HTML) target converter
=head1 SYNOPSIS
=head1 DESCRIPTION
Implements an C<DocSet::Doc> sub-class which converts a source
document in POD, into an output document in PS (intermediate in HTML).
=head1 METHODS
For the rest of the super class methods see C<DocSet::Doc>.
=over
=item * convert
=back
=head1 AUTHORS
Stas Bekman E<lt>stas (at) stason.orgE<gt>
=cut
1.2 +37 -7 modperl-docs/lib/DocSet/DocSet/HTML.pm
Index: HTML.pm
===================================================================
RCS file: /home/cvs/modperl-docs/lib/DocSet/DocSet/HTML.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- HTML.pm 5 Jan 2002 18:51:59 -0000 1.1
+++ HTML.pm 24 Jan 2002 18:11:24 -0000 1.2
@@ -3,6 +3,8 @@
use strict;
use warnings;
+use File::Spec::Functions;
+
use DocSet::Util;
use DocSet::NavigateCache ();
@@ -24,12 +26,17 @@
$self->set(dst_mime => 'text/html');
$self->set(tmpl_mode => 'html');
$self->set_dir(dst_root => $self->get_dir('dst_html'));
- banner("HTML DocSet: " . $self->get('title') );
+
+ note "\n";
+ banner("[scan] HTML DocSet: " . $self->get('title') );
}
sub complete {
my($self) = @_;
+ note "\n";
+ banner("[render] HTML DocSet: " . $self->get('title') );
+
$self->write_index_file();
}
@@ -88,11 +95,11 @@
version => $self->get('version')||'',
date => get_date(),
last_modified => get_timestamp(),
-# body => top
+ pdf_doc => $self->pdf_doc,
);
- # pluster index top and bottom docs if defined (after converting them)
+ # plaster index top and bottom docs if defined (after converting them)
if (my $body = $self->get('body')) {
my $src_root = $self->get_dir('src_root');
my $dst_mime = $self->get('dst_mime');
@@ -120,10 +127,6 @@
}
-
-
-
-
my $dst_root = $self->get_dir('dst_html');
my $dst_file = "$dst_root/index.html";
my $mode = $self->get('tmpl_mode');
@@ -133,6 +136,33 @@
my $content = proc_tmpl($tmpl_root, $tmpl_file, $mode, $vars);
note "+++ Creating $dst_file";
DocSet::Util::write_file($dst_file, $content);
+}
+
+# search for a pdf version in the parallel tree and copy/gzip it to
+# the same dir as the html version (we link to it from the html)
+sub pdf_doc {
+ my $self = shift;
+
+ my $id = $self->get('id');
+ my $dst_path = catfile $self->get_dir('dst_root'), "$id.pdf";
+ my $src_path = catfile $self->get_dir('dst_ps') , "$id.pdf";
+
+#print "TRYING $dst_path $src_path \n";
+
+ my %pdf = ();
+ if (-e $src_path) {
+ copy_file($src_path, $dst_path);
+ gzip_file($dst_path);
+ my $gzip_path = "$dst_path.gz";
+ %pdf = (
+ size => format_bytes(-s $gzip_path),
+ link => filename($gzip_path),
+ );
+ }
+#dumper \%pdf;
+
+ return \%pdf;
+
}
1.2 +11 -4 modperl-docs/lib/DocSet/DocSet/PSPDF.pm
Index: PSPDF.pm
===================================================================
RCS file: /home/cvs/modperl-docs/lib/DocSet/DocSet/PSPDF.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- PSPDF.pm 5 Jan 2002 18:51:59 -0000 1.1
+++ PSPDF.pm 24 Jan 2002 18:11:24 -0000 1.2
@@ -13,7 +13,7 @@
# what's the output format
sub trg_ext {
- return 'html';
+ return 'html'; # in this case 'html' is just an intermediate format
}
sub init {
@@ -23,15 +23,20 @@
# configure PS/PDF specific run-time
# though, we build ps/pdf the intermediate product is HTML
- $self->set(dst_mime => 'text/html');
+ $self->set(dst_mime => 'text/htmlps');
$self->set(tmpl_mode => 'ps');
$self->set_dir(dst_root => $self->get_dir('dst_ps'));
- banner("PS/PDF DocSet: " . $self->get('title') );
+
+ note "\n";
+ banner("[scan] PS/PDF DocSet: " . $self->get('title') );
}
sub complete {
my($self) = @_;
+ note "\n";
+ banner("[render] PS/PDF DocSet: " . $self->get('title') );
+
$self->write_index_file();
$self->create_ps_book;
@@ -46,7 +51,7 @@
# Using the same template file create the long and the short index
# html files
##################################
-sub write_index_file{
+sub write_index_file {
my($self) = @_;
my $dir = {
@@ -112,6 +117,8 @@
my $command = "ps2pdf $dst_root/$id.ps $dst_root/$id.pdf";
note "% $command";
system $command;
+
+ # META: can delete the .ps now
}
1.2 +4 -2 modperl-docs/lib/DocSet/Source/HTML.pm
Index: HTML.pm
===================================================================
RCS file: /home/cvs/modperl-docs/lib/DocSet/Source/HTML.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- HTML.pm 5 Jan 2002 18:51:59 -0000 1.1
+++ HTML.pm 24 Jan 2002 18:11:24 -0000 1.2
@@ -18,10 +18,12 @@
my $mode = 'Pod::POM::View::HTML';
#print Pod::POM::View::HTML->print($pom);
+ my $title = $self->{parsed_tree}->{title};
$self->{meta} =
{
- title => $self->{parsed_tree}->{title},
- link => $self->{rel_dst_path},
+ title => $title,
+ stitle => $title, # stitle is the same in docs
+ link => $self->{rel_dst_path},
};
# there is no autogenerated TOC for HTML files
1.2 +65 -16 modperl-docs/lib/DocSet/Source/POD.pm
Index: POD.pm
===================================================================
RCS file: /home/cvs/modperl-docs/lib/DocSet/Source/POD.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- POD.pm 5 Jan 2002 18:51:59 -0000 1.1
+++ POD.pm 24 Jan 2002 18:11:24 -0000 1.2
@@ -10,30 +10,73 @@
require DocSet::Doc;
@ISA = qw(DocSet::Doc);
+use constant HEAD_MAX_LEVEL => 4;
+use constant MAX_DESC_LENGTH => 500;
+
+# META: we are presenting too early, or this code should be moved to
+# POD2HTML specific module
+require Pod::POM::View::HTML;
+my $mode = 'Pod::POM::View::HTML';
+
sub retrieve_meta_data {
my($self) = @_;
$self->parse_pod;
- use Pod::POM::View::HTML;
- my $mode = 'Pod::POM::View::HTML';
#print Pod::POM::View::HTML->print($pom);
- my $meta = {};
+ my $meta = {
+ title => 'No Title',
+ abstract => '',
+ };
my $pom = $self->{parsed_tree};
my @sections = $pom->head1();
- # don't present on purpose ->present($mode); there should be no markup in NAME
- my $name_sec = shift @sections;
- if ($name_sec) {
- $meta->{title} = $name_sec->content();
- }
- else {
- $meta->{title} = 'No Title';
+
+
+ if (@sections) {
+
+ # extract the title from the NAME section and remove it from content
+ if ($sections[0]->title =~ /NAME/) {
+ # don't present on purpose ->present($mode); there should
+ # be no markup in NAME a problem with
+ # <TITLE><CODE>....</CODE><TITLE> and alike
+ $meta->{title} = (shift @sections)->content();
+ $meta->{title} =~ s/^\s*|\s*$//sg;
+ }
+
+ # stitle is the same in docs
+ $meta->{stitle} = $meta->{title};
+
+ # locate the DESCRIPTION section (should be in the first three
+ # sections)
+ for (0..2) {
+ next unless defined $sections[$_]
+ && $sections[$_]->title =~ /DESCRIPTION/i;
+
+ my $abstract = $sections[$_]->content->present($mode);
+
+# cannot do this now, as it might cut some markup in the middle: <i>1 2</i>
+# # we are interested only in the first paragraph, or if its
+# # too big first MAX_DESC_LENGTH chars.
+# my $index = index $abstract, " ", MAX_DESC_LENGTH;
+# # cut only if index didn't return '-1' which is when the the
+# # space wasn't found starting from location MAX_DESC_LENGTH
+# unless ($index == -1) {
+# $abstract = substr $abstract, 0, $index+1;
+# $abstract .= " ... <i>(continued)</i>";
+# }
+#
+# # temp workaround, but can only split on paras
+ $abstract =~ s|<p>(.*?)</p>.*|$1|s;
+
+ $meta->{abstract} = $abstract;
+ last;
+ }
}
- $meta->{title} =~ s/^\s*|\s*$//sg;
$meta->{link} = $self->{rel_dst_path};
+
# put all the meta data under the same attribute
$self->{meta} = $meta;
@@ -49,14 +92,19 @@
sub render_toc_level {
my($self, $node, $level) = @_;
- my %toc_entry = ();
my $title = $node->title;
- $toc_entry{link} = $toc_entry{title} = "$title"; # must stringify
- $toc_entry{link} =~ s/\W/_/g; # META: put into a sub?
- $toc_entry{link} = "#$toc_entry{link}"; # prepand '#' for internal links
+ my $link = "$title"; # must stringify to get the raw string
+ $link =~ s/\W/_/g; # META: put into a sub?
+ $link = "#$link"; # prepand '#' for internal links
+
+ my %toc_entry = (
+ title => $title->present($mode), # run the formatting if any
+ link => $link,
+ );
+
my @sub = ();
$level++;
- if ($level < 5) {
+ if ($level <= HEAD_MAX_LEVEL) {
# if there are deeper than =head4 levels we don't go down (spec is 1-4)
my $method = "head$level";
for my $sub_node ($node->$method()) {
@@ -64,6 +112,7 @@
}
}
$toc_entry{subs} = \@sub if @sub;
+
return \%toc_entry;
}
---------------------------------------------------------------------
To unsubscribe, e-mail: docs-cvs-unsubscribe@perl.apache.org
For additional commands, e-mail: docs-cvs-help@perl.apache.org