diff options
Diffstat (limited to 'lib/Youri/Check/Maintainer/Resolver/CGI.pm')
-rw-r--r-- | lib/Youri/Check/Maintainer/Resolver/CGI.pm | 79 |
1 files changed, 79 insertions, 0 deletions
diff --git a/lib/Youri/Check/Maintainer/Resolver/CGI.pm b/lib/Youri/Check/Maintainer/Resolver/CGI.pm new file mode 100644 index 0000000..21357b8 --- /dev/null +++ b/lib/Youri/Check/Maintainer/Resolver/CGI.pm @@ -0,0 +1,79 @@ +# $Id: CGI.pm 1179 2006-08-05 08:30:57Z warly $ +package Youri::Check::Maintainer::Resolver::CGI; + +=head1 NAME + +Youri::Check::Maintainer::Resolver::CGI - CGI-based maintainer resolver + +=head1 DESCRIPTION + +This is a CGI-based L<Youri::Check::Maintainer::Resolver> implementation. + +It uses a remote CGI to resolve maintainers. + +=cut + +use warnings; +use strict; +use Carp; +use base 'Youri::Check::Maintainer::Resolver'; + +=head1 CLASS METHODS + +=head2 new(%args) + +Creates and returns a new Youri::Check::Maintainer::Resolver::CGI object. + +Specific parameters: + +=over + +=item url $url + +CGI's URL. + +=back + +=cut + +sub _init { + my $self = shift; + my %options = ( + url => '', # url to fetch maintainers + @_ + ); + + croak "No URL given" unless $options{url}; + + open (INPUT, "GET $options{url} |"); + while (<INPUT>) { + chomp; + my ($package, $maintainer) = split(/\t/, $_); + $self->{_maintainers}->{$package} = $maintainer if $maintainer; + } + close(INPUT); +} + +sub get_maintainer { + my ($self, $package) = @_; + croak "Not a class method" unless ref $self; + + print "Retrieving package $package maintainer\n" + if $self->{_verbose} > 0; + + my $name = ref $package && $package->isa('Youri::Package') ? + $package->get_canonical_name() : + $package; + + return $self->{_maintainers}->{$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; |