The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use warnings;
use strict;

use Log::Report   'oodoc';

use Getopt::Long      qw/GetOptions :config gnu_getopt/;
use POSIX             qw/strftime/;
use Cwd               qw/getcwd/;
use File::Slurp       qw/read_file/;
use List::Util        qw/first/;
use File::Copy        qw/move copy/;
use File::Spec        ();
use Test::Pod;

use OODoc             ();

# In any case, we want modules in this dir to prevail over installed
# versions of the module.
my $here    = getcwd;
unshift @INC, $here, "$here/lib";

my $format_pod  = 'pod3';
my $format_html = 'html';
my $tmpdir      = $ENV{TMPDIR}         || '/tmp';

my ($verbose) = (0);
my ($rawdir, $distdir, $license);
my ($workdir, $podtailfn, $pmheadfn, $readmefn, $extends);
my ($firstyear, $email, $website, $skip_links);
my ($html_templates, $html_output, $html_docroot, $html_package);
my ($html_stylesheet);
my ($make_pod, $make_dist, $make_raw, $make_html) = (1, 1, 1, undef);
my ($run_tests) = (1);

Getopt::Long::Configure 'bundling';
GetOptions
 ( 'dist!'         => \$make_dist
 , 'distdir|d=s'   => \$distdir
 , 'email|e=s'     => \$email
 , 'extents|x=s'   => \$extends
 , 'firstyear|y=i' => \$firstyear
 , 'html!'         => \$make_html
 , 'html-docroot=s'   => \$html_docroot
 , 'html-output=s'    => \$html_output
 , 'html-templates=s' => \$html_templates
 , 'html-package=s'   => \$html_package
 , 'html-stylesheet=s'=> \$html_stylesheet
 , 'license|l=s'   => \$license
 , 'pod!'          => \$make_pod
 , 'podtail'       => \$podtailfn
 , 'pmhead'        => \$pmheadfn
 , 'readme'        => \$readmefn
 , 'raw!'          => \$make_raw
 , 'rawdir|r=s'    => \$rawdir
 , 'skip_links=s'  => \$skip_links
 , 'tests|t!'      => \$run_tests
 , 'verbose|v!'    => \$verbose
 , 'website|u=s'   => \$website
 , 'workdir|w=s'   => \$workdir
 ) or error __"stopped";

dispatcher mode => $verbose, 'ALL';

my %licenses = ( artistic => <<__ARTISTIC, gpl => <<__GPL);
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
See F<http://www.perl.com/perl/misc/Artistic.html>
__ARTISTIC
This program 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: F<http://www.gnu.org/licenses/gpl.html>
__GPL

my $ooversion = $OODoc::VERSION || $ENV{OODOC_VERSION};

sub read_makefile($);
sub parse_additional_dists(@);
sub create_pod($$);
sub create_html($$$$);
sub create_dist($$);
sub publish_dist($$);
sub create_raw_dist($$);
sub publish_raw_dist($$);
sub create_html_dist($$);
sub publish_html_dist($$);
sub create_heads_and_tails($);
sub create_readme($$$);
sub create_meta($);
sub skip_links(@);

#
# collect some project info
#

system "perl Makefile.PL"
   and fault "cannot run Makefile.PL for basic information";

my $makefile = read_makefile 'Makefile';

my $project  = $makefile->{DISTNAME};
my $version  = $makefile->{VERSION};
$firstyear ||= $makefile->{FIRST_YEAR};
$rawdir    ||= $makefile->{RAWDIR}  || $ENV{OODIST_RAWDIR}  || '.';
$distdir   ||= $makefile->{DISTDIR} || $ENV{OODIST_DISTDIR} || '.';
$license   ||= $makefile->{LICENSE} || $ENV{OODIST_LICENSE} || 'artistic';
$email     ||= $makefile->{EMAIL};
$website   ||= $makefile->{WEBSITE};
$extends   ||= $makefile->{EXTENDS} || '';;
$podtailfn ||= $makefile->{PODTAIL};
$pmheadfn  ||= $makefile->{PMHEAD};
$html_templates ||= $makefile->{HTML_TEMPLATES} || 'html';
$html_output    ||= $makefile->{HTML_OUTPUT}    || 'public_html';
$html_docroot   ||= $makefile->{HTML_DOCROOT}   || '/';
$html_package   ||= $makefile->{HTML_PACKAGE};
$html_stylesheet||= $makefile->{HTML_STYLESHEET}|| '/oodoc.css';

