1 files changed, 82 insertions, 0 deletions
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..24582a9
--- /dev/null
+++ b/lib/Youri/Check/Input/Updates/Source/Debian.pm
@@ -0,0 +1,82 @@
+# $Id: Debian.pm 1179 2006-08-05 08:30:57Z warly $
+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;