#
# 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.020;
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.009';
use List::AllUtils qw{ each_array };
use Moose;
use MooseX::Has::Sugar;
use MooseX::SemiAffordanceAccessor;
use App::Magpie::Constants qw{ $SHAREDIR };
use App::Magpie::URPM;
# -- private vars
my (@SKIP_MOD_NAME, @SKIP_MOD_VERSION);
{
my $skipfile = $SHAREDIR->child( 'modules.skip' );
my @skips = $skipfile->lines;
foreach my $skip ( @skips ) {
next if $skip =~ /^#/;
chomp $skip;
my ($module, $version, $reason) = split /\s*;\s*/, $skip;
$version ||= ".*"; # no version: all versions are skipped
push @SKIP_MOD_NAME, qr/^$module$/;
push @SKIP_MOD_VERSION, qr/^$version$/;
}
}
my %SKIPPKG = do {
my $skipfile = $SHAREDIR->child( 'packages.skip' );
my @skips = $skipfile->lines;
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;
return "ignored" if $self->is_ignored;
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_old" if $self->oldver eq "0" || $self->oldver eq "undef";
return "null_new" if $self->newver eq "0" || $self->newver eq "undef";
return "nodiff" if $self->oldver eq $self->newver; # cpan can be confused
return "unparsable" if $self->oldver eq "Unparsable";
return "normal";
}
sub is_ignored {
my $self = shift;
# check if module is ignored, regex comparison
my $it = each_array @SKIP_MOD_NAME, @SKIP_MOD_VERSION;
while ( my ($mod, $ver) = $it->() ) {
return 1 if $self->name =~ $mod && $self->newver =~ $ver;
}
return 0;
}
__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.009
=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
=head2 is_ignored
my $bool = $module->is_ignored;
Return true if C<$module> is ignored due to its presence in
F<SHAREDIR/modules.skip>. Note that it will not match against
F<SHAREDIR/packages.skip>.
=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