#!/usr/bin/perl
########################################################################
# Pod::Simple::HTML::Local
########################################################################
{package Pod::Simple::HTML::Local;
use strict;
use warnings;
use parent 'Pod::Simple::HTML';
use URI::Escape;
# Links anders verarbeiten
# das mache ich mit dem Überschreiben der passenden Funktion in
# Pod::Simple::HTML
$Pod::Simple::HTML::Tagmap{'item-bullet'}='
';
$Pod::Simple::HTML::Tagmap{'item-number'}='';
$Pod::Simple::HTML::Tagmap{'item-text'}='';
$Pod::Simple::HTML::Tagmap{'over-bullet'}='';
$Pod::Simple::HTML::Tagmap{'over-number'}='';
$Pod::Simple::HTML::Tagmap{'over-text'}='';
sub set_base_dir
{
my $self=shift;
my $path=shift;
return 0 if(!$path);
$self->{INPUT_BASE_DIR}=$path;
}
sub set_module_match_ref
{
my $self=shift;
my $ref=shift;
return 0 if(ref($ref) ne 'ARRAY');
$self->{MODULE_MATCH}=$ref;
return 1;
}
sub set_file_match_ref
{
my $self=shift;
my $ref=shift;
return 0 if(ref($ref) ne 'ARRAY');
$self->{FILE_MATCH}=$ref;
return 1;
}
sub resolve_pod_link_by_table
{
my ($self,$it,$section)=@_;
$self->{MODULE_MATCH}=[] unless($self->{MODULE_MATCH} && ref($self->{MODULE_MATCH}) eq "ARRAY");
$self->{FILE_MATCH}=[] unless($self->{FILE_MATCH} && ref($self->{FILE_MATCH}) eq "ARRAY");
my $file;
if(!$it && $section)
{ $file='/'.uri_unescape($section); }
elsif($it && $section && $it!~/::/)
{ $file=$it.'/'.uri_unescape($section); }
elsif($it && $it!~/::/)
{ $file=$it; }
$file=File::Spec->rel2abs($file,$self->{INPUT_BASE_DIR}) if($file);
if($file)
{
# datei in liste
if(grep{$_ eq $file}@{$self->{FILE_MATCH}})
{ return $self->convert_file_name($file); }
# datei mit #pageref
for my $path (@{$self->{FILE_MATCH}} )
{
if($file=~/^\Q$path\E(.*?)$/)
{
my $add=$1;
$add=~s!^[/#]+!!;
return $self->convert_file_name($path).'#'.$add;
}
}
# Die Datei ist ".pod" und bekannt
if($file=~m!^(.+?\.(?:pod|pl|pm))((?:[/#].+?)?)$!)
{
my ($path,$add)=($1,$2);
$add=~s!^[/#]+!!;
if(-f $path)
{
push(@{$self->{FILE_MATCH}},$path);
return $self->convert_file_name($path).($add?'#'.lc($add):'');
}
}
}
$it='' if(!$it);
if($section)
{$section='#'.$section; }
else
{ $section=''; }
# Das Modul ist in der Liste
if(grep{$_ eq $it}@{$self->{MODULE_MATCH}})
{ return $self->convert_module_name($it).$section; }
# Das Modul gehört zum selben Paket
if(grep{$it=~m!^\Q$_!}@{$self->{MODULE_MATCH}})
{
push(@{$self->{MODULE_MATCH}},$it);
return $self->convert_module_name($it).$section;
}
return undef;
}
########################################################################
sub convert_module_name
{
my $self=shift();
my $module=shift || '';
$module=~s!^.*?([^\\/]+)$!$1!;
$module=~s/::/_/g;
$module.='.html';
return $module;
}
sub convert_file_name
{
my $self=shift();
my $file=shift || '';
return $file if($file=~/\.html?$/);
unless( $file=~s!^.*?([^\\/]+)\.(?:pod|pl|pm)$!$1.html! )
{ $file.='.html'; }
return $file;
}
1;}
########################################################################
# MAIN
########################################################################
package main;
use strict;
use warnings;
use File::Spec;
use Getopt::Long;
use POSIX qw(:errno_h);
my $verbose=0;
my $charset='UTF-8';
my $output_base=File::Spec->curdir();
my $input_base=File::Spec->curdir();
my $css_file;
my $force=0;
my $ask=0;
my $index=0;
my $strict=0;
my $force_achor=0;
my @modules=();
my @env_dirs=();
my @files=();
$charset=$ENV{MM_CHARSET} if($ENV{MM_CHARSET});
$charset=$ENV{HTML_CHARSET} if($ENV{HTML_CHARSET});
GetOptions (
"charset=s" => \$charset,
"outdir|dir=s" => \$output_base,
"basedir|workingdir=s" => \$input_base,
"env=s" => \@env_dirs,
"module=s" => \@modules,
"file=s" => \@files,
"help" => sub{ usage(); },
"style=s" => \$css_file,
"force!" => \$force,
"verbose!" => \$verbose,
"ask!" => \$ask,
"index!" => \$index,
"strict!" => \$strict,
"anchors!" => \$force_achor,
) || usage('Unkown option',0,EINVAL());
push(@modules,@ARGV) if(@ARGV);
@env_dirs=map{ File::Spec->rel2abs($_) }@env_dirs;
unshift(@INC,@env_dirs);
usage('No Modul or File !',0,EINVAL()) if(!@modules and !@files);
$input_base=File::Spec->rel2abs($input_base);
@files=map{ File::Spec->rel2abs($_,$input_base) }@files;
$Pod::Simple::HTML::Content_decl = qq{};
########################################################################
for my $path (@files)
{
# could be a Molule
if(!$strict and $path=~/\.pm/ && -f $path)
{
my($p,$file,$add)=extract_module($path,[$input_base]);
if( defined($add) )
{ $file="${add}::$file" if($add); }
else
{ unshift(@ENV,$p); }
$file=~s/\.pm$//;
push(@modules,$file);
print "Convert File: $path to Module $file\n" if($verbose);
next;
}
unless(convert_file($path))
{
if($force)
{ print qq(File "$path" not found\n) if($verbose); }
else
{ usage(qq(File "$path" not found!),1,ENOENT()); }
}
}
for my $module (@modules)
{
my $path=get_filename($module);
if(!$strict and -f $module)
{
print "Convert Module: $module to " if($verbose);
my ($path,$add);
($path,$module,$add)=extract_module($path,@INC);
if( defined($add) )
{ $module="${add}::$module" if($add); }
else
{ unshift(@ENV,$path); }
$module=~s/\.pm$//;
print "$module\n" if($verbose);
}
unless(convert_file($path,$module))
{
if($force)
{ print qq(File for Module "$module" not found\n) if($verbose); }
else
{ usage(qq(File for Module "$module" not found!),1,ENOENT()); }
}
}
########################################################################
# Funktionen
########################################################################
sub convert_file
{
my $path=shift // '';
my $module=shift;
if($path && -f $path )
{
print qq|Read Pod from $path\n| if($verbose);
my $pod=Pod::Simple::HTML::Local->new();
my $html='';
$pod->output_string(\$html);
$pod->set_module_match_ref(\@modules);
$pod->set_file_match_ref(\@files);
$pod->set_source( $path );
$pod->set_base_dir( $input_base );
$pod->html_css($css_file) if($css_file);
$pod->index($index);
if($force_achor)
{
$pod->{Tagmap}->{'item-bullet'}='
- ';
$pod->{Tagmap}->{'item-number'}='
- ';
}
if(!$module and ( my $title = $pod->get_short_title() ))
{
$title=~s/\s+--.*$//;
$pod->force_title($title);
}
$pod->run;
if($html)
{
print "HTML created \n" if($verbose);
if($force_achor)
{
my $out="";
while( $html=~s/^(.*?)\Q\E(\s*[^\n]+)//s )
{
my @v=($1,$2);
my $str=$2;
$str=~s/[\s\r\n]+/_/;
$str=~s/^_+//;
$str=~s/_+$//;
$out.=$v[0].qq($v[1]);
}
$out.=$html if($html);
$html=$out;
print "Anchors created \n" if($verbose);
}
my $outputname='';
if($module)
{ $outputname=File::Spec->join($output_base,$pod->convert_module_name($module)); }
else
{ $outputname=File::Spec->join($output_base,$pod->convert_file_name($path)); }
print qq(Write HTML to file "$outputname" \n) if($verbose);
if($ask and -f $outputname)
{
my $count=5;
while($count--)
{
print qq|File "$outputname" allready exists.\nReplace it? [Yes/No]: |;
my $line=;
chomp($line);
if($line=~/^\s*n(?:o)?\s*$/i)
{
print qq|File "$outputname" not replaced. No HTML written\n| if($verbose);
return 1;
}
elsif(!$line || $line!~/^\s*y(?:es)?\S*$/i)
{
print qq|File "$outputname" will be replaced.\n| if($verbose);
last;
}
print 'Unknown answer try [y/Y]es or [n/N]o: ';
}
unless($count)
{
print qq|Five trys failed. File "$outputname" not replaced. No HTML written\n| if($verbose);
return 1;
}
}
if(create_path($outputname))
{
if(open(my $fh, '>', $outputname))
{
print $fh $html;
close($fh);
}
else
{
if($force)
{ print qq|Can't create "$outputname" ($!)\n| if($verbose); }
else
{ usage(qq|ERROR create "$outputname" ($!)\n|,1,EACCES()); }
}
}
else
{
if($force)
{ print qq|Can't create path to "$outputname" ($!)\n| if($verbose); }
else
{ usage(qq|ERROR create path to "$outputname" ($!)\n|,1,EACCES()); }
}
}
elsif($verbose)
{ print "No POD found, no HTML created\n"; }
return 1;
}
elsif($verbose)
{ print qq(File "$path" don't exists!\n); }
return 0;
}
sub usage
{
my $msg=shift || '';
my $nohelp=shift || 0;
my $exit=shift || 0;
my $out=\*STDOUT;
if($msg)
{
$out=\*STDERR;
print $out "ERROR: $msg\n";
$exit=255 unless($exit);
}
print $out < [ ...] ]
Convert POD to HTML with subpackages as local files
and set links correctly.
OPTIONS:
--dir | --outputdir
Set destination directory for the HTML files.
Default directory is the current.
--basedir | --workingdir
Set source directory for the pod files.
Default directory is the current.
--charset
Set the character encoding in HTML document.
UTF-8 is set as default. If available the enviroment variable
MM_CHARSET or HTML_CHARSET will be used.
--module
Set one or more modules which POD should be converted
--file
Set one or more files which POD should be converted
--env
Set one or more directories where modules can be found
--style
Set CSS-file
--index
Create Page Index
--help
Show this text
--ask
ask if a file will be replaced
--verbose
verbose output
--force
all errors are ignored.
--strict
don't convert Files to Modules.
--anchors
force anchors for listentries
EOH
exit($exit);
}
sub get_filename
{
my $module=shift;
my $name=undef;
$name=$module if(-f $module);
unless($name)
{
for(@INC)
{
my $path=File::Spec->join($_,$module);
if(-f $path)
{
$name=$path;
last;
}
}
}
unless($name)
{
my @dirs=split('::',$module);
my $path=File::Spec->join(@dirs);
outer:for my $end (qw(.pod .pm .pl))
{
my $p = $path.$end;
for my $base (@INC)
{
my $fullpath=File::Spec->join($base,$p);
if(-f $fullpath)
{
$name=$fullpath;
last outer;
}
}
}
unless($name)
{
my $fullpath=File::Spec->rel2abs($path);
$name=$fullpath if(-f $fullpath);
}
}
return $name;
}
sub create_path
{
my $path=shift;
return 0 unless($path);
$path=File::Spec->rel2abs($path);
return 0 unless($path);
my ($run,$directories,undef) = File::Spec->splitpath( $path );
for my $dir (File::Spec->splitdir( $directories ))
{
$run=File::Spec->join($run,$dir);
unless(-d $run)
{
return 0 unless(mkdir($run));
}
}
return 1;
}
sub extract_module
{
my $path=shift;
my $dirs=shift;
my ($run,$directories,$file) = File::Spec->splitpath( $path );
my $p=File::Spec->join($run,$directories );
$p=~s!([\\/])+!$1!;
my $add=undef;
for my $inc_path (reverse sort @$dirs)
{
if($p=~/^\Q$inc_path\E(.*?)$/)
{
if(!$1)
{
$add='';
last;
}
$add=$1;
if($add=~m!^[\\/](.+?)$!)
{
$add=$1;
$add=~s![\\/]+!::!gs;
last;
}
}
}
return ($p,$file,$add);
}
#__END__
=encoding utf8
=head1 NAME
pod_html_doc -- Create local HTML-Doku from pod
=head1 SYNOPSIS
HTML-Doc for this script in the working dir
pod_html_doc --file pod_html_doc
HTML-Doc for IO::File IO::Handle IO::Seekable IO::Dir in html-out/
pod_html_doc --outdir=html-out/ IO::File IO::Handle IO::Seekable IO::Dir
HTML-Doc for Pod::Simple::HTML in html-out/
pod_html_doc --outdir=html-out/ --module=Pod::Simple::HTML
=head1 DESCRIPTION
This converter create local documentations from POD Files and Modules with
POD-Documentations.
All Files for an Module will beconverted.
=over 4
=item --dir | --outputdir
Set destination directory for the HTML files.
Default directory is the current.
=item --basedir | --workingdir
Set source directory for the pod files.
Default directory is the current.
=item --env
Set one or more directories where modules can be found.
This works also for Modulnames linked in the POD
=item --module
Set one or more modules which POD should be converted
If the Modulname is a Filename the name will be searched in @INC.
This can be supressed by using "--strict"
Correct Modulnames are even searched in @INC
you can add path names to @INC with "--inc"
=item --file
Set one or more files which POD should be converted
The searchpath for relative filepaths is set with "--basedir"
If the filename looks like a path to an Module the Name will be converted.
The only Searchpath is set with "--basedir"
This can be supressed by using "--strict"
so remember:
--env and --modules
--file and --basedir
Please use --file not for modules and --module not for normal files.
The script tries to solve that, but it's not bullet prove.
=item --charset
Set the character encoding in HTML document.
UTF-8 is set as default. If available the enviroment variable
MM_CHARSET or HTML_CHARSET will be used.
=item --style
Set CSS-file
This file must not exists only the filename will be inclued in the HTML.
=item --index
Create Page Index
This behavior is disabled by default
=item --help
print a short helptext
=item --ask
At every already existing file ask if it may be replaced. Default is "Yes".
=item --verbose
Explans neearly everything.
=item --force
all errors are ignored. If a file could not be created or
any other error occured the script will not stop
=item --strict
don't convert Files to Modules.
=item --anchors
Set anchors for list entries. That's a hack!
C<=item 1> and C<=item *> I don't get an link-anchor.
This option search for C<<
- Name >> in the html and set the anchor.
But it's a regexp hack, and can produce wrong link-anchors.
=back
=head1 EXAMPLES
Convert all Files related to IO::File:
pod_html_doc --outdir=html-out/ IO::File IO::Handle IO::Seekable IO::Dir
more komplex creation, with css-file index.pod and an own module.
In each file an Index is created.
Creates index.html and OWN_Module.html in html-out/
pod_html_doc --outdir=html-out/ --basedir=LIBS/ --file=OWN/index.pod --env=LIBS/ --module=OWN::Module --style=pod.css --index
=head1 AUTHOR
ToPeG
=head1 VERSION
Version 1.0
=head1 COPYRIGHT
Copyright (c) ToPeG. All rights reserved.
=head1 LICENSE
This program is free software; you can redistribute it
and/or modify it under the same terms and conditions as
Perl itself.
This means that you can, at your option, redistribute it and/or modify it under
either the terms the GNU Public License (GPL) version 2 or later, or under the
Perl Artistic License.
See http://dev.perl.org/licenses/
=head1 DISCLAIMER
THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS
OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
PARTICULAR PURPOSE.
Use of this software in any way or in any form, source or binary,
is not allowed in any country which prohibits disclaimers of any
implied warranties of merchantability or fitness for a particular
purpose or any disclaimers of a similar nature.
IN NO EVENT SHALL I BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT,
SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OF THIS SOFTWARE AND ITS DOCUMENTATION (INCLUDING, BUT NOT
LIMITED TO, LOST PROFITS) EVEN IF I HAVE BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE