# Copyrights 2003-2011 by Mark Overmeer.
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 1.06.

package OODoc;
use vars '$VERSION';
$VERSION = '1.06';

use base 'OODoc::Object';

use strict;
use warnings;

use OODoc::Manifest;

use Carp;
use File::Copy;
use File::Spec;
use File::Basename;
use IO::File;
use List::Util 'first';


#-------------------------------------------


sub init($)
{   my ($self, $args) = @_;

    $self->SUPER::init($args) or return;

    $self->{O_pkg}    = {};

    my $distribution  = $self->{O_distribution} = delete $args->{distribution};
    croak "ERROR: the produced distribution needs a project description"
        unless defined $distribution;

    $self->{O_project} = delete $args->{project} || $distribution;

    my $version        = delete $args->{version};
    unless(defined $version)
    {   my $fn         = -f 'version' ? 'version'
                       : -f 'VERSION' ? 'VERSION'
                       : undef;
        if(defined $fn)
        {   my $v = IO::File->new($fn, 'r')
               or die "ERROR: Cannot read version from file $fn: $!\n";
            $version = $v->getline;
            $version = $1 if $version =~ m/(\d+\.[\d\.]+)/;
            chomp $version;
        }
    }

    croak "ERROR: no version specified for distribution \"$distribution\""
        unless defined $version;

    $self->{O_version} = $version;
    $self->{O_verbose} = delete $args->{verbose} || 0;
    $self;
}

#-------------------------------------------


sub distribution() {shift->{O_distribution}}


sub version() {shift->{O_version}}


sub project() {shift->{O_project}}

#-------------------------------------------


sub selectFiles($@)
{   my ($self, $files) = (shift, shift);

    my $select
      = ref $files eq 'Regexp' ? sub { $_[0] =~ $files }
      : ref $files eq 'CODE'   ? $files
      : ref $files eq 'ARRAY'  ? $files
      : croak "ERROR: use regex, code reference or array for file selection";

    return ($select, []) if ref $select eq 'ARRAY';

    my (@process, @copy);
    foreach my $fn (@_)
    {   if($select->($fn)) {push @process, $fn}
        else               {push @copy,    $fn}
    }

    ( \@process, \@copy );
}


