diff options
Diffstat (limited to 'lib/Youri/Check/Input/Updates/Source/RAA.pm')
-rw-r--r-- | lib/Youri/Check/Input/Updates/Source/RAA.pm | 121 |
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; |