$make_html = -d $html_templates
   unless defined $make_html;

$workdir   ||= "$tmpdir/$project";
my @extends = split /\:/, $extends;

# make directories absolute, because we will chdir
for($workdir, $rawdir, $distdir, $html_package, $html_templates, @extends)
{  $_ = File::Spec->rel2abs($_, $here);
}

info "*** Producing $project version $version";

my $lictext = $licenses{$license} || '';
if(!$lictext && $license)
{   $lictext = read_file $license
        or fault __"cannot read from licence file {file}", file => $license;
}

###
### Start OODoc
###

push @INC, map {"$_/lib"} @extends;

my $doc  = OODoc->new
 ( distribution => $project
 , version      => $version  # version of whole
 );

#
# Reading all the manual pages
# This could be called more than once to combine different sets of
# manual pages in different formats.
#

info "* Processing files of $project $version";

-d $workdir or mkdir $workdir
    or fault "cannot create {dir}", dir => $workdir;

my ($pmhead, $podtail) = create_heads_and_tails $makefile;

$doc->processFiles
 ( workdir    => $workdir
 , version    => $version      # version on each file
 , notice     => $pmhead
 , skip_links => skip_links($makefile->{SKIP_LINKS}, $skip_links)
 );

parse_additional_dists @extends
   if $make_pod || $make_html;

create_readme $doc, $readmefn, $workdir
   unless defined $readmefn && ! length $readmefn;

create_pod $doc, $podtail
   if $make_pod;

create_html $doc, $html_templates, $html_output, $html_docroot
   if $make_html;

# Dist package

chdir $workdir
   or fault __x"cannot go to my {dir}", dir => $workdir;

#create_meta $doc;

my $temp_distfn = create_dist $distdir, $makefile
   if $make_dist;

if(!$make_dist) { info "* dist not published" }
else            { publish_dist $distdir, $temp_distfn }

# RAW package

chdir $here
   or fault __x"cannot go back to {dir}", dir => $here;

my $temp_rawfn = create_raw_dist $rawdir, $makefile
   if $make_raw;

if(!$make_raw) { info "* test mode: raw not published" }
else           { publish_raw_dist $rawdir, $temp_rawfn }

# HTML package

if($make_html && $html_package)
{   chdir $html_output
        or fault __x"cannot go to produced html in {dir}", dir => $html_output;

    my $temp_htmlfn = create_html_dist $html_package, $makefile;
    publish_html_dist $html_package, $temp_htmlfn;
}
else
{   info "* test mode: html not published";
}

info "* Ready";
exit 0;

#
# Parse additional distributions
#

sub parse_additional_dists(@)
{   my @extras = @_;

    # Read all files which are in other modules, but contain information
    # which is required to produce the pod.

    foreach my $extra (@extras)
    {   info "* Processing files in $extra";
        system "cd $extra && perl Makefile.PL"
            and fault __x"failed to collect from {dist}", dist => $extra;

        my $other = read_makefile "$extra/Makefile";
        my $dist  = $other->{DISTNAME};
        my $distv = $other->{VERSION};
        trace "including files from $dist $distv";

        $doc->processFiles
         ( workdir      => undef
         , source       => $extra
         , select       => qr[^ lib/ .*? \.(pod|pm) $ ]x
         , version      => $distv
         , distribution => $dist
         , skip_links   => skip_links($other->{SKIP_LINKS}, $skip_links)
         );
    }

    info "* Preparation phase";
    $doc->prepare;
}

#
# Create pods
#

sub create_pod($$)
{   my ($doc, $podtail) = @_;

    info "* Creating POD files";

    $doc->create
      ( $format_pod
      , workdir => $workdir
      , select  => sub {my $manual = shift; $manual->distribution eq $project}
      , append  => $podtail
      );
}

