blob: 7623b3bfd5c82799709789a6ca9cd4f2e9622279 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
# $Id: Sourceforge.pm 1179 2006-08-05 08:30:57Z warly $
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;
|
