#!/usr/bin/perl

########################################################################
# Pod::Simple::HTML::Local
########################################################################
{package Pod::Simple::HTML::Local;
use strict;
use warnings;
use parent 'Pod::Simple::HTML';
use URI::Escape;
use File::Spec;
##use Data::Dumper;
# Links anders verarbeiten
# das mache ich mit dem Überschreiben der passenden Funktion in
# Pod::Simple::HTML

$Pod::Simple::HTML::Tagmap{'item-bullet'}='<li class="ItemBullet">';
$Pod::Simple::HTML::Tagmap{'item-number'}='<li class="ItemNumber">';
$Pod::Simple::HTML::Tagmap{'item-text'}='<dt class="ItemText">';
$Pod::Simple::HTML::Tagmap{'over-bullet'}='<ul class="OverBullet">';
$Pod::Simple::HTML::Tagmap{'over-number'}='<ol class="OverNumber">';
$Pod::Simple::HTML::Tagmap{'over-text'}='<dl class="OverText">';

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_match=@{$self->{FILE_MATCH}};
  my @module_match=@{$self->{MODULE_MATCH}};

  #print Dumper(\@file_match,\@module_match);

  # Verweis auf Modul/Datei ohne Verweis darin
  if($it && !$section)
  {
    # es ist ein bekanntes Modul
    if( grep{$_ eq $it}@module_match )
    { return $self->convert_module_name($it); }

    # es it ein Submodul
    if(grep{$it=~m!^\Q$_!}@module_match)
    {
      push(@{$self->{MODULE_MATCH}},$it);
      return $self->convert_module_name($it);
    }

    # es ist eine bekannte Datei
    if(grep{$_ eq $it}@file_match )
    { return $self->convert_file_name($it); }

    # es ist eine unbekannte aber vorhandene Datei.
    if(-f File::Spec->rel2abs($it,$self->{INPUT_BASE_DIR}) )
    {
      # wenn es mit POD zu tun hat,
      # dann zum wandeln vorsehen
      if($it=~/\.(?:pl|pm|pod)/ || $it!~/\.[^.]+$/)
      {
        push( @{$self->{FILE_MATCH}}, $it );
        return $self->convert_file_name($it);
      }
      # lokale Datei...
      return $it;
    }
  }
  # es könnte ein datei mit lokalem Verweis ein,
  # oder nur eine datei,
  # oder ein Modul mit lokamen Verweis
  else
  {
    # alle links müssen mit "/" getrennt sein
    # mache ich einfach mal als Vorschift um mir die Arbeit zu verweinfachen
    my $raw=$it//'';
    $raw.='/'.uri_unescape($section);
    # Tippfehler korrigieren
    # keine doppelten /
    # keine / am anfang oder ende
    $raw=~s!/+!/!g;
    $raw=~s!^/+!!;
    $raw=~s!/+$!!;

    # letztes Element kann ein interner Verweis sein, muss aber nicht.
    if($raw=~m!^(.+)/([^/]+)$!)
    {
      my $mod=$1;
      my $ref=$2;

      # modul gefunden
      if(grep{$_ eq $mod}@module_match)
      { return $self->convert_module_name($mod)."#".$ref; }

      # es it ein Submodul
      if(grep{$mod=~m!^\Q$_!}@module_match)
      {
        push( @{$self->{MODULE_MATCH}}, $mod );
        return $self->convert_module_name($mod).'#'.$ref;
      }

      # es kann noch eine bekannte Datei sein
      if(grep{$_ eq $mod}@file_match)
      { return $self->convert_file_name($mod).'#'.$ref; }

      # es ist eine unbekannte aber vorhandene Datei.
      if(-f File::Spec->rel2abs($mod,$self->{INPUT_BASE_DIR}) )
      {
        # wenn es mit POD zu tun hat,
        # dann zum wandeln vorsehen
        if($mod=~/\.(?:pl|pm|pod)/ || $mod!~/\.[^.]+$/)
        {
          push( @{$self->{FILE_MATCH}}, $mod );
          return $self->convert_file_name($mod).'#'.$ref;
        }
        # lokale Datei...
        return $mod.'#'.$ref;
      }
    }

    # es kann hier nurnoch eine Datei sein,
    # oder ein unbakkntes Modul

    if(grep{$_ eq $raw}@file_match)
    { return $self->convert_file_name($raw); }

    # es ist eine unbekannte aber vorhandene Datei.
    if(-f File::Spec->rel2abs($raw,$self->{INPUT_BASE_DIR}) )
    {
      # wenn es mit POD zu tun hat,
      # dann zum wandeln vorsehen
      if($raw=~/\.(?:pl|pm|pod)/ || $raw!~/\.[^.]+$/)
      {
        push( @{$self->{FILE_MATCH}}, $raw );
        return $self->convert_file_name($raw);
      }

      # lokale Datei...
      return $raw;
    }

  }

  # hier angekommen kann es nur noch ein unbekanntes Modul sein
  # das überlasse ich der Aufbreitung durch Pod::Simple::HTML
  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?$/);
  if(File::Spec->file_name_is_absolute($file))
  { $file=File::Spec->abs2rel($file,$self->{INPUT_BASE_DIR}); }
  $file=~s![/\\]+!_!g;
  unless( $file=~s!^.*?([^\\/]+)\.(?:pod|pl|pm)$!$1.html! )
  { $file.='.x.html'; }
  return $file;
}

1;}

########################################################################
# MAIN
########################################################################

package main;

use strict;
use warnings;
use File::Spec;
use Getopt::Long;
use POSIX qw(:errno_h);
use Data::Dumper;
use HTML::Entities;

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);
$output_base=File::Spec->rel2abs($output_base);

@files=map{ File::Spec->rel2abs($_,$input_base) }@files;
@files=map{ File::Spec->abs2rel($_,$input_base) }@files;


$Pod::Simple::HTML::Content_decl = qq{<meta http-equiv="Content-Type" content="text/html; charset=$charset" >};

########################################################################

print "Converting Files\n" if($verbose);
for my $raw_file (@files)
{
  my $path=File::Spec->rel2abs($raw_file,$input_base);
  # could be a Molule
  if(!$strict and $raw_file=~/\.pm$/ and -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()); }
  }
}

print "Converting Modules\n" if($verbose);
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);
  }

  print "USING $path for $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'}='<li class="ItemBullet"><!--add_anchor_here-->';
      $pod->{Tagmap}->{'item-number'}='<li class="ItemNumber"><!--add_anchor_here-->';
    }

    if(!$module and ( my $title = $pod->get_short_title() ))
    {
      $title=~s/\s+--.*$//;
      $pod->force_title(encode_entities($title));
    }

    $pod->run;

    if($html)
    {
      print "HTML created \n" if($verbose);

      if($force_achor)
      {
        my $out="";
        while( $html=~s/^(.*?)\Q<!--add_anchor_here-->\E((?:\s*[^<>\n]+)|(?:\s*<a[^>]+>.+?<\/a>))//s )
        {
          my @v=($1,$2);
          my $str=$2;
          $str=$1 if($str=~/<a[^>]+>(.+?)<\/a>/);
          $str=~s/[\s\r\n]+/_/;
          $str=~s/^_+//;
          $str=~s/_+$//;
          $out.=$v[0].qq(<a name="$str">$v[1]</a>);
        }
        $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=<STDIN>;
          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 <<EOH if(!$nohelp);
USAGE:
  $0 [options] [<Module::B> [<Module::C> ...] ]

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<Name> don't get an link-anchor.
This option search for C<< <li> 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.1

=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