#
# Create html
#

sub create_html($$$$)
{   my ($doc, $templates, $output, $url) = @_;

    info "* Creating HTML files in $output";

    $doc->create
     ( $format_html
     , workdir          => $output
     , format_options   => 
        [ html_root       => $url
        , html_stylesheet => $html_stylesheet
        ]
     , manual_format    => []
     , manual_templates => "$templates/manual"
     , other_templates  => "$templates/other"
     );
}

sub create_heads_and_tails($)
{   my $makefile = shift;
    my $today    = strftime "%B %d, %Y", localtime;
    my $year     = strftime "%Y", localtime;

    if($firstyear)
    {   $year = $firstyear =~ m/$year$/ ? $firstyear
              : $firstyear =~ m/\D$/    ? $firstyear.$year
              : "$firstyear-$year";
    }

    my $changelog = first { m/^(?:change|contrib)/i } glob '*';

    my $contrib   = $changelog ? <<__CONTRIB : '';
 For other contributors see $changelog.
__CONTRIB

    my $web       = $website ? " Website: F<$website>" : '';
    my $author    = $makefile->{AUTHOR} ? " by $makefile->{AUTHOR}" : '';

    my $pmheadsrc
     = defined $pmheadfn  ? read_file $pmheadfn
     : -f 'PMHEAD.txt'    ? read_file 'PMHEAD.txt'
     :                      <<'__PM_HEAD';
Copyrights $year$author.
${contrib}See the manual pages for details on the licensing terms.
Pod stripped from pm file by OODoc $ooversion.
__PM_HEAD

    my $podtailsrc
     = defined $podtailfn ? read_file $podtailfn
     : -f 'PODTAIL.txt'   ? read_file 'PODTAIL.txt'
     :                      <<'__POD_TAIL';

=head1 SEE ALSO

This module is part of $project distribution version $version,
built on $today.$web

=head1 LICENSE

Copyrights $year$author.$contrib

$lictext

__POD_TAIL

   my $pmhead  = eval qq{"$pmheadsrc"};
   error __x"pmhead: {err}", err => $@ if $@;

   my $podtail = eval qq{"$podtailsrc"};
   error __x"podtail: {err}", err => $@ if $@;

   ($pmhead, $podtail);
}

sub create_readme($$$)
{   my ($doc, $readmefn, $workdir) = @_;
    my @toplevel = glob "$workdir/*";

    my $readme   = first { /\breadme$/i } @toplevel;
    return 1 if $readme;

    info "adding README";

    my $manifest = first { /\bmanifest$/i } @toplevel;
    open MANIFEST, '>>', $manifest
        or fault __x"cannot append to {file}", file => $manifest;
    print MANIFEST "README\n";
    close MANIFEST;

    $readme      = File::Spec->catfile($workdir, 'README');

    if($readmefn)
    {   # user provided README
        info "copying $readmefn as README\n";

        copy $readmefn, $readme
            or fault __x"cannot copy {from} to {to}"
              , from => $readmefn, to => $readme;

        return 1;
    }

    #
    # Produce a README text
    #

    open README, '>', $readme
        or fault __x"cannot write to {file}", file => $readme;

    my $date = localtime;

    print README <<__README;
=== README for $project version $version
=   Generated on $date by OODoc $ooversion

There are various ways to install this module:

 (1) if you have a command-line, you can do:
       perl -MCPAN -e 'install <any package from this distribution>'

 (2) if you use Windows, have a look at http://ppm.activestate.com/

 (3) if you have downloaded this module manually (as root/administrator)
       gzip -d $project-$version.tar.gz
       tar -xf $project-$version.tar
       cd $project-$version
       perl Makefile.PL
       make          # optional
       make test     # optional
       make install

For usage, see the included manual-pages or
    http://search.cpan.org/dist/$project-$version/

Please report problems to
    http://rt.cpan.org/Dist/Display.html?Queue=$project

__README

    close README;
    1;
}

