package CPANPLUS::Dist::Slackware::PackageDescription;

use strict;
use warnings;

use English qw( -no_match_vars );

use File::Spec qw();
use File::Temp qw();
use Pod::Find qw();
use Pod::Simple::PullParser qw();
use POSIX qw();
use Text::Wrap qw($columns);

our $VERSION = '0.03';

sub new {
    my ( $class, %attrs ) = @_;
    return bless \%attrs, $class;
}

sub module {
    my $self = shift;
    return $self->{module};
}

sub name {
    my $self = shift;
    return $self->{name} || 'perl-' . $self->module->package_name;
}

sub version {
    my $self = shift;
    return $self->{version} || $self->module->package_version;
}

sub distname {
    my $self = shift;
    return $self->name . q{-} . $self->version;
}

sub build {
    my $self = shift;

    # $ENV{BUILD} is ignored since packages may be built recursively.
    return $self->{build} || 1;
}

sub set_build {
    my ( $self, $build ) = @_;

    return $self->{build} = $build;
}

sub arch {
    my $self = shift;
    my $arch = $self->{arch} || $ENV{ARCH};
    if ( !$arch ) {
        $arch = (POSIX::uname)[4];
        if ( $arch =~ /^i.86$/ ) {
            $arch = 'i486';
        }
        elsif ( $arch =~ /^arm/ ) {
            $arch = 'arm';
        }
    }
    return $arch;
}

sub tag {
    my $self = shift;
    return $self->{tag} || $ENV{TAG} || '_CPANPLUS';
}

sub type {
    my $self = shift;
    return $self->{type} || $ENV{PKGTYPE} || 'tgz';
}

sub filename {
    my $self = shift;
    my $filename
        = $self->distname . q{-}
        . $self->arch . q{-}
        . $self->build
        . $self->tag . q{.}
        . $self->type;
    return $filename;
}

sub outputdir {
    my $self = shift;
    return $self->{outputdir} || $ENV{OUTPUT} || File::Spec->tmpdir;
}

sub outputname {
    my $self       = shift;
    my $outputname = $self->filename;
    my $outputdir  = $self->outputdir;
    if ($outputdir) {
        $outputname = File::Spec->catfile( $outputdir, $outputname );
    }
    return $outputname;
}

sub docdir {
    my $self = shift;
    return $self->{docdir}
        || File::Spec->catfile( '/usr/doc', $self->distname );
}

sub docfiles {
    my $self   = shift;
    my $module = $self->module;

    my $wrksrc = $module->status->extract;
    return if !$wrksrc;

    opendir my $dh, $wrksrc or return;
    my @docfiles = grep {
        m{ ^(?:
                AUTHORS
                | BUGS
                | Change(?:s|Log)
                | COPYING(?:\.(?:LESSER|LIB))?
                | CREDITS
                | FAQ
                | LICEN[CS]E
                | NEWS
                | README(?:\.(?:md|pod))?
                | THANKS
                | TODO
            )$
        }xi && -f File::Spec->catfile( $wrksrc, $_ )
    } readdir $dh;
    closedir $dh;
    return @docfiles;
}

sub _summary_from_pod {
    my $self    = shift;
    my $module  = $self->module;
    my $srcname = $module->module;

    my $wrksrc = $module->status->extract;
    return if !$wrksrc;

    my $summary = q{};
    my @dirs    = (
        map { File::Spec->catdir( $wrksrc, $_ ) }
            qw(blib/lib blib/bin lib bin),
        $wrksrc
    );
    my $podfile = Pod::Find::pod_where( { -dirs => \@dirs }, $srcname );
    if ($podfile) {
        my $parser = Pod::Simple::PullParser->new;
        $parser->set_source($podfile);
        my $title = $parser->get_title;
        if ( $title && $title =~ /^(?:\S+\s+)+?-+\s+(.+)/xs ) {
            $summary = $1;
        }
        else {

            # XXX Try harder to find a summary.
        }
    }
    return $summary;
}

sub _summary_from_meta {
    my $self   = shift;
    my $module = $self->module;

    eval { require Parse::CPAN::Meta } or return;

    my $wrksrc = $module->status->extract;
    return if !$wrksrc;

    my $summary = q{};
    for (qw(META.yml META.json)) {
        my $metafile = File::Spec->catfile( $wrksrc, $_ );
        if ( -f $metafile ) {
            my $distmeta;
            eval { $distmeta = Parse::CPAN::Meta::LoadFile($metafile) }
                or next;
            if (   $distmeta
                && $distmeta->{abstract}
                && $distmeta->{abstract} !~ /unknown/i )
            {
                $summary = $distmeta->{abstract};
                last;
            }
        }
    }
    return $summary;
}