sub processFiles(@)
{   my ($self, %args) = @_;
    my $verbose = defined $args{verbose} ? $args{verbose} : $self->{O_verbose};

    croak "ERROR: requires a directory to write the distribution to"
       unless exists $args{workdir};

    my $dest    = $args{workdir};
    my $source  = $args{source};
    my $distr   = $args{distribution} || $self->distribution;

    my $version = $args{version};
    unless(defined $version)
    {   my $fn  = defined $source ? File::Spec->catfile($source, 'version')
                :                   'version';
        $fn     = -f $fn          ? $fn
                : defined $source ? File::Spec->catfile($source, 'VERSION')
                :                   'VERSION';
        if(defined $fn)
        {   my $v = IO::File->new($fn, "r")
                or die "ERROR: Cannot read version from $fn: $!";
            $version = $v->getline;
            $version = $1 if $version =~ m/(\d+\.[\d\.]+)/;
            chomp $version;
        }
        elsif($version = $self->version) { ; }
        else
        {   die "ERROR: there is no version defined for the source files.\n";
        }
    }

    my $notice = '';
    if($notice = $args{notice})
    {   $notice =~ s/^(\#\s)?/# /mg;       # put comments if none
    }

    #
    # Split the set of files into those who do need special processing
    # and those who do not.
    #

    my $manfile
      = exists $args{manifest} ? $args{manifest}
      : defined $source        ? File::Spec->catfile($source, 'MANIFEST')
      :                          'MANIFEST';

    my $manifest = OODoc::Manifest->new(filename => $manfile);

    my $manout;
    if(defined $dest)
    {   my $manif = File::Spec->catfile($dest, 'MANIFEST');
        $manout   = OODoc::Manifest->new(filename => $manif);
        $manout->add($manif);
    }
    else
    {   $manout   = OODoc::Manifest->new(filename => undef);
    }

    my $select    = $args{select} || qr/\.(pm|pod)$/;
    my ($process, $copy) = $self->selectFiles($select, @$manifest);

    print @$process. " files to process and ".@$copy." files to copy\n"
       if $verbose > 1;

    #
    # Copy all the files which do not contain pseudo doc
    #

    if(defined $dest)
    {   foreach my $filename (@$copy)
        {   my $fn = defined $source ? File::Spec->catfile($source, $filename)
                   :                   $filename;

            my $dn = File::Spec->catfile($dest, $fn);
            carp "WARNING: no file $fn to include in the distribution", next
               unless -f $fn;

            unless(-e $dn && ( -M $dn < -M $fn ) && ( -s $dn == -s $fn ))
            {   $self->mkdirhier(dirname $dn);

                copy $fn, $dn
                   or die "ERROR: cannot copy distribution file $fn to $dest: $!\n";

                print "Copied $fn to $dest\n" if $verbose > 2;
            }

            $manout->add($dn);
        }
    }

    #
    # Create the parser
    #

    my $parser = $args{parser} || 'OODoc::Parser::Markov';
    my $skip_links = delete $args{skip_links};

    unless(ref $parser)
    {   eval "require $parser";
        croak "ERROR: Cannot compile $parser class:\n$@"
           if $@;

        $parser = $parser->new(skip_links => $skip_links)
           or croak "ERROR: Parser $parser could not be instantiated";
    }

    #
    # Now process the rest
    #

    foreach my $filename (@$process)
    {   my $fn = $source ? File::Spec->catfile($source, $filename) : $filename; 

        carp "WARNING: no file $fn to include in the distribution", next
            unless -f $fn;

        my $dn;
        if($dest)
        {   $dn = File::Spec->catfile($dest, $fn);
            $self->mkdirhier(dirname $dn);
            $manout->add($dn);
        }

        # do the stripping
        my @manuals = $parser->parse
          ( input        => $fn
          , output       => $dn
          , distribution => $distr
          , version      => $version
          , notice       => $notice
          );

        if($verbose > 2)
        {   print "Stripped $fn into $dn\n" if defined $dn;
            print $_->stats foreach @manuals;
        }

        foreach my $man (@manuals)
        {   $self->addManual($man) if $man->chapters;
        }
    }

    #
    # Some general subtotals
    #

    print $self->stats if $verbose > 1;
    $self;
}

#-------------------------------------------


sub prepare(@)
{   my ($self, %args) = @_;
    my $verbose = defined $args{verbose} ? $args{verbose} : $self->{O_verbose};

    print "Collect package relations.\n" if $verbose >1;
    $self->getPackageRelations($verbose);

    print "Expand manual contents.\n" if $verbose >1;
    foreach my $manual ($self->manuals)
    {   print "  expand manual $manual\n" if $verbose > 1;
        $manual->expand;
    }

    print "Create inheritance chapter.\n" if $verbose >1;
    foreach my $manual ($self->manuals)
    {   $manual->createInheritance;
    }

    $self;
}


sub getPackageRelations($)
{   my ($self, $verbose) = @_;
    my @manuals  = $self->manuals;  # all

    #
    # load all distributions (which are not loaded yet)
    #

    print "Compile all packages\n" if $verbose;

    foreach my $manual (@manuals)
    {    next if $manual->isPurePod;
         print "  require package $manual\n" if $verbose > 1;

         eval "require $manual";
         warn "WARNING: errors from $manual; $@\n"
            if $@ && $@ !~ /can't locate/i && $@ !~ /attempt to reload/i;
    }

    print "Detect inheritance relationships\n" if $verbose;

    foreach my $manual (@manuals)
    {
         print "  relations for $manual\n" if $verbose > 1;

        if($manual->name ne $manual->package)  # autoloaded code
        {   my $main = $self->mainManual("$manual");
            $main->extraCode($manual) if defined $main;
            next;
        }
        my %uses = $manual->collectPackageRelations;

        foreach (defined $uses{isa} ? @{$uses{isa}} : ())
        {   my $isa = $self->mainManual($_) || $_;

            $manual->superClasses($isa);
            $isa->subClasses($manual) if ref $isa;
        }

        if(my $realizes = $uses{realizes})
        {   my $to  = $self->mainManual($realizes) || $realizes;

            $manual->realizes($to);
            $to->realizers($manual) if ref $to;
        }
    }

    $self;
}

#-------------------------------------------


our %formatters =
 ( pod  => 'OODoc::Format::Pod'
 , pod2 => 'OODoc::Format::Pod2'
 , pod3 => 'OODoc::Format::Pod3'
 , html => 'OODoc::Format::Html'
 );

sub create($@)
{   my ($self, $format, %args) = @_;
    my $verbose = defined $args{verbose} ? $args{verbose} : $self->{O_verbose};

    my $dest    = $args{workdir}
       or croak "ERROR: requires a directory to write the manuals to";

    #
    # Start manifest
    #

    my $manfile  = exists $args{manifest} ? $args{manifest}
                 : File::Spec->catfile($dest, 'MANIFEST');
    my $manifest = OODoc::Manifest->new(filename => $manfile);

    # Create the formatter

    unless(ref $format)
    {   $format = $formatters{$format} if exists $formatters{$format};

        eval "require $format";
        die "ERROR: formatter $format has compilation errors: $@" if $@;

        my $options    = delete $args{format_options} || [];

        $format = $format->new
          ( manifest    => $manifest
          , workdir     => $dest
          , project     => $self->distribution
          , version     => $self->version
          , @$options
          );
    }

    #
    # Create the manual pages
    #

    my $select = ! defined $args{select}     ? sub {1}
               : ref $args{select} eq 'CODE' ? $args{select}
               :                        sub { $_[0]->name =~ $args{select}};

    foreach my $package (sort $self->packageNames)
    {
        foreach my $manual ($self->manualsForPackage($package))
        {   next unless $select->($manual);

            unless($manual->chapters)
            {   print "Skipping $manual: no chapters\n" if $verbose > 1;
                next;
            }

            print "  creating manual $manual with ",ref($format), "\n"
                if $verbose > 1;

            $format->createManual
             ( manual         => $manual
             , template       => $args{manual_template}
             , append         => $args{append}
             , format_options => ($args{manual_format} || [])
             );
        }
    }

    #
    # Create other pages
    #

    print "Creating other pages\n" if $verbose > 1;
    $format->createOtherPages
     ( source   => $args{other_files}
     , process  => $args{process_files}
     );

    $format;
}


sub stats()
{   my $self = shift;
    my @manuals  = $self->manuals;
    my $manuals  = @manuals;
    my $realpkg  = $self->packageNames;

    my $subs     = map {$_->subroutines} @manuals;
    my @options  = map { map {$_->options} $_->subroutines } @manuals;
    my $options  = @options;
    my $examples = map {$_->examples}    @manuals;

    my $diags    = map {$_->diagnostics} @manuals;
    my $distribution   = $self->distribution;
    my $version  = $self->version;

    <<STATS;
$distribution version $version
  Number of package manuals: $manuals
  Real number of packages:   $realpkg
  documented subroutines:    $subs
  documented options:        $options
  documented diagnostics:    $diags
  shown examples:            $examples
STATS
}

#-------------------------------------------


1;