# Since ExtUtils::MakeMaker, the META files only get updated when
# they already exist.
sub create_meta($)
{   my ($doc) = @_;
    my $manifest = first { /\bmanifest$/i } glob "*";
    $manifest or panic "No manifest";

    foreach my $fn ('META.yml', 'META.json')
    {  next if -f $fn;
       info "adding $fn";
       open META, '>>', $fn and close META;

       open MANIFEST, '>>', $manifest
           or fault __x"cannot append to {file}", file => $manifest;
       print MANIFEST "$fn\n";
       close MANIFEST;
    }
}

#
# Create a distribution
#

sub create_dist($$)
{   my ($dest, $makefile) = @_;

    info "* Preparing test";
    system "perl Makefile.PL"
        and fault __x"perl Makefile.PL in {dir} failed", dir => $workdir;

    system "make clean >/dev/null"
        and fault __x"make clean in {dir} failed", dir => $workdir;

    move 'Makefile.old', 'Makefile'
        or fault __x"cannot reinstate Makefile in {dir}", dir => $workdir;

    info "* Running make";
    system "make distdir >/dev/null"
       and fault __x"make in {dir} failed", dir => $workdir;

    if($run_tests)
    {   foreach my $testdir qw(t tests xt)
        {   -d $testdir or next;

            info "* Running tests in $testdir";
            system "make test TEST_FILES=$testdir/*.t"
                and fault __x"make test in {dir} failed", dir => $testdir;
        }
    }
    else
    {   info "* Release testing skipped";
    }

    my $distfile = $makefile->{DISTVNAME}. '.tar.gz';
    info "* Building distribution in $distfile";
    unlink $distfile;

    system "make dist >/dev/null"
        and fault __x"make dist in {dir} failed", dir => $workdir;

    $distfile;
}

sub publish_dist($$)
{   my ($dest, $distfile) = @_;
    return if $dest eq $workdir;

    print "Distributed package in $dest/$distfile\n";

    -f $distfile
        or error __x"cannot find produced {file}", file => $distfile;

    -d $dest or mkdir $dest
        or fault __x"cannot create {dir}", dir => $dest;

    move $distfile, $dest
        or fault __x"cannot move {from} to {to}", from => $distfile, to=>$dest;
}

#
# RAW
#

sub create_raw_dist($$)
{   my ($dest, $makefile) = @_;

    my $rawname = $makefile->{DISTVNAME}.'-raw';
    my $rawfile = $rawname. '.tar.gz';
    info "* Building raw package $rawfile";
    
    unlink $rawfile;
    
    my %manifests;
    foreach my $man (glob "MANIFEST*")
    {   foreach (read_file $man)
        {  s/\s{3,}.*$//;
           next if m/^#/;
           next unless length;
           chomp;
           $manifests{$_}++;
        }
    }
    
    my @manifests = map { "$rawname/$_" } sort keys %manifests;
    symlink('.', $rawname) || readlink $rawname eq '.'
        or fault __x"cannot create temp symlink {name}", name => $rawname;

    local $" = ' ';
    system "tar czf $rawfile @manifests"
        and fault __x"cannot produce {file} with tar", file => $rawfile;

    unlink $rawname;
    $rawfile;
}

sub publish_raw_dist($$)
{   my ($dest, $rawfile) = @_;
    return if $dest eq $html_output;

    -d $dest or mkdir $dest
        or fault __x"cannot create {dir}", dir => $dest;

    print "Raw package to $dest/$rawfile\n";

    move $rawfile, $dest
        or fault __x"cannot move {from} to {to}", from => $rawfile, to => $dest;
}

#
# HTMLPKG
#

sub create_html_dist($$)
{   my ($dest, $makefile) = @_;

    my $htmlfile = $makefile->{DISTVNAME}.'-html.tar.gz';
    info "* Building html package $htmlfile";

    unlink $htmlfile;

    local $" = ' ';
    system "tar czf $htmlfile *"
        and fault __x"cannot produce {file} with tar", file => $htmlfile;

    $htmlfile;
}

sub publish_html_dist($$)
{   my ($dest, $htmlfile) = @_;

    return if $dest eq $html_output;

    -d $dest or mkdir($dest)
        or fault __x"cannot create {dir}", dir => $dest;

    info "* HTML package to $dest/$htmlfile";

    move $htmlfile, $dest
        or fault __x"cannot move {from} to {to}", from => $htmlfile, to=>$dest;
}