sub summary {
    my $self   = shift;
    my $module = $self->module;

    my $summary 
        = $self->_summary_from_meta
        || $module->description
        || $self->_summary_from_pod
        || q{};
    $summary =~ s/\v+/ /g;    # Replace vertical whitespace.
    return $summary;
}

sub _webpage {
    my $self   = shift;
    my $module = $self->module;
    my $name   = $module->package_name;

    return "https://metacpan.org/release/$name";
}

sub config_function {
    my $self = shift;

    return <<'END_CONFIG';
config() {
    NEW=$1
    OLD=${NEW%.new}
    # If there's no config file by that name, mv it over:
    if [ ! -r "$OLD" ]; then
        mv "$NEW" "$OLD"
    elif [ -f "$NEW" -a -f "$OLD" ]; then
        NEWCKSUM=$(cat "$NEW" | md5sum)
        OLDCKSUM=$(cat "$OLD" | md5sum)
        if [ "$NEWCKSUM" = "$OLDCKSUM" ]; then
            # toss the redundant copy
            rm "$NEW"
        fi
    elif [ -h "$NEW" -a -h "$OLD" ]; then
        NEWLINK=$(readlink -n "$NEW")
        OLDLINK=$(readlink -n "$OLD")
        if [ "$NEWLINK" = "$OLDLINK" ]; then
            # remove the redundant link
            rm "$NEW"
        fi
    fi
    # Otherwise, we leave the .new copy for the admin to consider...
}
END_CONFIG
}

sub _slack_desc_header {
    my ( $self, $indentation_level ) = @_;

    my $tab = q{ } x $indentation_level;

    return <<"END_DESC";
# HOW TO EDIT THIS FILE:
# The "handy ruler" below makes it easier to edit a package description.  Line
# up the first '|' above the ':' following the base package name, and the '|'
# on the right side marks the last column you can put a character in.  You must
# make exactly 11 lines for the formatting to be correct.  It's also
# customary to leave one space after the ':'.

$tab|-----handy-ruler------------------------------------------------------|
END_DESC
}

sub slack_desc {
    my $self = shift;

    my $name    = $self->name;
    my $prefix  = "$name:";
    my $title   = "$prefix $name";
    my $summary = $self->summary;
    my $webpage = $self->_webpage;

    # Format the summary.
    my $tab = "$prefix ";
    $columns = 71 + length $tab;
    my $body = Text::Wrap::wrap( $tab, $tab, $summary );

    my $max_body_line_count = 9;    # 11 - 2

    # How long in lines is the formatted text?
    my $body_line_count = @{ [ $body =~ /^\Q$tab\E/mg ] };
    if ( $body_line_count < $max_body_line_count ) {

        # Add the distribution's webpage if there is enough space left.
        my $link = Text::Wrap::wrap( $tab, $tab,
            "For more info, visit: $webpage" );
        my $link_line_count = @{ [ $link =~ /^\Q$tab\E/mg ] };
        if ( $body_line_count + $link_line_count < $max_body_line_count ) {
            if ( $body_line_count > 0 ) {

                # Insert an empty line between the summary and the link.
                $body .= "\n$prefix\n";
                ++$body_line_count;
            }
            $body .= $link;
            $body_line_count += $link_line_count;
        }

        # Add empty lines if necessary.
        $body .= "\n$prefix" x ( $max_body_line_count - $body_line_count );
    }
    elsif ( $body_line_count > $max_body_line_count ) {

        # Cut the summary if it is too long.
        $body = join "\n",
            ( split /\n/, $body )[ 0 .. $max_body_line_count - 1 ];
    }
    return
          $self->_slack_desc_header( length $name )
        . "$title\n"
        . "$prefix\n"
        . "$body\n";
}

