#!/usr/bin/env perl
# -*- cperl -*-

use strict;
use Pod::Xhtml;
use Pod::Hyperlink::BounceURL;
use Pod::Usage;
use Getopt::Long;
use XML::XSH2 qw(xsh_init open_doc);

# Default options
my %opt = (index => 1, toplink => 'ToC',topurl=>'#TOP');
GetOptions(\%opt, qw(css=s toplink|backlink=s topurl=s help index! infile:s outfile:s title:s))
    || pod2usage();
pod2usage(-verbose => 2) if $opt{help};

my $toplink = $opt{toplink} ?
    sprintf('<p><a href="%s" class="toplink">%s</a></p>', $opt{topurl}, $opt{toplink}) : '';


my $linkparser = new Pod::Hyperlink::BounceURL;
$linkparser->configure( URL => '%s.html' );

my $parser = new Pod::Xhtml(
    MakeIndex  => $opt{index},
    TopLinks   => $toplink,
    StringMode => 1,
    LinkParser => $linkparser,
);
if ($opt{css}) {
    $parser->addHeadText(qq[<link rel="stylesheet" href="$opt{css}"/>]);
}
$parser->parse_from_file($opt{infile});

$XML::XSH2::Map::xhtml = $parser->asString;
$XML::XSH2::Map::outfile = $opt{outfile};
$XML::XSH2::Map::title = $opt{title};

# post process:

use XML::XSH2::Inline;

nobackups;
quiet;
echo $outfile;
open --string $xhtml;

register-xhtml-namespace x;

# minor fixes

while //x:p[x:dl and not(text())] {
  xmove node() replace .;
}

if {length $title} {
  rm /*/x:head/x:title;
  my $t := insert element x:title prepend /*/x:head;
  $t +:= insert element x:h1 prepend /*/x:body;
  xinsert text $title into $t;
}

map { 'Table of contents' } //*[@id='TOP']/text();

for //@href[starts-with(.,'#quot_')] {
  map :i {s/^\#quot_/\#/; s/_quot$//} .;
  map :i {s/^"(.*)"$/$1/} ../text();
}

for //x:cite {
  rename a .;
  cp xsh:new-attribute('href',concat(.,'.html')) into .;
}

$items=//x:dt;

$ids = 0;
for //x:code[not(ancestor::x:dt)] {
  my $str = normalize-space(.);
  my $str1 = normalize-space(substring-before(.,'('));
  my $target = (//x:h1|//x:h2|//x:h3|//x:h4)[.=$str];
  if ($target) {
#    echo Creating link to $str;
    wrap a .;
    cp xsh:new-attribute('href',concat('#',$target/@id)) into ..;
  } else {
    my $item = $items[normalize-space(.)=$str];
    unless ($item) $item = $items[normalize-space(.)=$str1];

    for my $s in {grep length, $str,$str1} {
      unless ($item)
	$item = $items[$s=normalize-space(substring-before(.,'('))];
      unless ($item) 
	$item = $items[
	  $s=normalize-space(substring-after(.,'>')) or
	  $s=normalize-space(substring-after(.,'::')) ];
      unless ($item)
	$item = $items[
	  $s=normalize-space(substring-before(substring-after(.,'>'),'(')) or
	  $s=normalize-space(substring-before(substring-after(.,'::'),'(')) ];
    }

    if count($item)>1 {
      my $best = $item[1];
      my $best_common_level = 0;
      my $ancestors = ancestor-or-self::*;
      my $cnt = count($ancestors);
      for my $i in ($item) {
	my $common_level = count($i/ancestor-or-self::*[
	  count(.|$ancestors)=$cnt]);
	if ($common_level>$best_common_level) {
	  $best = $i;
	  $best_common_level = $common_level;
	}
      }
      $item = $best;
    }
    if ($item) {
#      echo ITEM: $str "=>" $item;
      unless ($item/@id) {
	# generate id
	$id += 1;
	insert attribute 'id="gen-${id}"' into $item;
      }
      wrap a .;
      cp xsh:new-attribute('href',concat('#',$item/@id)) into ..;	
    }
  }
}

map :i {s/%3A%3A/__/g} //@href;

save --format html --file $outfile;

__END__

=pod


=head1 NAME

pod2xhtml - convert .pod files to .xhtml files

=head1 SYNOPSIS

    pod2xhtml [--title] title [--help] [--infile INFILE] [--outfile OUTFILE] [OPTIONS]

=head1 DESCRIPTION

Converts files from pod format (see L<perlpod>) to XHTML format.

=head1 OPTIONS

pod2xhtml takes the following arguments:

=over 4

=item *

--help - display help

=item *

--infile FILENAME
- the input filename. STDIN is used otherwise

=item *

--title TITLE
- put <title>TITLE</title> into head and <h1>TITLE</h1> to the top of body


=item *

--outfile FILENAME
- the output filename. STDOUT is used otherwise

=item *

--css URL
- Stylesheet URL

=item *

--index/--noindex
- generate an index, or not. The default is to create an index.

=item *

--toplink LINK TEXT
- set text for "back to top" links. The default is 'Top'.

=back

=head1 BUGS

See L<Pod::Xhtml> for a list of known bugs in the translator.

=head1 AUTHOR

P Kent E<lt>cpan _at_ bbc _dot_ co _dot_ ukE<gt>

Customizations by P. Pajas 

=head1 COPYRIGHT

This is a customized of pod2xhtml script, copyrighted by (c) BBC 2004.

This program is free software; you can redistribute it and/or modify
it under the GNU GPL.

See the file COPYING in this distribution, or http://www.gnu.org/licenses/gpl.txt

=head1 SEE ALSO

L<perlpod>, L<Pod::Xhtml>

=cut
