diff options
Diffstat (limited to 'lib/Youri/Check/Input/Updates/Source/Sourceforge.pm')
-rw-r--r-- | lib/Youri/Check/Input/Updates/Source/Sourceforge.pm | 103 |
1 files changed, 103 insertions, 0 deletions
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; |