#
# read_makefile MAKEFILE
# Collect values of variable defined in the specified MAKEFILE, which was
# produced by "perl Makefile.PL"
#

sub read_makefile($)
{   my $makefile = shift;

    open MAKEFILE, '<', $makefile
       or fault __x"cannot open produced Makefile: {file}", file => $makefile;

    my %makefile;
    while( <MAKEFILE> )
    {   $_ .= <MAKEFILE> while !eof MAKEFILE && s/\\$//; # continuations
        s/\n\t*/ /g;

        $makefile{$1} = $2 if m/^([A-Z_][A-Z\d_]+)\s*\=\s*(.*?)\s*$/;

        if(m/^#\s+([A-Z_][A-Z\d_]+)\s*\=>\s*(.*?)\s*$/)
        {   # important information which ended-up in comments ;(
            my ($key, $v) = ($1, $2);
            $v =~ s/q\[([^\]]*)\]/$1/g;  # remove q[]
            $makefile{$key} = $v;
        }
    }

    close MAKEFILE;
    \%makefile;
}

#
# skip_links STRINGS
# Split list of package names to avoid
#

sub skip_links(@)
{   my @links = map { defined $_ ? split(/[\, ]/, $_) : () } @_;
    \@links;
}
    
__END__

=head1 NAME

oodist - create perl distributions with OODoc

=head1 SYNOPSIS

 cd <src>
 oodist [OPTIONS]
   OPTION:                 DEFAULT:
   --pod   or --nopod        produce pod: yes
   --dist  or --nodist       package distribution: yes
   --html  or --nohtml       produce html: yes if templates
   --raw   or --noraw        produce package with raw files: yes
   --tests or --notests      run tests before packaging: yes

  OPTIONS general:
   --distdir  | -d <dir>     makefile:DISTDIR || $ENV{OODOC_DISTDIR} || <src>
   --extends  | -x <path>    empty
   --project  | -p <string>  makefile:DISTNAME
   --rawdir   | -r <dir>     makefile:RAWDIR  || $ENV{OODOC_RAWDIR} || <src>
   --readme        <file>    constructured
   --workdir  | -w <dir>     /tmp/<DISTVNAME>
   --verbose  | -v           true when specified

  OPTIONS for parsers:
   --skip_links <string>     makefile:SKIP_LINKS

  OPTIONS for POD:
   --email    | -e <email>   makefile:EMAIL
   --firstyear| -y <year>    makefile:FIRST_YEAR
   --license  | -l <string>  makefile:LICENSE || $ENV{OODOC_LICENSE} || 'artistic'
   --pmhead   | -h <file>    makefile:PMHEAD  || 'PMHEAD.txt'  || constructed
   --podtail  | -t <file>    makefile:PODTAIL || 'PODTAIL.txt' || constructed
   --website  | -u <url>     makefile:WEBSITE

  OPTIONS for HTML:
   --html-templates <dir>    makefile:HTML_TEMPLATES || 'html'
   --html-output <dir>       makefile:HTML_OUTPUT    || 'public_html'
   --html-docroot <url>      makefile:HTML_DOCROOT   || '/'
   --html-package <dir>      makefile:HTML_PACKAGE

=head1 DESCRIPTION

The C<oodist> script is currently only usable on UNIX in combination
with Makefile.PL.  It is a smart wrapper around the OODoc module,
to avoid start work to produce real POD for modules which use OODoc's
POD extensions.  HTML is not (yet) supported.

=head2 Configuring

All OPTIONS can be specified on the command-line, but you do not want
to specify them explicitly each time you produce a new distribution for
your product.  The options come in two kinds: those which are environment
independent and those which are.  The first group can be set via the
Makefile.PL, the second can be set using environment variables as well.

Example: add to the end of your C<Makefile.PL>

 sub MY::postamble { <<'__POSTAMBLE' }
 FIRST_YEAR   = 2001
 WEBSITE      = http://perl.overmeer.net/oodoc
 EMAIL        = oodoc@overmeer.net
 __POSTAMBLE