sub build_script {
    my $self    = shift;
    my $module  = $self->module;
    my $name    = $module->package_name;
    my $version = $module->package_version;

    # Quote single quotes.
    $name    =~ s/('+)/'"$1"'/g;
    $version =~ s/('+)/'"$1"'/g;

    return <<"END_SCRIPT";
#!/bin/sh
SRCNAM='$name'
VERSION=\${VERSION:-'$version'}
cpan2dist --format CPANPLUS::Dist::Slackware \$SRCNAM-\$VERSION
END_SCRIPT
}

sub _prereqs {
    my $self   = shift;
    my $module = $self->module;
    my $cb     = $module->parent;

    my @prereqs;
    my $prereq_ref = $module->status->prereqs;
    if ($prereq_ref) {
        for my $srcname ( sort { uc $a cmp uc $b } keys %{$prereq_ref} ) {
            my $modobj = $cb->module_tree($srcname);
            next if !$modobj;
            next if $modobj->package_is_perl_core;

            push @prereqs,
                { srcname => $srcname, version => $prereq_ref->{$srcname} };
        }
    }
    return @prereqs;
}

sub readme_slackware {
    my $self    = shift;
    my $module  = $self->module;
    my $srcname = $module->module;
    my $version = $module->package_version;

    $columns = 78;

    my $title  = "$srcname for Slackware Linux";
    my $line   = q{*} x length $title;
    my $readme = "$title\n$line\n\n";

    my $text = 'This package was created by CPANPLUS::Dist::Slackware'
        . " from the Perl distribution '$srcname' version $version.\n";
    $readme .= Text::Wrap::wrap( q{}, q{}, $text );

    my @prereqs = $self->_prereqs;
    if (@prereqs) {
        $readme
            .= "\n"
            . "Building this package required the following Perl modules:\n"
            . "\n";
        for my $prereq (@prereqs) {
            $readme .= $prereq->{srcname};
            my $prereq_version = $prereq->{version};
            if ( $prereq_version ne '0' ) {
                $readme .= " >= $prereq_version";
            }
            $readme .= "\n";
        }
    }

    return $readme;
}

sub destdir {
    my $self = shift;

    my $module  = $self->module;
    my $cb      = $module->parent;
    my $destdir = $self->{destdir};
    if ( !$destdir ) {
        my $template = 'package-' . $self->name . '-XXXXXXXXXX';
        my $wrkdir   = $ENV{TMP}
            || File::Spec->catdir( File::Spec->tmpdir, 'CPANPLUS' );
        if ( !-d $wrkdir ) {
            $cb->_mkdir( dir => $wrkdir )
                or die "Could not create directory '$wrkdir': $OS_ERROR\n";
        }
        $destdir = File::Temp::tempdir( $template, DIR => $wrkdir );
        $self->{destdir} = $destdir;
    }
    return $destdir;
}

1;
__END__

=head1 NAME

CPANPLUS::Dist::Slackware::PackageDescription - Collect information on a
Slackware compatible package

=head1 VERSION

This documentation refers to C<CPANPLUS::Dist::Slackware::PackageDescription>
version 0.03.

=head1 SYNOPSIS

    use CPANPLUS::Dist::Slackware::PackageDescription;

    $pkgdesc = CPANPLUS::Dist::Slackware::PackageDescription->new(
        module => $modobj,
        tag    => '_MYTAG',
        type   => 'txz'
    );

    $filename = $pkgdesc->filename();
    $summary  = $pkgdesc->summary();
    $desc     = $pkgdesc->slack_desc();
    @docfiles = $pkgdesc->docfiles();

=head1 DESCRIPTION

This module gets information on a yet-to-be-created Slackware compatible
package.  The information is obtained from a C<CPANPLUS::Module> object, the
file system and the environment.  Among other things, the module translates a
Perl distribution's name and version into a package name.  It tries to find a
short summary that describes the distribution.  It can build a F<slack_desc>
description for you.  It finds standard documentation files like F<README> and
F<Changes>.

=head1 SUBROUTINES/METHODS

=over 4

=item B<< CPANPLUS::Dist::Slackware::PackageDescription->new(%attrs) >>

Returns a newly constructed object.

    $pkgdesc = CPANPLUS::Dist::Slackware::PackageDescription->new(
        module => $modobj,
        %attrs
    );

The C<CPANPLUS::Module> object is mandatory.  All other attributes are
optional.

=item B<< $pkgdesc->module >>

Returns the C<CPANPLUS::Module> object that was passed to the constructor.

=item B<< $pkgdesc->name >>

Returns the package name, e.g. "perl-Some-Module".

=item B<< $pkgdesc->version >>

Returns the package version, e.g. "0.01".

=item B<< $pkgdesc->distname >>

Returns the package name and version, e.g. "perl-Some-Module-0.01".

=item B<< $pkgdesc->build >>

Returns the package's build number.  Normally "1".

As packages may be built recursively, C<CPANPLUS::Dist::Slackware>
ignores C<$ENV{BUILD}>.

=item B<< $pkgdesc->set_build >>

Sets the package's build number.

=item B<< $pkgdesc->arch >>

Returns the package architecture.  If unset, either the value of C<$ENV{ARCH}>
or a platform-specific identifier like "i486" is returned.

=item B<< $pkgdesc->tag >>

Returns a tag that is added to the package filename.  Defaults to C<$ENV{TAG}>
or "_CPANPLUS".

=item B<< $pkgdesc->type >>

Returns the package extension.  Defaults to C<$ENV{PKGTYPE}> or "tgz".  Other
possible values are "tbz", "tlz" and "txz".

=item B<< $pkgdesc->filename >>

Returns the package's filename, e.g.
F<perl-Some-Module-0.01-i486-1_CPANPLUS.tgz>.

=item B<< $pkgdesc->outputdir >>

Returns the directory where all created packages are stored.  Defaults to
F<$OUTPUT>, F<$TMPDIR> or F</tmp>.

=item B<< $pkgdesc->outputname >>

Returns the package's full filename, e.g.
F</tmp/perl-Some-Module-0.01-i486-1_CPANPLUS.tgz>.

=item B<< $pkgdesc->docdir >>

Returns the packages's documentation directory, e.g.
F</usr/doc/perl-Some-Module-0.01>.

=item B<< $pkgdesc->docfiles >>

Returns a list of standard documentation files that the distribution contains,
e.g. C<("Changes", "LICENSE, "README")>.  The filenames are relative to the
distribution's top-level directory.

Must be called after the distribution has been extracted.

=item B<< $pkgdesc->summary >>

Returns a description of the distribution's purpose, e.g. "Drop atomic bombs
on Australia".

Must not be called before the distribution has been extracted.  Gives better
results when called after the distribution has been built, i.e. when the
"blib" directory is available.

=item B<< $pkgdesc->config_function >>

Returns a C<config> shell function that can be added to the F<doinst.sh>
script in the package's F<install> directory.

Only the shell function is returned.  You have to add the C<config> function
calls for each configuration file yourself.

=item B<< $pkgdesc->slack_desc >>

Returns a Slackware package description that can be written to the
F<slack-desc> file in the package's F<install> directory.

=item B<< $pkgdesc->build_script >>

Returns a build script that can be written to F<perl-Some-Module.SlackBuild>
in the package's documentation directory.

=item B<< $pkgdesc->readme_slackware >>

Returns the text of a F<README.SLACKWARE> file that can be stored in the
package's documentation directory.  The returned document lists the build
dependencies.  You can add more text to this document, e.g. a list of
configuration files provided by the package.

=item B<< $pkgdesc->destdir >>

Returns the staging directory where the distribution is temporarily installed,
e.g. F</tmp/CPANPLUS/package-perl-Some-Module-01yEr7X43K>.  Defaults to a
package-specific subdirectory in F<$TMP> or F</tmp/CPANPLUS>.

=back

=head1 DIAGNOSTICS

None.

=head1 CONFIGURATION AND ENVIRONMENT

See above and C<CPANPLUS::Dist::Slackware> for supported environment
variables.

=head1 DEPENDENCIES

Requires the modules C<File::Spec>, C<File::Temp>, C<Pod::Find>,
C<Pod::Simple>, C<POSIX>, and C<Text::Wrap>, which are all provided by Perl
5.10.  If available, the module C<Parse::CPAN::Meta> is used.

=head1 INCOMPATIBILITIES

None known.

=head1 SEE ALSO

C<CPANPLUS::Dist::Slackware>

=head1 AUTHOR

Andreas Voegele, C<< <andreas at andreasvoegele.com> >>

=head1 BUGS AND LIMITATIONS

Please report any bugs to C<bug-cpanplus-dist-slackware at rt.cpan.org>, or
through the web interface at L<http://rt.cpan.org/>.

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2012 Andreas Voegele

This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

See http://dev.perl.org/licenses/ for more information.

=cut
