imported initial version of youri svn

23 files changed, 2800 insertions, 0 deletions

diff --git a/lib/Youri/Check/Input/Age.pm b/lib/Youri/Check/Input/Age.pm
new file mode 100644
index 0000000..1b80d62
--- /dev/null
+++ b/lib/Youri/Check/Input/Age.pm
@@ -0,0 +1,110 @@
+# $Id: Age.pm 885 2006-04-17 22:25:00Z guillomovitch $
+package Youri::Check::Input::Age;
+
+=head1 NAME
+
+Youri::Check::Input::Age - Check maximum age
+
+=head1 DESCRIPTION
+
+This plugin checks packages age, and report the ones exceeding maximum limit.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use DateTime;
+use DateTime::Format::Duration;
+use base 'Youri::Check::Input';
+
+sub columns {
+    return qw/
+        arch
+        buildtime
+    /;
+}
+
+sub links {
+    return qw//;
+}
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Age object.
+
+Specific parameters:
+
+=over
+
+=item max_age $age
+
+Maximum age allowed (default: 1 year)
+
+=item pattern $pattern
+
+Pattern used to describe age (default: %Y year)
+
+=back
+
+=cut
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        max_age => '1 year',
+        pattern => '%Y year',
+        @_
+    );
+
+    $self->{_format} = DateTime::Format::Duration->new(
+        pattern => $options{pattern}
+    );
+
+    $self->{_now} = DateTime->from_epoch(
+        epoch => time()
+    );
+
+    $self->{_max_age} = $options{max_age};
+}
+
+sub run {
+    my ($self, $media, $resultset) = @_;
+    croak "Not a class method" unless ref $self;
+
+    my $max_age_string = $media->max_age() ?
+        $media->max_age() :
+        $self->{_max_age};
+
+    my $max_age = $self->{_format}->parse_duration($max_age_string);
+
+    my $check = sub {
+        my ($package) = @_;
+
+        my $buildtime = DateTime->from_epoch(
+            epoch => $package->get_age()
+        );
+        
+        my $age = $self->{_now}->subtract_datetime($buildtime);
+
+        if (DateTime::Duration->compare($age, $max_age) > 0) {
+            my $date = $buildtime->strftime("%a %d %b %G");
+
+            $resultset->add_result($self->{_id}, $media, $package, {
+                arch      => $package->get_arch(),
+                buildtime => $date
+            });
+        }
+    };
+    $media->traverse_headers($check);
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Build.pm b/lib/Youri/Check/Input/Build.pm
new file mode 100644
index 0000000..fc93af8
--- /dev/null
+++ b/lib/Youri/Check/Input/Build.pm
@@ -0,0 +1,128 @@
+# $Id: Build.pm 885 2006-04-17 22:25:00Z guillomovitch $
+package Youri::Check::Input::Build;
+
+=head1 NAME
+
+Youri::Check::Input::Build - Check build outputs
+
+=head1 DESCRIPTION
+
+This plugin checks build outputs of packages, and report failures. Additional
+source plugins handle specific sources.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use Youri::Utils;
+use base 'Youri::Check::Input';
+
+sub columns {
+    return qw/
+        arch
+        bot
+        status
+    /;
+}
+
+sub links {
+    return qw/
+        status url
+    /;
+}
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Build object.
+
+Specific parameters:
+
+=over
+
+=item sources $sources
+
+Hash of source plugins definitions
+
+=back
+
+=cut
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        sources => undef,
+        @_
+    );
+
+    croak "No source defined" unless $options{sources};
+    croak "sources should be an hashref" unless ref $options{sources} eq 'HASH';
+
+    foreach my $id (keys %{$options{sources}}) {
+        print "Creating source $id\n" if $options{verbose};
+        eval {
+            push(
+            @{$self->{_sources}},
+            create_instance(
+                    'Youri::Check::Input::Build::Source',
+                    id        => $id,
+                    test      => $options{test},
+                    verbose   => $options{verbose},
+                    %{$options{sources}->{$id}}
+                )
+            );
+            # register monitored archs
+            $self->{_archs}->{$_}->{$id} = 1
+                foreach @{$options{sources}->{$id}->{archs}};
+        };
+        print STDERR "Failed to create source $id: $@\n" if $@;
+    }
+
+    croak "no sources created" unless @{$self->{_sources}};
+}
+
+sub run {
+    my ($self, $media, $resultset) = @_;
+    croak "Not a class method" unless ref $self;
+
+    # this is a source media check only
+    return unless $media->get_type() eq 'source';
+
+    my $callback = sub {
+        my ($package) = @_;
+
+        my $name    = $package->get_name();
+        my $version = $package->get_version();
+        my $release = $package->get_release();
+
+        foreach my $source (@{$self->{_sources}}) {
+            my $id = $source->get_id();
+            foreach my $arch (keys %{$self->{_archs}}) {
+                next unless $self->{_archs}->{$arch}->{$id};
+                $resultset->add_result($self->{_id}, $media, $package, { 
+                    arch   => $arch,
+                    bot    => $id,
+                    status => $source->status($name, $version, $release, $arch),
+                    url    => $source->url($name, $version, $release, $arch),
+                }) if $source->fails(
+                    $name,
+                    $version,
+                    $release,
+                    $arch,
+                );
+            }
+        }
+    };
+
+    $media->traverse_headers($callback);
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Build/Source.pm b/lib/Youri/Check/Input/Build/Source.pm
new file mode 100644
index 0000000..be13ac7
--- /dev/null
+++ b/lib/Youri/Check/Input/Build/Source.pm
@@ -0,0 +1,109 @@
+# $Id: Source.pm 868 2006-04-11 20:35:09Z guillomovitch $
+package Youri::Check::Input::Build::Source;
+
+=head1 NAME
+
+Youri::Check::Input::Build::Source - Abstract build log source
+
+=head1 DESCRIPTION
+
+This abstract class defines the updates source interface for
+L<Youri::Check::Input::Build>.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+
+=head1 CLASS METHODS
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Build object.
+
+No generic parameters (subclasses may define additional ones).
+
+Warning: do not call directly, call subclass constructor instead.
+
+=cut
+
+sub new {
+    my $class = shift;
+    croak "Abstract class" if $class eq __PACKAGE__;
+
+    my %options = (
+        id        => '',    # object id
+        test      => 0,     # test mode
+        verbose   => 0,     # verbose mode
+        @_
+    );
+
+    my $self = bless {
+        _id        => $options{id},
+        _test      => $options{test},
+        _verbose   => $options{verbose},
+    }, $class;
+
+    $self->_init(%options);
+
+    return $self;
+}
+
+sub _init {
+    # do nothing
+}
+
+=head1 INSTANCE METHODS
+
+=head2 get_id()
+
+Returns source identity.
+
+=cut
+
+sub get_id {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return $self->{_id};
+}
+
+=head2 fails($name, $version, $release, $arch)
+
+Returns true if build fails for package with given name, version and release on
+given architecture.
+
+=head2 status($name, $version, $release, $arch)
+
+Returns exact build status for package with given name, version and release on
+given architecture. It has to be called after fails().
+
+=head2 url($name, $version, $release, $arch)
+
+Returns URL of information source for package with given name, version and
+release on given architecture. It has to be called after fails().
+
+=head1 SUBCLASSING
+
+The following methods have to be implemented:
+
+=over
+
+=item fails
+
+=item status
+
+=item url
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Build/Source/Iurt.pm b/lib/Youri/Check/Input/Build/Source/Iurt.pm
new file mode 100644
index 0000000..9ab84b4
--- /dev/null
+++ b/lib/Youri/Check/Input/Build/Source/Iurt.pm
@@ -0,0 +1,117 @@
+# $Id: LBD.pm 574 2005-12-27 14:31:16Z guillomovitch $
+package Youri::Check::Input::Build::Source::Iurt;
+
+=head1 NAME
+
+Youri::Check::Input::Build::Source::Iurt - Iurt build log source
+
+=head1 DESCRIPTION
+
+This source plugin for L<Youri::Check::Input::Build> collects build logs
+available from a iurt build bot.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use LWP::UserAgent;
+use HTML::TokeParser;
+use base 'Youri::Check::Input::Build::Source';
+
+my %status = (
+    install_deps => 0,
+    build        => 1,
+    binary_test  => 2
+);
+
+my $pattern = '^('
+    . join('|', keys %status)
+    . ')_\S+-[^-]+-[^-]+\.src\.rpm\.\d+\.log$';
+
+=head1 CLASS METHODS
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Build::LBD object.
+
+Specific parameters:
+
+=over
+
+=item url $url
+
+URL of logs for this iurt instance (default:
+http://qa.mandriva.com/build/iurt/cooker)
+
+=back
+
+=cut
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        url    => 'http://qa.mandriva.com/build/iurt/cooker',
+        @_
+    );
+
+    $self->{_agent} = LWP::UserAgent->new();
+
+    # try to connect to base URL directly, and abort if not available
+    my $response = $self->{_agent}->head($options{url});
+    die "Unavailable URL $options{url}: " . $response->status_line()
+        unless $response->is_success();
+
+    $self->{_url} = $options{url};
+}
+
+sub fails {
+    my ($self, $name, $version, $release, $arch) = @_;
+
+    my $result;
+    my $url = "$self->{_url}/$arch/log/$name-$version-$release.src.rpm";
+    print "Fetching URL $url: " if $self->{_verbose} > 1;
+    my $response = $self->{_agent}->get($url);
+    print $response->status_line() . "\n" if $self->{_verbose} > 1;
+    if ($response->is_success()) {
+        my $parser = HTML::TokeParser->new(\$response->content());
+        while (my $token = $parser->get_tag('a')) {
+            my $href = $token->[1]->{href};
+            next unless $href =~ /$pattern/o;
+            my $status  = $1;
+            if (
+                !$result->{status} ||
+                $status{$result->{status}} < $status{$status}
+            ) {
+                $result->{status} = $status;
+                $result->{url}    = $url . '/' . $href;
+            }
+        }
+    }
+
+    $self->{_results}->{$name}->{$version}->{$release}->{$arch} = $result;
+
+    return $result->{status} && $result->{status} ne 'binary_test';
+}
+
+sub status {
+    my ($self, $name, $version, $release, $arch) = @_;
+    return
+        $self->{_results}->{$name}->{$version}->{$release}->{$arch}->{status};
+}
+
+sub url {
+    my ($self, $name, $version, $release, $arch) = @_;
+    return
+        $self->{_results}->{$name}->{$version}->{$release}->{$arch}->{url};
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Build/Source/LBD.pm b/lib/Youri/Check/Input/Build/Source/LBD.pm
new file mode 100644
index 0000000..1f01645
--- /dev/null
+++ b/lib/Youri/Check/Input/Build/Source/LBD.pm
@@ -0,0 +1,135 @@
+# $Id: LBD.pm 885 2006-04-17 22:25:00Z guillomovitch $
+package Youri::Check::Input::Build::Source::LBD;
+
+=head1 NAME
+
+Youri::Check::Input::Build::Source::LBD - LBD build log source
+
+=head1 DESCRIPTION
+
+This source plugin for L<Youri::Check::Input::Build> collects build logs
+available from a LBD build bot.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use LWP::UserAgent;
+use HTML::TokeParser;
+use base 'Youri::Check::Input::Build::Source';
+
+my @status = qw/
+    OK
+    arch_excl
+    broken
+    cannot_be_installed
+    debug
+    dependency
+    file_not_found
+    multiarch
+    problem
+    unpackaged_files
+/;
+
+=head1 CLASS METHODS
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Build::LBD object.
+
+Specific parameters:
+
+=over
+
+=item url $url
+
+URL of logs for this LBD instance (default: http://eijk.homelinux.org/build)
+
+=item medias $medias
+
+List of medias monitored by this LBD instance
+
+=item archs $archs
+
+List of architectures monitored by this LBD instance
+
+=back
+
+=cut
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        url    => 'http://eijk.homelinux.org/build',
+        medias => undef,
+        archs  => undef,
+        @_
+    );
+
+    my $agent   = LWP::UserAgent->new();
+
+    # try to connect to base URL directly, and abort if not available
+    my $response = $agent->head($options{url});
+    die "Unavailable URL $options{url}: " . $response->status_line()
+        unless $response->is_success();
+
+    my $pattern = '^(\S+)-([^-]+)-([^-]+)(?:\.gz)?$';
+
+    foreach my $arch (@{$options{archs}}) {
+        foreach my $media (@{$options{medias}}) {
+            my $url_base = "$options{url}/$arch/$media/BO";
+            foreach my $status (@status) {
+                my $url = "$url_base/$status/";
+                print "Fetching URL $url: " if $self->{_verbose} > 1;
+                my $response = $agent->get($url);
+                print $response->status_line() . "\n" if $self->{_verbose} > 1;
+                if ($response->is_success()) {
+                    my $parser = HTML::TokeParser->new(\$response->content());
+                    while (my $token = $parser->get_tag('a')) {
+                        my $href = $token->[1]->{href};
+                        next unless $href =~ /$pattern/o;
+                        my $name    = $1;
+                        my $version = $2;
+                        my $release = $3;
+                        my $result;
+                        $result->{status} = $status;
+                        $result->{url}    = $url . '/' . $href;
+                        $self->{_results}->{$name}->{$version}->{$release}->{$arch} = $result;
+                    }
+                }
+            }
+        }
+    }
+}
+
+sub fails {
+    my ($self, $name, $version, $release, $arch) = @_;
+
+    my $status =
+        $self->{_results}->{$name}->{$version}->{$release}->{$arch}->{status};
+
+    return $status && $status ne 'OK' && $status ne 'arch_excl';
+}
+
+sub status {
+    my ($self, $name, $version, $release, $arch) = @_;
+    return
+        $self->{_results}->{$name}->{$version}->{$release}->{$arch}->{status};
+}
+
+sub url {
+    my ($self, $name, $version, $release, $arch) = @_;
+    return
+        $self->{_results}->{$name}->{$version}->{$release}->{$arch}->{url};
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Conflicts.pm b/lib/Youri/Check/Input/Conflicts.pm
new file mode 100644
index 0000000..9ffc986
--- /dev/null
+++ b/lib/Youri/Check/Input/Conflicts.pm
@@ -0,0 +1,231 @@
+# $Id: Conflicts.pm 885 2006-04-17 22:25:00Z guillomovitch $
+package Youri::Check::Input::Conflicts;
+
+=head1 NAME
+
+Youri::Check::Input::Conflicts - Check file conflicts
+
+=head1 DESCRIPTION
+
+This plugin checks packages files, and report conflict and duplications.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use constant;
+use Youri::Package;
+use base 'Youri::Check::Input';
+
+use constant TYPE_MASK => 0170000; 
+use constant TYPE_DIR  => 0040000;
+
+use constant PACKAGE => 0;
+use constant MODE    => 1;
+use constant MD5SUM  => 2;
+
+my $compatibility = {
+    x86_64  => 'i586',
+    i586    => 'x86_64',
+    sparc64 => 'sparc',
+    sparc   => 'sparc64',
+    ppc64   => 'ppc',
+    ppc     => 'ppc64'
+};
+
+sub columns {
+    return qw/
+        arch
+        file
+        error
+        level
+    /;
+}
+
+sub links {
+    return qw//;
+}
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Conflicts object.
+
+No specific parameters.
+
+=cut
+
+sub prepare {
+    my ($self, @medias) = @_;
+    croak "Not a class method" unless ref $self;
+
+    my $index = sub {
+        my ($package) = @_;
+
+        # index files
+        foreach my $file ($package->get_files()) {
+            push(
+                @{$self->{_files}->{$file->[Youri::Package::FILE_NAME]}},
+                [ $package, $file->[Youri::Package::FILE_MODE], $file->[Youri::Package::FILE_MD5SUM] ]
+            );
+        }
+    };
+
+    foreach my $media (@medias) {
+        # don't index source media files
+        next unless $media->get_type() eq 'binary';
+
+        my $media_id = $media->get_id();
+        $self->{_medias}->{$media_id} = 1;
+        print STDERR "Indexing media $media_id files\n"
+            if $self->{_verbose};
+
+        $media->traverse_headers($index);
+    }
+}
+
+sub run {
+    my ($self, $media, $result) = @_;
+    croak "Not a class method" unless ref $self;
+
+    # this is a binary media check only
+    return unless $media->get_type() eq 'binary';
+
+    my $check = sub {
+        my ($package) = @_;
+
+        return if $package->get_arch() eq 'src';
+
+        my $arch = $package->get_arch();
+        my $name = $package->get_name();
+
+        foreach my $file ($package->get_files()) {
+
+            my $found =
+                $self->{_files}->{$file->[Youri::Package::FILE_NAME]};
+
+            my @found = $found ? @$found : ();
+
+            foreach my $found (@found) {
+                next if $found->[PACKAGE] == $package;
+                next unless compatible($found->[PACKAGE], $package);
+                next if conflict($found->[PACKAGE], $package);
+                next if replace($found->[PACKAGE], $package);
+                if (
+                    ($file->[Youri::Package::FILE_MODE] & TYPE_MASK) == TYPE_DIR &&
+                    ($found->[MODE] & TYPE_MASK) == TYPE_DIR
+                ) {
+                    $result->add_result($self->{_id}, $media, $package, {
+                        arch  => $arch,
+                        file  => $name,
+                        error => "directory $file->[Youri::Package::FILE_NAME] duplicated with package " . $found->[PACKAGE]->get_name(),
+                        level => Youri::Check::Input::WARNING
+                    }) unless $self->_directory_duplicate_exception(
+                        $package,
+                        $found->[PACKAGE],
+                        $file
+                    );
+                } else {
+                    if ($found->[MD5SUM] eq $file->[Youri::Package::FILE_MD5SUM]) {
+                        $result->add_result($self->{_id}, $media, $package, {
+                            arch  => $arch,
+                            file  => $name,
+                            error => "file $file->[Youri::Package::FILE_NAME] duplicated with package " . $found->[PACKAGE]->get_name(),
+                            level => Youri::Check::Input::WARNING
+                        }) unless $self->_file_duplicate_exception(
+                            $package,
+                            $found->[PACKAGE],
+                            $file
+                        );
+                    } else {
+                        $result->add_result($self->{_id}, $media, $package, {
+                            arch  => $arch,
+                            file  => $name,
+                            error => "non-explicit conflict on file $file->[Youri::Package::FILE_NAME] with package " . $found->[PACKAGE]->get_name(),
+                            level => Youri::Check::Input::ERROR
+                        }) unless $self->_file_conflict_exception(
+                            $package,
+                            $found->[PACKAGE],
+                            $file
+                        );
+                    }
+                }
+            }
+        }
+    };
+
+    $media->traverse_headers($check);
+}
+
+# return true if $package1 is arch-compatible with $package2
+sub compatible {
+    my ($package1, $package2) = @_;
+
+    my $arch1 = $package1->get_arch();
+    my $arch2 = $package2->get_arch();
+
+    return 1 if $arch1 eq $arch2;
+
+    return 1 if $compatibility->{$arch1} && $compatibility->{$arch1} eq $arch2;
+
+    return 0;
+}
+
+# return true if $package1 conflict with $package2
+# or the other way around
+sub conflict {
+    my ($package1, $package2) = @_;
+
+    my $name2 = $package2->get_name();
+
+    foreach my $conflict ($package1->get_conflicts()) {
+        return 1 if $conflict eq $name2;
+    }
+
+    my $name1 = $package1->get_name();
+
+    foreach my $conflict ($package2->get_conflicts()) {
+        return 1 if $conflict eq $name1;
+    }
+
+    return 0;
+}
+
+# return true if $package1 replace $package2
+sub replace {
+    my ($package1, $package2) = @_;
+
+
+    my $name1 = $package1->get_name();
+    my $name2 = $package2->get_name();
+
+    return 1 if $name1 eq $name2;
+
+    foreach my $obsolete ($package1->get_obsoletes()) {
+        return 1 if $obsolete->[Youri::Package::DEPENDENCY_NAME] eq $name2;
+    }
+
+    return 0;
+}
+
+sub _directory_duplicate_exception {
+    return 0;
+}
+
+sub _file_duplicate_exception {
+    return 0;
+}
+
+sub _file_conflict_exception {
+    return 0;
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Dependencies.pm b/lib/Youri/Check/Input/Dependencies.pm
new file mode 100644
index 0000000..5533ef4
--- /dev/null
+++ b/lib/Youri/Check/Input/Dependencies.pm
@@ -0,0 +1,162 @@
+# $Id: Dependencies.pm 875 2006-04-16 12:02:22Z guillomovitch $
+package Youri::Check::Input::Dependencies;
+
+=head1 NAME
+
+Youri::Check::Input::Dependencies - Check dependencies consistency
+
+=head1 DESCRIPTION
+
+This class checks dependencies consistency.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use Youri::Package;
+use base 'Youri::Check::Input';
+
+use constant MEDIA => 0;
+use constant RANGE => 1;
+
+sub columns {
+    return qw/
+        arch
+        file
+        error
+        level
+    /;
+}
+
+sub links {
+    return qw//;
+}
+
+sub prepare {
+    my ($self, @medias) = @_;
+    croak "Not a class method" unless ref $self;
+
+    foreach my $media (@medias) {
+        my $media_id = $media->get_id();
+        $self->{_medias}->{$media_id} = 1;
+        print STDERR "Indexing media $media_id dependencies\n"
+            if $self->{_verbose};
+
+        my $index = sub {
+            my ($package) = @_;
+
+            # index provides
+            foreach my $provide ($package->get_provides()) {
+                push(
+                    @{$self->{_provides}->{$provide->[Youri::Package::DEPENDENCY_NAME]}},
+                    [ $media_id, $provide->[Youri::Package::DEPENDENCY_RANGE] ]
+                );
+            }
+
+            # index files
+            foreach my $file ($package->get_files()) {
+                push(
+                    @{$self->{_files}->{$file->[Youri::Package::FILE_NAME]}},
+                    [ $media_id, undef ]
+                );
+            }
+        };
+        $media->traverse_headers($index);
+    }
+}
+
+sub run {
+    my ($self, $media, $resultset) = @_;
+    croak "Not a class method" unless ref $self;
+
+    my @allowed_ids = $media->allow_deps();
+
+    # abort unless all allowed medias are present
+    foreach my $id (@allowed_ids) {
+        unless ($self->{_medias}->{$id}) {
+            carp "Missing media $id, aborting";
+            return;
+        }
+    }
+
+    # index allowed medias
+    my %allowed_ids = map { $_ => 1 } @allowed_ids;
+    my $allowed_ids = join(",", @allowed_ids);
+
+    my $class = $media->get_package_class();
+
+    my $check = sub {
+        my ($package) = @_;
+
+        my $arch = $package->get_arch();
+        my $name = $package->get_name();
+
+        foreach my $require ($package->get_requires()) {
+
+            my $found =
+                substr($require->[Youri::Package::DEPENDENCY_NAME], 0, 1) eq '/' ?
+                    $self->{_files}->{$require->[Youri::Package::DEPENDENCY_NAME]} :
+                    $self->{_provides}->{$require->[Youri::Package::DEPENDENCY_NAME]};
+
+            my @found = $found ? @$found : ();
+
+            if (!@found) {
+                $resultset->add_result($self->{_id}, $media, $package, {
+                    arch  => $arch,
+                    file  => $name,
+                    error => "$require->[Youri::Package::DEPENDENCY_NAME] not found",
+                    level => Youri::Check::Input::ERROR
+                });
+                next;
+            }
+
+            my @found_in_media =
+                grep { $allowed_ids{$_->[MEDIA]} }
+                @found;
+
+            if (!@found_in_media) {
+                $resultset->add_result($self->{_id}, $media, $package, {
+                    arch  => $arch,
+                    file  => $name,
+                    error => "$require->[Youri::Package::DEPENDENCY_NAME] found in incorrect media $_->[MEDIA] (allowed $allowed_ids)",
+                    level => Youri::Check::Input::ERROR
+                }) foreach @found;
+                next;
+            }
+
+            next unless $require->[Youri::Package::DEPENDENCY_RANGE];
+
+            my @found_in_range =
+                grep {
+                    !$_->[RANGE] ||
+                    $class->compare_ranges(
+                        $require->[Youri::Package::DEPENDENCY_RANGE],
+                        $_->[RANGE]
+                    )
+                } @found_in_media;
+
+            if (!@found_in_range) {
+                $resultset->add_result($self->{_id}, $media, $package, {
+                    arch  => $arch,
+                    file  => $name,
+                    error => "$require->[Youri::Package::DEPENDENCY_NAME] found with incorrect range $_->[RANGE] (needed $require->[Youri::Package::DEPENDENCY_RANGE])",
+                    level => Youri::Check::Input::ERROR
+                }) foreach @found_in_media;
+                next;
+            }
+        }
+    };
+
+    $media->traverse_headers($check);
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/MandrivaConflicts.pm b/lib/Youri/Check/Input/MandrivaConflicts.pm
new file mode 100644
index 0000000..c43623b
--- /dev/null
+++ b/lib/Youri/Check/Input/MandrivaConflicts.pm
@@ -0,0 +1,63 @@
+# $Id: Conflicts.pm 533 2005-10-20 07:08:03Z guillomovitch $
+package Youri::Check::Input::MandrivaConflicts;
+
+=head1 NAME
+
+Youri::Check::Input::MandrivaConflicts - Check file conflicts on Mandriva
+
+=head1 DESCRIPTION
+
+This class checks file conflicts between packages, taking care of Mandriva
+packaging policy.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use Youri::Package;
+use base 'Youri::Check::Input::Conflicts';
+
+sub _directory_duplicate_exception {
+    my ($self, $package1, $package2, $file) = @_;
+
+    # allow shared directories between devel packages of different arch
+    return 1 if _multiarch_exception($package1, $package2);
+
+    # allow shared modules directories between perl packages
+    return 1 if 
+        $file->[Youri::Package::FILE_NAME] =~ /^\/usr\/lib\/perl5\/vendor_perl\// &&
+        $file->[Youri::Package::FILE_NAME] !~ /^(auto|[^\/]+-linux)$/;
+
+    return 0;
+}
+
+sub _file_duplicate_exception {
+    my ($self, $package1, $package2, $file) = @_;
+
+    # allow shared files between devel packages of different arch
+    return 1 if _multiarch_exception($package1, $package2);
+
+    return 0;
+}
+
+sub _multiarch_exception {
+    my ($package1, $package2) = @_;
+
+    return 1 if
+        $package1->get_canonical_name() eq $package2->get_canonical_name()
+        && $package1->get_name() =~ /-devel$/
+        && $package2->get_name() =~ /-devel$/;
+
+    return 0;
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Missing.pm b/lib/Youri/Check/Input/Missing.pm
new file mode 100644
index 0000000..ece034d
--- /dev/null
+++ b/lib/Youri/Check/Input/Missing.pm
@@ -0,0 +1,138 @@
+package Youri::Check::Input::Missing;
+
+=head1 NAME
+
+Youri::Check::Input::Missing - Check components consistency
+
+=head1 DESCRIPTION
+
+This plugin checks consistency between package components, and report outdated
+ones.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use List::MoreUtils qw/all any/;
+use base 'Youri::Check::Input';
+
+sub columns {
+    return qw/
+        component
+        arch
+        revision
+        error
+    /;
+}
+
+sub links {
+    return qw//;
+}
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Missing object.
+
+No specific parameters.
+
+=cut
+
+sub prepare {
+    my ($self, @medias)  = @_;
+    croak "Not a class method" unless ref $self;
+    $self->{_srcs} = ();
+    foreach my $media (@medias) {
+        # only index source media
+        next unless $media->get_type() eq 'source';
+
+        my $media_id = $media->get_id();
+        $self->{_medias}->{$media_id} = 1;
+        print STDERR "Indexing media $media_id packages\n" if $self->{_verbose};
+
+        my $index = sub {
+            my ($package) = @_;
+            $self->{_srcs}->{$media_id}->{$package->get_name()} =
+                $package->get_version() . '-' . $package->get_release();
+        };
+
+        $media->traverse_headers($index);
+    }
+}
+
+sub run {
+    my ($self, $media, $resultset) = @_;
+    croak "Not a class method" unless ref $self;
+
+    # this is a binary media check only
+    return unless $media->get_type() eq 'binary';
+
+    my @allowed_ids = $media->allow_srcs();
+
+    # abort unless all allowed medias are present
+    foreach my $id (@allowed_ids) {
+    unless ($self->{_medias}->{$id}) {
+            carp "Missing media $id, aborting";
+            return;
+        }
+    }
+
+    my $class = $media->get_package_class();
+
+    my $check_package = sub {
+        my ($package) = @_;
+        my $canonical_name = $package->get_canonical_name();
+
+        my $bin_revision =
+            $package->get_version() . '-' . $package->get_release();
+
+        my $src_revision;
+        foreach my $id (@allowed_ids) {
+            $src_revision = $self->{_srcs}->{$id}->{$canonical_name};
+            last if $src_revision;
+        }
+
+        if ($src_revision) {
+            # check if revision match
+            unless ($src_revision eq $bin_revision) {
+                if ($class->compare_versions($src_revision, $bin_revision) > 0) {
+                    # binary package is obsolete
+                    $resultset->add_result($self->{_id}, $media, $package, {
+                        component => $package->get_name(),
+                        arch      => $package->get_arch(),
+                        revision  => $bin_revision,
+                        error     => "Obsolete binaries (source $src_revision found)",
+                    });
+                } else {
+                    # source package is obsolete
+                    $resultset->add_result($self->{_id}, $media, $package, {
+                        component => $package->get_canonical_name(),
+                        arch      => 'src',
+                        revision  => $src_revision,
+                        error     => "Obsolete source (binaries $bin_revision found)",
+                    });
+                }
+            }
+        } else {
+            $resultset->add_result($self->{_id}, $media, $package, {
+                component => $package->get_name(),
+                arch      => $package->get_arch(),
+                revision  => $bin_revision,
+                error     => "Missing source package",
+            });
+        }
+    };
+
+    $media->traverse_headers($check_package);
+}
+
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Orphans.pm b/lib/Youri/Check/Input/Orphans.pm
new file mode 100644
index 0000000..e193f0e
--- /dev/null
+++ b/lib/Youri/Check/Input/Orphans.pm
@@ -0,0 +1,74 @@
+package Youri::Check::Input::Orphans;
+
+=head1 NAME
+
+Youri::Check::Input::Orphans - Check maintainance
+
+=head1 DESCRIPTION
+
+This plugin checks maintainance status of packages, and reports unmaintained
+ones.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use base 'Youri::Check::Input';
+
+sub columns {
+    return qw/
+        error
+    /;
+}
+
+sub links {
+    return qw//;
+}
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Orphans object.
+
+No specific parameters.
+
+=cut
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        resolver => undef,
+        @_
+    );
+
+    croak "No resolver defined" unless $options{resolver};
+
+    $self->{_resolver} = $options{resolver};
+}
+
+sub run {
+    my ($self, $media, $resultset) = @_;
+    croak "Not a class method" unless ref $self;
+    
+    # this is a source media check only
+    return unless $media->get_type() eq 'source';
+
+    my $check = sub {
+        my ($package) = @_;
+        $resultset->add_result($self->{_id}, $media, $package, {
+            error => "unmaintained package"
+        }) unless $self->{_resolver}->get_maintainer($package);
+    };
+
+    $media->traverse_headers($check);
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Rpmlint.pm b/lib/Youri/Check/Input/Rpmlint.pm
new file mode 100644
index 0000000..7b6a735
--- /dev/null
+++ b/lib/Youri/Check/Input/Rpmlint.pm
@@ -0,0 +1,113 @@
+# $Id: Rpmlint.pm 885 2006-04-17 22:25:00Z guillomovitch $
+package Youri::Check::Input::Rpmlint;
+
+=head1 NAME
+
+Youri::Check::Input::Rpmlint - Check packages with rpmlint
+
+=head1 DESCRIPTION
+
+This plugins checks packages with rpmlint, and reports output.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use base 'Youri::Check::Input';
+
+sub columns {
+    return qw/
+        arch
+        file
+        error
+        level
+    /;
+}
+
+sub links {
+    return qw//;
+}
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Rpmlint object.
+
+Specific parameters:
+
+=over
+
+=item path $path
+
+Path to the rpmlint executable (default: /usr/bin/rpmlint)
+
+=item config $config
+
+Specific rpmlint configuration.
+
+=back
+
+=cut
+
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        path   => '/usr/bin/rpmlint', # path to rpmlint
+        config => '',                 # default rpmlint configuration
+        @_
+    );
+
+    $self->{_path}   = $options{path};
+    $self->{_config} = $options{config};
+}
+
+sub run {
+    my ($self, $media, $resultset) = @_;
+    croak "Not a class method" unless ref $self;
+
+    my $config = $media->rpmlint_config() ?
+        $media->rpmlint_config() :
+        $self->{_config};
+
+    my $check = sub {
+        my ($file, $package) = @_;
+
+        my $arch = $package->get_arch();
+        my $name = $package->get_name();
+
+        my $command = "$self->{_path} -f $config $file";
+        open(RPMLINT, "$command |") or die "Can't run $command: $!";
+        while (<RPMLINT>) {
+            chomp;
+            if (/^E: \Q$name\E (.+)/) {
+                $resultset->add_result($self->{_id}, $media, $package, { 
+                    arch  => $arch,
+                    file  => $name,
+                    error => $1,
+                    level => Youri::Check::Input::ERROR
+                });
+            } elsif (/^W: \Q$name\E (.+)/) {
+                $resultset->add_result($self->{_id}, $media, $package, { 
+                    arch  => $arch,
+                    file  => $name,
+                    error => $1,
+                    level => Youri::Check::Input::WARNING
+                });
+            }
+        }
+        close(RPMLINT);
+    };
+
+    $media->traverse_files($check);
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Signature.pm b/lib/Youri/Check/Input/Signature.pm
new file mode 100644
index 0000000..57b49bc
--- /dev/null
+++ b/lib/Youri/Check/Input/Signature.pm
@@ -0,0 +1,96 @@
+# $Id: Rpmlint.pm 567 2005-12-12 21:24:56Z guillomovitch $
+package Youri::Check::Input::Signature;
+
+=head1 NAME
+
+Youri::Check::Input::Signature - Check signature
+
+=head1 DESCRIPTION
+
+This plugin checks packages signature, and report unsigned ones. 
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use base 'Youri::Check::Input';
+
+sub columns {
+    return qw/
+        arch
+        file
+        error
+    /;
+}
+
+sub links {
+    return qw//;
+}
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Signature object.
+
+Specific parameters:
+
+=over
+
+=item key $key
+
+Expected GPG key identity
+
+=back
+
+=cut
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        key => '',
+        @_
+    );
+
+    $self->{_key} = $options{key};
+}
+
+sub run {
+    my ($self, $media, $resultset) = @_;
+    croak "Not a class method" unless ref $self;
+
+    my $check = sub {
+        my ($package) = @_;
+
+        my $arch = $package->get_arch();
+        my $name = $package->get_name();
+
+        my $key = $package->get_gpg_key();
+
+        if (!$key) {
+            $resultset->add_result($self->{_id}, $media, $package, { 
+                arch  => $arch,
+                file  => $name,
+                error => "unsigned package $name"
+            });
+        } elsif ($key ne $self->{_key}) {
+            $resultset->add_result($self->{_id}, $media, $package, { 
+                arch  => $arch,
+                file  => $name,
+                error => "invalid key id $key for package $name (allowed $self->{_key})"
+            });
+        }
+        
+    };
+
+    $media->traverse_headers($check);
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Updates.pm b/lib/Youri/Check/Input/Updates.pm
new file mode 100644
index 0000000..2d21cb3
--- /dev/null
+++ b/lib/Youri/Check/Input/Updates.pm
@@ -0,0 +1,275 @@
+# $Id: Updates.pm 915 2006-05-23 20:01:49Z pterjan $
+package Youri::Check::Input::Updates;
+
+=head1 NAME
+
+Youri::Check::Input::Updates - Check available updates
+
+=head1 DESCRIPTION
+
+This plugin checks available updates for packages, and report existing ones.
+Additional source plugins handle specific sources.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use Memoize;
+use Youri::Utils;
+use base 'Youri::Check::Input';
+
+sub columns {
+    return qw/
+        current
+        available
+        source
+    /;
+}
+
+sub links {
+    return qw/
+        source url
+    /;
+}
+
+memoize('is_newer');
+
+our $VERSION_REGEXP = 'v?([\d._-]*\d)[._ -]*(?:(alpha|beta|pre|rc|pl|rev|cvs|svn|[a-z])[_ -.]*([\d.]*))?([_ -.]*.*)';
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Updates object.
+
+Specific parameters:
+
+=over
+
+=item aliases $aliases
+
+Hash of global aliases definitions
+
+=item sources $sources
+
+Hash of source plugins definitions
+
+=back
+
+=cut
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        aliases => undef,
+        sources => undef,
+        @_
+    );
+
+    croak "No source defined" unless $options{sources};
+    croak "sources should be an hashref" unless ref $options{sources} eq 'HASH';
+    if ($options{aliases}) {
+        croak "aliases should be an hashref" unless ref $options{aliases} eq 'HASH';
+    }
+
+    foreach my $id (keys %{$options{sources}}) {
+        print "Creating source $id\n" if $options{verbose};
+        eval {
+            # add global aliases if defined
+            if ($options{aliases}) {
+                foreach my $alias (keys %{$options{aliases}}) {
+                    $options{sources}->{$id}->{aliases}->{$alias} =
+                    $options{aliases}->{$alias}
+                }
+            }
+
+            push(
+                @{$self->{_sources}},
+                create_instance(
+                    'Youri::Check::Input::Updates::Source',
+                    id          => $id,
+                    test        => $options{test},
+                    verbose     => $options{verbose},
+                    check_id    => $options{id},
+                    resolver    => $options{resolver},
+                    preferences => $options{preferences},
+                    %{$options{sources}->{$id}}
+                )
+            );
+        };
+        print STDERR "Failed to create source $id: $@\n" if $@;
+    }
+
+    croak "no sources created" unless @{$self->{_sources}};
+}
+
+sub run {
+    my ($self, $media, $resultset) = @_;
+    croak "Not a class method" unless ref $self;
+    
+    # this is a source media check only
+    return unless $media->get_type() eq 'source';
+
+    my $callback = sub {
+        my ($package) = @_;
+
+        my $name    = $package->get_name();
+        my $version = $package->get_version();
+        my $release = $package->get_release();
+
+        # compute version with rpm subtilities related to preversions
+        my $current_version = ($release =~ /^0\.(\w+)\.\w+$/) ?
+            $version . $1 :
+            $version;
+        my $current_stable = is_stable($current_version);
+
+        my ($max_version, $max_source, $max_url);
+        $max_version = $current_version;
+
+        foreach my $source (@{$self->{_sources}}) {
+            my $available_version = $source->get_version($package);
+            if (
+                $available_version &&
+                (! $current_stable || is_stable($available_version)) &&
+                is_newer($available_version, $max_version)
+            ) {
+                $max_version = $available_version;
+                $max_source  = $source->get_id();
+                $max_url     = $source->get_url($name);
+            }
+        }
+        $resultset->add_result($self->{_id}, $media, $package, {
+            current   => $current_version,
+            available => $max_version,
+            source    => $max_source,
+            url       => $max_url
+        }) if $max_version ne $current_version;
+    };
+
+    $media->traverse_headers($callback);
+}
+
+=head2 is_stable($version)
+
+Checks if given version is stable.
+
+=cut
+
+sub is_stable {
+    my ($version) = @_;
+    return $version !~ /alpha|beta|pre|rc|cvs|svn/i;
+    
+}
+
+=head2 is_newer($v1, $v2)
+
+Checks if $v1 is newer than $v2.
+
+This function will return true only if we are sure this is newer (and not equal).
+If we can't compare the versions, a warning will be displayed.
+
+=cut
+
+sub is_newer {
+    my ($v1, $v2) = @_;  
+    return 0 if $v1 eq $v2;
+
+    # Reject strange cases
+    # One is a large number (like date or revision) and the other one not, or
+    # has different length
+    if (($v1 =~ /^\d{3,}$/ || $v2 =~ /^\d{3,}$/) 
+       && (join('0',split(/\d/, $v1."X")) ne join('0',split(/\d/, $v2."X")))) { 
+      carp "strange : $v1 vs $v2";
+      return 0;
+    }
+
+    my %states = (alpha=>-4,beta=>-3,pre=>-2,rc=>-1);
+    my $i; $states{$_} = ++$i foreach 'a'..'z';
+
+    if ($v1 =~ /^[\d._-]+$/ && $v2 =~ /^[\d._-]+$/) {
+        my @v1 = split(/[._-]/, $v1);
+        my @v2 = split(/[._-]/, $v2);
+	if (join('',@v1) eq (join '',@v2)) {
+          # Might be something like 1.2.0 vs 1.20, usual false positive
+          carp "strange : $v1 vs $v2";
+          return 0;
+        }
+        for my $i (0 .. $#v1) {
+          $v1[$i] ||= 0;
+          $v2[$i] ||= 0;
+          return 1 if $v1[$i] > $v2[$i];
+          return 0 if $v1[$i] < $v2[$i];
+        }
+        # When v2 is longer than v1 but start the same, v1 <= v2
+        return 0;
+    } else {
+        my ($num1, $state1, $statenum1, $other1, $num2, $state2, $statenum2, $other2);
+
+        if ($v1 =~ /^$VERSION_REGEXP$/io) {
+            ($num1, $state1, $statenum1, $other1) = ($1, "\L$2", $3, $4);
+        } else {
+            carp "unknown version format $v1";
+            return 0;
+        }
+
+        if ($v2 =~ /^$VERSION_REGEXP$/io) {
+            ($num2, $state2, $statenum2, $other2) = ($1, "\L$2", $3, $4);
+        } else {
+            carp "unknown version format $v2";
+            return 0;
+        }
+
+        # If we know the format of only one, there might be an issue, do nothing
+
+        if (($other1 && ! $other2 )||(!$other1 && $other2 )) {
+            carp "can't compare $v1 vs $v2";
+            return 0;
+        }
+	
+        return 1 if is_newer($num1, $num2);
+        return 0 unless $num1 eq $num2;
+
+        # The numeric part is the same but not the end
+        
+        if ($state1 eq '') {
+            return 1 if $state2 =~ /^(alpha|beta|pre|rc)/;
+            return 0 if $state2 =~ /^([a-z]|pl)$/;
+            carp "unknown state format $state2";
+            return 0;
+        }
+
+        if ($state2 eq '') {
+            return 0 if $state1 =~ /^(alpha|beta|pre|rc)/;
+            return 1 if $state1 =~ /^([a-z]|pl)$/;
+            carp "unknown state format $state1";
+            return 0;
+        }
+
+        if ($state1 eq $state2) {
+                return 1 if is_newer($statenum1, $statenum2);
+                return 0 unless $statenum1 eq $statenum2;
+                # If everything is the same except this, just compare it
+                # as we have no idea on the format
+                return "$other1" gt "$other2";
+        }
+
+        my $s1 = 0;
+        my $s2 = 0;
+        $s1=$states{$state1} if exists $states{$state1};
+        $s2=$states{$state2} if exists $states{$state2};
+        return $s1>$s2 if ($s1 != 0 && $s2 != 0);
+        return 1 if $s1<0 && $state2 =~ /^([a-z]|pl)$/;
+        return 0 if $s2<0 && $state1 =~ /^([a-z]|pl)$/;
+        carp "unknown case $v1, $v2";
+        return 0;
+    }
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Updates/Source.pm b/lib/Youri/Check/Input/Updates/Source.pm
new file mode 100644
index 0000000..1f671bd
--- /dev/null
+++ b/lib/Youri/Check/Input/Updates/Source.pm
@@ -0,0 +1,240 @@
+# $Id: Source.pm 897 2006-04-20 21:57:56Z guillomovitch $
+package Youri::Check::Input::Updates::Source;
+
+=head1 NAME
+
+Youri::Check::Input::Updates::Source - Abstract updates source
+
+=head1 DESCRIPTION
+
+This abstract class defines the updates source interface for
+L<Youri::Check::Input::Updates>.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+
+=head1 CLASS METHODS
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Updates object.
+
+Generic parameters (subclasses may define additional ones):
+
+=over
+
+=item aliases $aliases
+
+Hash of package aliases.
+
+=back
+
+Warning: do not call directly, call subclass constructor instead.
+
+=cut
+
+sub new {
+    my $class = shift;
+    croak "Abstract class" if $class eq __PACKAGE__;
+
+    my %options = (
+        id          => '',    # object id
+        test        => 0,     # test mode
+        verbose     => 0,     # verbose mode
+        aliases     => undef, # aliases
+        resolver    => undef, # maintainer resolver
+        preferences => undef, # maintainer preferences
+        check_id    => '',    # parent check id
+        @_
+    );
+
+    if ($options{aliases}) {
+        croak "aliases should be an hashref" unless ref $options{aliases} eq 'HASH';
+    }
+    if ($options{resolver}) {
+        croak "resolver should be a Youri::Check::Maintainer::Resolver object" unless $options{resolver}->isa("Youri::Check::Maintainer::Resolver");
+    }
+    if ($options{preferences}) {
+        croak "preferences should be a Youri::Check::Maintainer::Preferences object" unless $options{preferences}->isa("Youri::Check::Maintainer::Preferences");
+    }
+
+    my $self = bless {
+        _id          => $options{id},
+        _test        => $options{test},
+        _verbose     => $options{verbose},
+        _aliases     => $options{aliases},
+        _resolver    => $options{resolver},
+        _preferences => $options{preferences},
+        _check_id    => $options{check_id},
+    }, $class;
+
+    $self->_init(%options);
+
+    return $self;
+}
+
+sub _init {
+    # do nothing
+}
+
+=head1 INSTANCE METHODS
+
+Excepted explicit statement, package name is expressed with Mandriva naming
+conventions.
+
+=head2 get_id()
+
+Returns source identity.
+
+=cut
+
+sub get_id {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return $self->{_id};
+}
+
+=head2 get_version($package)
+
+Returns available version for given package, which can be either a full
+L<Youri::Package> object or just a package name.
+
+=cut
+
+sub get_version {
+    my ($self, $package) = @_;
+    croak "Not a class method" unless ref $self;
+
+    my $name = ref $package && $package->isa('Youri::Package') ?
+        $package->get_canonical_name() :
+        $package;
+
+    # translate in grabber namespace
+    $name = $self->get_name($name);
+
+    # return if aliased to null 
+    return unless $name;
+
+    # return subclass computation
+    return $self->_version($name);
+}
+
+=head2 get_url($name)
+
+Returns the URL of information source for package with given name.
+
+=cut
+
+sub get_url {
+    my ($self, $name) = @_;
+
+    # retun subclass computation
+    return $self->_url($self->get_name($name));
+}
+
+=head2 name($name)
+
+Returns name converted to specific source naming conventions for package with given name.
+
+=cut
+
+sub get_name {
+    my ($self, $name) = @_;
+    croak "Not a class method" unless ref $self;
+
+    # return config aliases if it exists
+    if ($self->{_aliases} ) {
+        return $self->{_aliases}->{$name} if exists $self->{_aliases}->{$name};
+    }
+
+    # return maintainer aliases if it exists
+    if ($self->{_resolver} && $self->{_preferences}) {
+        my $maintainer = $self->{_resolver}->get_maintainer($name);
+        if ($maintainer) {
+            my $aliases = $self->{_preferences}->get_preference(
+                $maintainer,
+                $self->{_check_id},
+                'aliases'
+            );
+            if ($aliases) {
+                if ($aliases->{all}) {
+                    return $aliases->{all}->{$name} if exists $aliases->{all}->{$name};
+                }
+                if ($aliases->{$self->{_id}}) {
+                    return $aliases->{$self->{_id}}->{$name} if exists $aliases->{$self->{_id}}->{$name};
+                }
+            }
+        }
+    }
+
+    # return return subclass computation
+    return $self->_name($name);
+}
+
+=head2 _version($name)
+
+Hook called by default B<version()> implementation after name translation.
+
+=cut
+
+sub _version {
+    my ($self, $name) = @_;
+    return $self->{_versions}->{$name};
+}
+
+=head2 _url($name)
+
+Hook called by default B<url()> implementation after name translation.
+
+=cut
+
+sub _url {
+    my ($self, $name) = @_;
+    return undef;
+}
+
+=head2 _name($name)
+
+Hook called by default B<name()> implementation if given name was not found in
+the aliases.
+
+=cut
+
+sub _name {
+    my ($self, $name) = @_;
+    return $name;
+}
+
+=head1 SUBCLASSING
+
+The following methods have to be implemented:
+
+=over
+
+=item version
+
+As an alternative, the B<_version()> hook can be implemented.
+
+=item url
+
+As an alternative, the <_url()> hook can be implemented.
+
+=item name
+
+As an alternative, the B<_name()> hook can be implemented.
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Updates/Source/CPAN.pm b/lib/Youri/Check/Input/Updates/Source/CPAN.pm
new file mode 100644
index 0000000..99f155f
--- /dev/null
+++ b/lib/Youri/Check/Input/Updates/Source/CPAN.pm
@@ -0,0 +1,75 @@
+# $Id: CPAN.pm 885 2006-04-17 22:25:00Z guillomovitch $
+package Youri::Check::Input::Updates::Source::CPAN;
+
+=head1 NAME
+
+Youri::Check::Input::Updates::Source::CPAN - CPAN updates source
+
+=head1 DESCRIPTION
+
+This source plugin for L<Youri::Check::Input::Updates> collects updates
+available from CPAN.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use base 'Youri::Check::Input::Updates::Source';
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Updates::Source::CPAN object.  
+
+Specific parameters:
+
+=over
+
+=item url $url
+
+URL to CPAN full modules list (default:
+http://www.cpan.org/modules/01modules.index.html)
+
+=back
+
+=cut
+
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        url => 'http://www.cpan.org/modules/01modules.index.html',
+        @_
+    );
+
+    my $versions;
+    open(INPUT, "GET $options{url} |") or croak "Can't fetch $options{url}: $!";
+    while (<INPUT>) {
+        next unless $_ =~ />([\w-]+)-([\d\.]+)\.tar\.gz<\/a>/;
+        $versions->{$1} = $2;
+    }
+    close(INPUT);
+
+    $self->{_versions} = $versions;
+}
+
+sub _url {
+    my ($self, $name) = @_;
+    return "http://search.cpan.org/dist/$name";
+}
+
+sub _name {
+    my ($self, $name) = @_;
+    $name =~ s/^perl-//g;
+    return $name;
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Updates/Source/Debian.pm b/lib/Youri/Check/Input/Updates/Source/Debian.pm
new file mode 100644
index 0000000..c930a10
--- /dev/null
+++ b/lib/Youri/Check/Input/Updates/Source/Debian.pm
@@ -0,0 +1,82 @@
+# $Id: Debian.pm 885 2006-04-17 22:25:00Z guillomovitch $
+package Youri::Check::Input::Updates::Source::Debian;
+
+=head1 NAME
+
+Youri::Check::Input::Updates::Source::Debian - Debian source for updates
+
+=head1 DESCRIPTION
+
+This source plugin for L<Youri::Check::Input::Updates> collects updates
+ available from Debian.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use base 'Youri::Check::Input::Updates::Source';
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Updates::Source::Debian object.
+
+Specific parameters:
+
+=over
+
+=item url $url
+
+URL to Debian mirror content file (default: http://ftp.debian.org/ls-lR.gz)
+
+=back
+
+=cut
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        url => 'http://ftp.debian.org/ls-lR.gz',
+        @_
+    );
+
+    my $versions;
+    open(INPUT, "GET $options{url} | zcat |") or croak "Can't fetch $options{url}: $!";
+    while (my $line = <INPUT>) {
+        next unless $line =~ /([\w\.-]+)_([\d\.]+)\.orig\.tar\.gz$/;
+        my $name = $1;
+        my $version = $2;
+        $versions->{$name} = $version;
+    }
+    close(INPUT);
+
+    $self->{_versions} = $versions;
+}
+
+sub _url {
+    my ($self, $name) = @_;
+    return "http://packages.debian.org/$name";
+}
+
+sub _name {
+    my ($self, $name) = @_;
+    
+    if ($name =~ /^(perl|ruby)-([-\w]+)$/) {
+        $name = lc("lib$2-$1");
+    } elsif ($name =~ /^apache-([-\w]+)$/) {
+        $name = "libapache-$1";
+        $name =~ s/_/-/g;
+    }
+
+    return $name;
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Updates/Source/Fedora.pm b/lib/Youri/Check/Input/Updates/Source/Fedora.pm
new file mode 100644
index 0000000..cbe255a
--- /dev/null
+++ b/lib/Youri/Check/Input/Updates/Source/Fedora.pm
@@ -0,0 +1,63 @@
+# $Id: Fedora.pm 885 2006-04-17 22:25:00Z guillomovitch $
+package Youri::Check::Input::Updates::Source::Fedora;
+
+=head1 NAME
+
+Youri::Check::Input::Updates::Source::Fedora - Fedora updates source
+
+=head1 DESCRIPTION
+
+This source plugin for L<Youri::Check::Input::Updates> collects updates
+available from Fedora.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use base 'Youri::Check::Input::Updates::Source';
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Updates::Source::Fedora object.
+
+Specific parameters:
+
+=over
+
+=item url $url
+
+URL to Fedora development SRPMS directory (default:
+http://fr.rpmfind.net/linux/fedora/core/development/SRPMS)
+
+=back
+
+=cut
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        url => 'http://fr.rpmfind.net/linux/fedora/core/development/SRPMS',
+        @_
+    );
+
+    my $versions;
+    open(INPUT, "GET $options{url} |") or die "Can't fetch $options{url}: $!\n";
+    while (<INPUT>) {
+        next unless $_ =~ />([\w-]+)-([\w\.]+)-[\w\.]+\.src\.rpm<\/a>/;
+        $versions->{$1} = $2;
+    }
+    close(INPUT);
+
+    $self->{_versions} = $versions;
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Updates/Source/Freshmeat.pm b/lib/Youri/Check/Input/Updates/Source/Freshmeat.pm
new file mode 100644
index 0000000..53672f0
--- /dev/null
+++ b/lib/Youri/Check/Input/Updates/Source/Freshmeat.pm
@@ -0,0 +1,111 @@
+# $Id: Freshmeat.pm 885 2006-04-17 22:25:00Z guillomovitch $
+package Youri::Check::Input::Updates::Source::Freshmeat;
+
+=head1 NAME
+
+Youri::Check::Input::Updates::Source::Freshmeat - Freshmeat source for updates
+
+=head1 DESCRIPTION
+
+This source plugin for L<Youri::Check::Input::Updates> collects updates
+available from Freshmeat.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use XML::Twig;
+use LWP::UserAgent;
+use base 'Youri::Check::Input::Updates::Source';
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Updates::Source::Freshmeat
+object.
+
+Specific parameters:
+
+=over
+
+=item preload true/false
+
+Allows to load full Freshmeat catalogue at once instead of checking each software independantly (default: false)
+
+=back
+
+=cut
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        preload => 0,
+        @_
+    );
+
+    if ($options{preload}) {
+        my $versions;
+        
+        my $project = sub {
+            my ($twig, $project) = @_;
+            my $name    = $project->first_child('projectname_short')->text();
+            my $version = $project->first_child('latest_release')->first_child('latest_release_version')->text();
+            $versions->{$name} = $version;
+            $twig->purge();
+        };
+
+        my $twig = XML::Twig->new(
+           TwigRoots => { project => $project }
+        );
+
+        my $url = 'http://download.freshmeat.net/backend/fm-projects.rdf.bz2';
+
+        open(INPUT, "GET $url | bzcat |") or die "Can't fetch $url: $!\n";
+        $twig->parse(\*INPUT);
+        close(INPUT);
+
+        $self->{_versions} = $versions;
+    }
+}
+
+sub _version {
+    my ($self, $name) = @_;
+
+    if ($self->{_versions}) {
+        return $self->{_versions}->{$name};
+    } else {
+        my $version;
+
+        my $latest_release_version = sub {
+            $version = $_[1]->text();
+        };
+
+        my $twig = XML::Twig->new(
+            TwigRoots => { latest_release_version => $latest_release_version }
+        );
+
+        my $url = "http://freshmeat.net/projects-xml/$name";
+        
+        open(INPUT, "GET $url |") or die "Can't fetch $url: $!\n";
+        # freshmeat answer with an HTML page when project doesn't exist
+        $twig->safe_parse(\*INPUT);
+        close(INPUT);
+
+        return $version;
+    }
+}
+
+sub _url {
+    my ($self, $name) = @_;
+    return "http://freshmeat.net/projects/$name";
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Updates/Source/GNOME.pm b/lib/Youri/Check/Input/Updates/Source/GNOME.pm
new file mode 100644
index 0000000..381ae5e
--- /dev/null
+++ b/lib/Youri/Check/Input/Updates/Source/GNOME.pm
@@ -0,0 +1,104 @@
+# $Id$
+package Youri::Check::Input::Updates::Source::GNOME;
+
+=head1 NAME
+
+Youri::Check::Input::Updates::Source::GNOME - GNOME updates source
+
+=head1 DESCRIPTION
+
+This source plugin for L<Youri::Check::Input::Updates> collects updates
+available from GNOME.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use LWP::UserAgent;
+use HTML::TokeParser;
+use List::MoreUtils 'any';
+use base 'Youri::Check::Input::Updates::Source';
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Updates::Source::Gnome object.
+
+Specific parameters:
+
+=over
+
+=item url $url
+
+URL to GNOME sources directory (default:
+http://fr2.rpmfind.net/linux/gnome.org/sources)
+
+=back
+
+=cut
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        url => 'http://fr2.rpmfind.net/linux/gnome.org/sources/', # default url
+	# We use HTTP as it offers a better sorting (1.2 < 1.10)
+        @_
+    );
+
+    $self->{_agent} = LWP::UserAgent->new();
+    my $response = $self->{_agent}->get($options{url});
+    if($response->is_success()) {
+        my $parser = HTML::TokeParser->new(\$response->content());
+        while (my $token = $parser->get_tag('a')) {
+            my $href = $token->[1]->{href};
+            next unless $href =~ /^([-\w]+)\/$/o;
+            $self->{_names}->{$1} = 1;
+        }
+    }
+
+    $self->{_url} = $options{url};
+}
+
+sub _version {
+    my ($self, $name) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return unless $self->{_names}->{$name};
+    
+    my $response = $self->{_agent}->get("$self->{_url}/$name/");
+    if($response->is_success()) {
+        my $major;
+        my $parser = HTML::TokeParser->new(\$response->content());
+        while (my $token = $parser->get_tag('a')) {
+            my $href = $token->[1]->{href};
+            next unless $href =~ /^([.\d]+)\/$/o;
+            $major = $1;
+        }
+        return unless $major;
+
+        $response = $self->{_agent}->get("$self->{_url}/$name/$major/");
+        if($response->is_success()) {
+            $parser = HTML::TokeParser->new(\$response->content());
+            while (my $token = $parser->get_tag('a')) {
+                my $href = $token->[1]->{href};
+                next unless $href =~ /^LATEST-IS-([.\d]+)$/o;
+                return $1;
+            }
+        }
+    }
+}
+
+sub _url {
+    my ($self, $name) = @_;
+    return $self->{_url}."$name/";
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Updates/Source/Gentoo.pm b/lib/Youri/Check/Input/Updates/Source/Gentoo.pm
new file mode 100644
index 0000000..9b2473e
--- /dev/null
+++ b/lib/Youri/Check/Input/Updates/Source/Gentoo.pm
@@ -0,0 +1,75 @@
+# $Id: Gentoo.pm 885 2006-04-17 22:25:00Z guillomovitch $
+package Youri::Check::Input::Updates::Source::Gentoo;
+
+=head1 NAME
+
+Youri::Check::Input::Updates::Source::Gentoo - Gentoo updates source
+
+=head1 DESCRIPTION
+
+This source plugin for L<Youri::Check::Input::Updates> collects updates
+available from Gentoo.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use LWP::Simple;
+use base 'Youri::Check::Input::Updates::Source';
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Updates::Source::Gentoo object.
+
+Specific parameters:
+
+=over
+
+=item url $url
+
+URL to Gentoo snapshots directory (default:
+http://gentoo.mirror.sdv.fr/snapshots)
+
+=back
+
+=cut
+
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        url => 'http://gentoo.mirror.sdv.fr/snapshots', # default URL
+        @_
+    );
+
+    my $versions;
+    my $content = get($options{url});
+    my $file;
+    while ($content =~ /<A HREF="(portage-\d{8}.tar.bz2)">/g) {
+        $file = $1;
+    }
+    open(INPUT, "GET $options{url}/$file | tar tjf - |") or croak "Can't fetch $options{url}/$file: $!";
+    while (my $line = <INPUT>) {
+        next unless $line =~ /.*\/([\w-]+)-([\d\.]+)(:?-r\d)?\.ebuild$/;
+        $versions->{$1} = $2;
+    }
+    close(INPUT);
+
+    $self->{_versions} = $versions;
+}
+
+sub _url {
+    my ($self, $name) = @_;
+    return "http://packages.gentoo.org/search/?sstring=$name";
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Updates/Source/NetBSD.pm b/lib/Youri/Check/Input/Updates/Source/NetBSD.pm
new file mode 100644
index 0000000..5142001
--- /dev/null
+++ b/lib/Youri/Check/Input/Updates/Source/NetBSD.pm
@@ -0,0 +1,75 @@
+# $Id$
+package Youri::Check::Input::Updates::Source::NetBSD;
+
+=head1 NAME
+
+Youri::Check::Input::Updates::Source::NetBSD - NetBSD source for updates
+
+=head1 DESCRIPTION
+
+This source plugin for L<Youri::Check::Input::Updates> collects updates
+ available from NetBSD.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use base 'Youri::Check::Input::Updates::Source';
+use IO::Ftp;
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Updates::Source::NetBSD object.
+
+Specific parameters:
+
+=over
+
+=item url $url
+
+URL to NetBSD mirror content file, without ftp: (default: //ftp.free.fr/mirrors/ftp.netbsd.org/NetBSD-current/pkgsrc/README-all.html)
+
+=back
+
+=cut
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        url => '//ftp.free.fr/mirrors/ftp.netbsd.org/NetBSD-current/pkgsrc/README-all.html',
+        @_
+    );
+
+    my $versions;
+    my $urls;
+
+    my $in = IO::Ftp->new('<',$options{url}) or croak "Can't fetch $options{url}: $!";
+    while (my $line = <$in>) {
+        next unless $line =~ /<!-- (.+)-([^-]*?)(nb\d*)? \(for sorting\).*?href="([^"]+)"/;
+        my $name = $1;
+        my $version = $2;
+        $versions->{$name} = $version;
+        $urls->{$name} = $4;
+    }
+    close($in);
+
+    $self->{_versions} = $versions;
+    $self->{_urls} = $urls;
+    $self->{_url} = $options{url};
+}
+
+sub _url {
+    my ($self, $name) = @_;
+    return $self->{_urls}->{$name};
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Updates/Source/RAA.pm b/lib/Youri/Check/Input/Updates/Source/RAA.pm
new file mode 100644
index 0000000..8f820c5
--- /dev/null
+++ b/lib/Youri/Check/Input/Updates/Source/RAA.pm
@@ -0,0 +1,121 @@
+# $Id: RAA.pm 902 2006-04-21 21:44:25Z guillomovitch $
+package Youri::Check::Input::Updates::Source::RAA;
+
+=head1 NAME
+
+Youri::Check::Input::Updates::Source::RAA - RAA updates source
+
+=head1 DESCRIPTION
+
+This source plugin for L<Youri::Check::Input::Updates> collects updates
+available from RAA.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use SOAP::Lite;
+use List::MoreUtils 'any';
+use Youri::Package;
+use base 'Youri::Check::Input::Updates::Source';
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Updates::Source::RAA object.
+
+Specific parameters:
+
+=over
+
+=item url $url
+
+URL to RAA SOAP interface (default:
+http://www.ruby-lang.org/xmlns/soap/interface/RAA/0.0.4)
+
+=back
+
+=cut
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        url => 'http://www.ruby-lang.org/xmlns/soap/interface/RAA/0.0.4/',
+        @_
+    );
+
+    my $raa = SOAP::Lite->service($options{url})
+        or croak "Can't connect to $options{url}";
+    
+    $self->{_raa}   = $raa;
+    $self->{_names} = $raa->names();
+}
+
+sub get_version {
+    my ($self, $package) = @_;
+    croak "Not a class method" unless ref $self;
+
+    my $name;
+    if (ref $package && $package->isa('Youri::Package')) {
+        # don't bother checking for non-ruby packages
+        if (
+            any { $_->[Youri::Package::DEPENDENCY_NAME] =~ /ruby/ }
+            $package->get_requires()
+        ) {
+            $name = $package->get_canonical_name();
+        } else {
+            return;
+        }
+    } else {
+        $name = $package;
+    }
+
+    # translate in grabber namespace
+    $name = $self->get_name($name);
+
+    # return if aliased to null 
+    return unless $name;
+
+    # susceptible to throw exception for timeout
+    eval {
+        my $gem = $self->{_raa}->gem($name);
+        return $gem->{project}->{version} if $gem;
+    };
+
+    return;
+}
+
+sub _url {
+    my ($self, $name) = @_;
+    return "http://raa.ruby-lang.org/project/$name/";
+}
+
+sub _name {
+    my ($self, $name) = @_;
+
+    if (ref $self) {
+        my $match = $name;
+        $match =~ s/^ruby[-_]//;
+        $match =~ s/[-_]ruby$//;
+        my @results =
+            grep { /^(ruby[-_])?\Q$match\E([-_]ruby)$/ }
+            @{$self->{_names}};
+        if (@results) {
+            return $results[0];
+        } else {
+            return $name;
+        }
+    } else {
+        return $name;
+    }
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Input/Updates/Source/Sourceforge.pm b/lib/Youri/Check/Input/Updates/Source/Sourceforge.pm
new file mode 100644
index 0000000..9a3305c
--- /dev/null
+++ b/lib/Youri/Check/Input/Updates/Source/Sourceforge.pm
@@ -0,0 +1,103 @@
+# $Id: Sourceforge.pm 908 2006-05-12 21:16:08Z pterjan $
+package Youri::Check::Input::Updates::Source::Sourceforge;
+
+=head1 NAME
+
+Youri::Check::Input::Updates::Source::Sourceforge - Sourceforge updates source
+
+=head1 DESCRIPTION
+
+This source plugin for L<Youri::Check::Input::Updates> collects updates
+available from Sourceforge.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use LWP::UserAgent;
+use HTML::TokeParser;
+use Youri::Check::Input::Updates;
+use base 'Youri::Check::Input::Updates::Source';
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Updates::Source::Sourceforge
+object.  
+
+No specific parameters.
+
+=cut
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        @_
+    );
+
+    $self->{_agent} = LWP::UserAgent->new();
+}
+
+sub get_version {
+    my ($self, $package) = @_;
+    croak "Not a class method" unless ref $self;
+
+    my $name;
+    if (ref $package && $package->isa('Youri::Package')) {
+        # don't bother checking for packages without sf.net URL
+        my $url = $package->get_url();
+        if (
+            $url =~ /http:\/\/(.*)\.sourceforge\.net/ ||
+            $url =~ /http:\/\/.*sourceforge\.net\/projects\/([^\/]+)/
+        ) {
+            $name = $package->get_canonical_name();
+        } else {
+            return;
+        }
+    } else {
+        $name = $package;
+    }
+
+    # translate in grabber namespace
+    $name = $self->get_name($name);
+
+    # return if aliased to null 
+    return unless $name;
+
+    my $response = $self->{_agent}->get($self->_url($name));
+    if($response->is_success()) {
+        my $max = 0;
+        my $parser = HTML::TokeParser->new(\$response->content());
+        while (my $token = $parser->get_tag('a')) {
+            my $text = $parser->get_trimmed_text("/$token->[0]");
+            next unless $text;
+            next unless $text =~ /^
+                \Q$name\E
+                [._-]?($Youri::Check::Input::Updates::VERSION_REGEXP)
+                [._-]?(w(?:in)?(?:32)?|mips|sparc|bin|ppc|i\d86|src|sources?)?
+                \.(?:tar\.(?:gz|bz2)|tgz|zip)
+                $/iox;
+            my $version = $1;
+            my $arch    = $2;
+            next if $arch && $arch !~ /(src|sources?)/;
+            $max = $version if Youri::Check::Input::Updates::is_newer($version, $max);
+        }
+        return $max if $max;
+    }
+    return;
+}
+
+sub _url {
+    my ($self, $name) = @_;
+    return "http://prdownloads.sourceforge.net/$name/";
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;