=head2 Main options

The process is controlled by four main options.  All options are by
default C<on>.

=over 4

=item --pod or --nopod

Produce pod files in the working directory and in the distribution.

=item --dist or --nodist

Create a distribution, containing all files from the MANIFEST plus
produced files.
Even with C<nodist>, you will end-up with these archives in the
working directory (see C<--workdir>).

=item --html or --nohtml

Create html manual pages.  The C<--html-templates> options must
point to an existing directory (defaults to the C<html/> sub-directory).

=item --raw  or --noraw

Create a package which contains the files which are needed to produce
the distribution: the pm files still including the oodoc markup.

=back

=head2 General options

The other OPTIONS in detail

=over 4

=item --readme <filename>

Copy the specified README file into the distribution, if there is no
README yet.  The name will be added to the MANIFEST.  If the option
is not specified, a simple file will be created.  If this option is
specified, but the filename is empty, then the README will not be
produced.

=item --distdir  | -d <dir>

The location where the final file to be distributed is placed, by default
in the source directory.

=item --extends  | -x <path>

A colon seperated list of directories which contains "raw oodoc" pm and
pod files which are (in some cases) used to provide data for base-classes
of this module.

=item --rawdir   | --r <dir>

The location where a I<raw> version of the distribution is made.  The
normal distribution contains expanded POD and stripped PM files.  For that
reason, you can not use it a backup for your files.  If you have co-workers
on the module, you may wish to give them the originals.

=item --verbose  | --v

Shows what happens during the process.

=item --workdir  | -w <dir>

The processing will take place in a seperate directory: the stripped pm's
and produced pod files will end-up there.

If not provided, that directory will be named after the project, and
located in C<$ENV{TMPDIR}>, which defaults to C</tmp>.  For instance
C</tmp/OODoc/>

=back

=head2 Options for parsers

=over 4

=item --skip_links <strings>

A blank or comma separated list of packages which will have a manual
page, but cannot be loaded under their name.  Sub-packages are excluded
as well.  For instance, XML::LibXML has many manual-pages without
a package with the same name.

=back

=head2 Options to produce POD

=over 4

=item --email    | -e <email>

The email address which can be used to contact the authors.  Used in the
automatic podtail.

=item --firstyear| -y <string>

The first year that a release for this software was made.  Used in the
automatic podtail.  The specified string can be more complex than a
simple year, for instance C<1998-2000,2003>.  The last year will be
automatically added like C<-2006>, which results in C<1998-2000,2003-2006>.
When the current year is detected at the end of the string, the year will
not be added again.

=item --license  | -l ['gpl'|'artistic'|filename]

The lisense option is a special case: it can contain either the
strings C<gpl> or C<artistic>, or a filename which is used to
read the actual license text from.  The default is C<artistic>

=item --pmhead

Each of the stripped C<pm> files will have content of the file
added at the top.  Each line will get a comment '# ' marker before
it.  If not specified, a short notice will be produced automatically.

Implicitly, if a file C<PMHEAD.txt> exists, that will be used.
variables found in the text will be filled-in.

=item --podtail

Normally, a trailing text is automatically produced, based on all kinds
of facts.  However, you can specify your own file. If exists, the content
is read from a file named C<PODTAIL.txt>.

After reading the file, variables will be filled in: scalars like
C<$version>, C<$project>, C<$website> etc are to your disposal.

=item --website  | -u <url>

Where the HTML documentation related to this module is publicly visible.

=back

=head2 Options to produce HTML

=over 4

=item --html-docroot <url>
This (usually relative) URL is prepended to all absolute links in the
HTML output.

=item --html-output <dir>
The directory where the produced HTML pages are written to.

=item --html-templates <dir>
The directory which contains the templates for HTML pages which are used
to construct the html version of the manual-pages. The html2 backend
accepts a colon separated list of directories.

=item --html-package <dir>
When specified, the html-output directory will get packaged into a
a tar achive in this specified directory.

=item --html_stylesheet <file>
Where to find the stylesheet which should be used to display the
produced HTML. A copy of the stylesheet will be made and put in the
top-level of the HTML directory.

=back