#!/usr/bin/perl

# my_pod2html -- convert POD to HTML, with some mangling

# Copyright 2009, 2010, 2011, 2013, 2016, 2017 Kevin Ryde

# my_pod2html is shared by several distributions.
#
# my_pod2html is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# my_pod2html is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
# more details.
#
# You should have received a copy of the GNU General Public License along
# with this file.  If not, see <http://www.gnu.org/licenses/>.

use strict;
use warnings;

# uncomment this to run the ### lines
# use Smart::Comments;


my $local_links = 0;
my $local_dir = '';
if (@ARGV && $ARGV[0] =~ /--local(=(.*))?/) {
  $local_links = 1;
  $local_dir = $2;
  shift @ARGV;
}
my $pod2html = MyPod2HTML->new;
$pod2html->title_postfix(' Man Page');

# <h1> and <h2> both too big, in mozilla at least
$pod2html->html_h_level(3);

$pod2html->parse_from_file(@ARGV);
exit 0;


#------------------------------------------------------------------------------
package MyPod2HTML;
use base 'Pod::Simple::HTML';


our $VERSION = 1;

use constant DEBUG => 0;

my %table;
BEGIN {
  %table =
    ('apt-file'     => 'http://packages.debian.org/apt-file',
     'apt-cache'    => 'http://packages.debian.org/apt',
     'apt-rdepends' => 'http://packages.debian.org/apt-rdepends',
     'gtk-options'  => 'http://manpages.ubuntu.com/manpages/jaunty/man7/gtk-options.7.html',
     'xsetroot'     => 'http://www.x.org/archive/X1'.'1R7.5/doc/man/man1/xsetroot.1.html',
     'leafnode'     => 'http://leafnode.sourceforge.net',
     'lynx'         => 'http://lynx.isc.org/',
     'feed2imap'    => 'http://home.gna.org/feed2imap',
     # disguise from grep
     'rss'.'2email' => 'http://rss'.'2email.infogami.com',
     'rssdrop'      => 'http://search.cpan.org/dist/rssdrop/',
     'toursst'      => 'http://packages.debian.org/etch/toursst',
     'netrc'        => 'http://linux.die.net/man/5/netrc',
     'gp'           => 'http://pari.math.u-bordeaux.fr/dochtml/gpman.html',

     # apparently http://man-db.nongnu.org/ doesn't have man pages 
     'man'      => 'http://ftp.parisc-linux.org/cgi-bin/man/man2html?man+1',
     'lexgrog'  => 'http://ftp.parisc-linux.org/cgi-bin/man/man2html?lexgrog+1',
     'apropos'  => 'http://ftp.parisc-linux.org/cgi-bin/man/man2html?apropos+1',
    );
}

sub resolve_man_page_link {
  my ($self, $to, $frag) = @_;
  $to = "$to";  # Pod::Simple::LinkSection object
  ### $to
  if (my ($page, $section) = ($to =~ /(.*)\(\d+\)$/)) {
    ### $page
    ### $section
    if (my $url = $table{$page}) {
      ### url from table: $url
      return $url;
    }
  }
  return shift->SUPER::resolve_man_page_link (@_);
}

sub resolve_pod_link_by_table {
  my ($self, $to, $section) = @_;

  my $tux_link = sub {
    my ($dir, $filename) = @_;
    if (! $local_links) { return "https://user42.tuxfamily.org/$dir/$filename"; }
    if ($dir eq $local_dir) { return $filename; }
    return "../$dir/$filename";
  };

  my $url;
  if (defined $to) {
    if ($to eq 'AptPkg') {
      $url = 'http://packages.debian.org/libapt-pkg-perl';
    }
    if ($to =~ /^Glib::Ex::(SourceIds|SignalIds|FreezeNotify|TieProperties)/) {
      $url = $tux_link->("glib-ex-ob"."jectbits", "$1.html");
    }
    if ($to eq 'Gtk2::Ex::Widget'.'Cursor') {
      $url = $tux_link->('gtk2-ex-widget'.'cursor', 'Widget'.'Cursor.html');
    }
    if ($to eq 'Ti'.'e:'.':TZ') {
      $url = $tux_link->('ti'.'e-'.'tz', 'TZ.html');
    }
    if ($to eq 'Time:'.':TZ') {
      $url = $tux_link->('ti'.'e-'.'tz', 'Time-'.'TZ.html');
    }

    if ($to =~ /^(Glib|Gtk2)($|::(?!Ex::))/) {
      $to =~ s{::}{/};
      $url = "http://gtk2-perl.sourceforge.net/doc/pod/$to.html"
    }

    if (defined $url) {
      return ($url . (defined $section && $section ne '' ? "#$section" : ''));
    }
  }
  return $self->SUPER::resolve_pod_link_by_table($to, $section);
}


# sub do_pod_link {
#   my($self, $link) = @_;
#   if (DEBUG) {
#     print "\nlink tag=",$link->tagname," type=",$link->attr('type'),"\n";
#     print "  to=",$link->attr('to')||'[none]',"\n";
#     print "  section=",$link->attr('section')||'[none]',"\n";
#   }
# 
#   my $to = $link->attr('to') || '';  # undef if internal link
# 
#   return $self->SUPER::do_pod_link($link);
# }