The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#
# This file is part of App-Magpie
#
# This software is copyright (c) 2011 by Jerome Quelin.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use 5.012;
use strict;
use warnings;

package App::Magpie::Action::Old::Module;
# ABSTRACT: module that has a newer version available
$App::Magpie::Action::Old::Module::VERSION = '2.005';
use File::ShareDir::PathClass;
use Moose;
use MooseX::Has::Sugar;
use MooseX::SemiAffordanceAccessor;

use App::Magpie::URPM;


# -- private vars

my $sharedir = File::ShareDir::PathClass->dist_dir( 'App-Magpie' );
my %SKIPMOD = do {
    my $skipfile = $sharedir->file( 'modules.skip' );
    my @skips = $skipfile->slurp;
    my %skip;
    foreach my $skip ( @skips ) {
        next if $skip =~ /^#/;
        chomp $skip;
        my ($module, $version, $reason) = split /\s*;\s*/, $skip;
        $skip{$module} = $version;
    }
    %skip;
};

my %SKIPPKG = do {
    my $skipfile = $sharedir->file( 'packages.skip' );
    my @skips = $skipfile->slurp;
    my %skip;
    foreach my $skip ( @skips ) {
        next if $skip =~ /^#/;
        chomp $skip;
        my ($pkg, $reason) = split /\s*;\s*/, $skip;
        $skip{$pkg} = 1;
    }
    %skip;
};


# -- public attributes


has name     => ( ro, isa => "Str", required );
has oldver   => ( ro, isa => "Str" );
has newver   => ( ro, isa => "Str" );
has is_core  => ( rw, isa => "Bool" );
has packages => ( ro, isa => "ArrayRef", lazy_build, auto_deref );

sub _build_packages {
    my ($self) = @_;
    my $urpm = App::Magpie::URPM->instance;
    my $module = $self->name;
    my %seen;   # to remove packages in both i586 & x86_64 medias
    my @pkgs   =
        grep { ! $seen{ $_->name }++ }
        $urpm->packages_providing( $module );

    my $iscore = scalar( grep { $_->name =~ /^perl(-base)?$/ } @pkgs );
    $self->set_is_core( !!$iscore );
    return [ grep { $_->name !~ /^perl(-base)?$/ } @pkgs ];
}


# -- public methods


sub category {
    my ($self) = @_;
    my @pkgs   = $self->packages;
    my $iscore = $self->is_core;

    if ( exists $SKIPMOD{ $self->name } ) {
        return "ignored" if $SKIPMOD{ $self->name } eq "";
        return "ignored" if $self->newver eq $SKIPMOD{ $self->name };
    }

    if ( $iscore ) {
        return "core"       if scalar(@pkgs) == 0;
        return "strange"    if scalar(@pkgs) >= 2;
        # scalar(@pkgs) == 1;
        return "ignored" if exists $SKIPPKG{ $pkgs[0] };
        return "dual-lifed";
    }

    return "orphan"  if scalar(@pkgs) == 0;
    return "strange" if scalar(@pkgs) >= 2;
    # scalar(@pkgs) == 1;
    return "ignored"    if exists $SKIPPKG{ $pkgs[0]->name };
    return "null"       if $self->oldver == 0 || $self->newver == 0;
    return "nodiff"     if $self->oldver == $self->newver; # cpan can be confused
    return "unparsable" if $self->oldver eq "Unparsable";
    return "normal";
}


__PACKAGE__->meta->make_immutable;
1;

__END__

=pod

=encoding UTF-8

=head1 NAME

App::Magpie::Action::Old::Module - module that has a newer version available

=head1 VERSION

version 2.005

=head1 DESCRIPTION

This class represents an installed Perl module that has a newer version
available on CPAN.

=head1 ATTRIBUTES

=head2 name

The name of the module.

=head2 oldver

The version of the module as currently installed.

=head2 newver

The module version, as available on CPAN.

=head2 packages

The Mageia packages holding the module (there can be more than one).
Core packages (perl and perl-base) are excluded from this list.

=head2 is_core

Whether the module is shipped in a core Perl package.

=head1 METHODS

=head2 category

    my $str = $module->category;

Return the module category:

=over 4

=item * C<core> - one of the core packages (perl, perl-base)

=item * C<dual-lifed> - core package + one other package

=item * C<normal> - plain, non-core regular package

=item * C<orphan> - installed package not shipped by a package
(inherited from mandriva, or not yet submitted)

=item * C<strange> - shipped by more than one non-core package

=item * C<nodiff> - when cpan reports a difference although there isn't

=item * C<null> - when old or new versions are 0.0000

=item * C<unparsable> - current version unparsable

=back

=head1 AUTHOR

Jerome Quelin <jquelin@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Jerome Quelin.

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

=cut