imported initial version of youri svn

1 files changed, 121 insertions, 0 deletions

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;