#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use ExtUtils::MakeMaker;
use File::Temp;
use File::Spec;
use Config;
use constant WIN32 => $^O eq 'MSWin32';

our $VERSION = "0.02";

my $index_url = 'http://www.cpan.org/modules/02packages.details.txt.gz';
my $quote = WIN32 ? q/"/ : q/'/;

GetOptions(
    'h|help'  => \my $help,
    'verbose' => \my $verbose,
) or pod2usage();
pod2usage() if $help;

unless ($ENV{HARNESS_ACTIVE}) {
    &main;
    exit;
}

sub main {
    init_tools();

    my $tmpfile = File::Temp->new(UNLINK => 1, SUFFIX => '.gz');
    getstore($index_url, $tmpfile->filename) or die "Cannot getstore file";

    my $fh = zopen($tmpfile) or die "cannot open $tmpfile";
    # skip header part
    while (my $line = <$fh>) {
        last if $line eq "\n";
    }
    # body part
    my %seen;
    while (my $line = <$fh>) {
        my ($pkg, $version, $dist) = split /\s+/, $line;
        next if $dist =~ m{/perl-\.[0-9._]+\.tar\.gz$};
        (my $file = $pkg) =~ s!::!/!g;
        $file = "${file}.pm";
        SCAN_INC: for my $dir (@INC) {
            my $path = "$dir/$file";
            next unless -f $path;
            my $inst_version = MM->parse_version($path);
               $inst_version  =~ s/\s+//; # workaround for Attribute::Params::Validate
            next if $inst_version eq 'undef';
            if ($inst_version ne $version && CPAN::Version->vlt($inst_version, $version)) {
                next if $seen{$dist}++;
                if ($verbose) {
                    printf "%-30s %-7s %-7s %s\n", $pkg, $inst_version, $version, $dist;
                } else {
                    print "$dist\n";
                }
            }
            last SCAN_INC;
        }
    }
}

# taken from cpanminus
sub which {
    my($name) = @_;
    my $exe_ext = $Config{_exe};
    foreach my $dir(File::Spec->path){
        my $fullpath = File::Spec->catfile($dir, $name);
        if (-x $fullpath || -x ($fullpath .= $exe_ext)){
            if ($fullpath =~ /\s/ && $fullpath !~ /^$quote/) {
                $fullpath = "$quote$fullpath$quote"
            }
            return $fullpath;
        }
    }
    return;
}

sub init_tools {
    if (!$ENV{DEBUG_WGET} && eval { require LWP::Simple }) {
        *getstore = sub { LWP::Simple::getstore(@_) == 200 };
    } elsif (my $wget = which 'wget') {
        *getstore = sub {
            my($uri, $path) = @_;
            return file_getstore($uri, $path) if $uri =~ s!^file:/+!/!;
            system($wget, '--quiet', $uri, '-O', $path) == 0;
        };
    } else {
        die "Cannot find LWP::Simple and wget.\n";
    }

    if (!$ENV{DEBUG_ZCAT} && eval { require IO::Zlib }) {
        *zopen = sub {
            IO::Zlib->new($_[0], "rb");
        };
    } elsif (my $zcat = which 'zcat') {
        *zopen = sub {
            my $file = shift;
            open(my $fh, '-|', $zcat, $file)
                or return;
            return $fh;
        };
    } else {
        die "Cannot find IO::Zlib or zcat.\n";
    }
}

### Inline stripped CPAN::Version
# Copyright: Andreas Koenig
package # # hide from pause
    CPAN::Version;

# CPAN::Version::vcmp courtesy Jost Krieger
sub vcmp {
    my($self,$l,$r) = @_;
    no warnings 'numeric';

    return 0 if $l eq $r; # short circuit for quicker success

    for ($l,$r) {
        s/_//g;
    }
    for ($l,$r) {
        next unless tr/.// > 1 || /^v/;
        s/^v?/v/;
        1 while s/\.0+(\d)/.$1/; # remove leading zeroes per group
    }
    if ($l=~/^v/ <=> $r=~/^v/) {
        for ($l,$r) {
            next if /^v/;
            $_ = $self->float2vv($_);
        }
    }
    my $lvstring = "v0";
    my $rvstring = "v0";
    if ($] >= 5.006
     && $l =~ /^v/
     && $r =~ /^v/) {
        $lvstring = $self->vstring($l);
        $rvstring = $self->vstring($r);
    }

    return (
            ($l ne "undef") <=> ($r ne "undef")
            ||
            $lvstring cmp $rvstring
            ||
            $l <=> $r
            ||
            $l cmp $r
    );
}

sub vgt {
    my($self,$l,$r) = @_;
    $self->vcmp($l,$r) > 0;
}

sub vlt {
    my($self,$l,$r) = @_;
    0 + ($self->vcmp($l,$r) < 0);
}

sub vge {
    my($self,$l,$r) = @_;
    $self->vcmp($l,$r) >= 0;
}

sub vle {
    my($self,$l,$r) = @_;
    0 + ($self->vcmp($l,$r) <= 0);
}

sub vstring {
    my($self,$n) = @_;
    $n =~ s/^v// or die "CPAN::Version::vstring() called with invalid arg [$n]";
    pack "U*", split /\./, $n;
}

# vv => visible vstring
sub float2vv {
    my($self,$n) = @_;
    my($rev) = int($n);
    $rev ||= 0;
    my($mantissa) = $n =~ /\.(\d{1,12})/; # limit to 12 digits to limit
                                          # architecture influence
    $mantissa ||= 0;
    $mantissa .= "0" while length($mantissa)%3;
    my $ret = "v" . $rev;
    while ($mantissa) {
        $mantissa =~ s/(\d{1,3})// or
            die "Panic: length>0 but not a digit? mantissa[$mantissa]";
        $ret .= ".".int($1);
    }
    # warn "n[$n]ret[$ret]";
    $ret =~ s/(\.0)+/.0/; # v1.0.0 => v1.0
    $ret;
}

__END__

=head1 NAMES

cpan-outdated - detect outdated CPAN modules in your environment

=head1 SYNOPSIS

    # print list of outdated modules
    % cpan-outdated

    # verbose
    % cpan-outdated --verbose

    # install with cpan
    % cpan-outdated | xargs cpan -i

    # install with cpanm
    % cpan-outdated | xargs cpanm

=head1 DESCRIPTION

This module print list of outdated CPAN modules in your machine.

It's same feature of 'CPAN::Shell->r', but cpan-outdated is so fast and less memory.

This script can integrate with cpanm command.

=head1 DEPENDENCIES

perl 5.8 or later (Actually I believe it works with pre 5.8 too but haven't tested).

=over 4

=item LWP or 'wget' to get a index file over HTTP.

=item IO::Zlib or 'zcat' to decode gziped index file.

=back

=head1 AUTHOR

Tokuhiro Matsuno

=head1 LICENSE

Copyright (C) 2009 Tokuhiro Matsuno.

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

=head1 SEE ALSO

L<CPAN>

=cut
