# vim: ts=4 sw=4
package LWP::Protocol::virtual;
use warnings;
use strict;
=head1 NAME
LWP::Protocol::virtual - Protocol to locate resources on groups of sites
=head1 VERSION
Version 0.02
=cut
our $VERSION = '0.02';
use LWP::Protocol;
use HTTP::Status qw( RC_BAD_REQUEST RC_FOUND );
use Carp qw(confess);
use Data::Dumper;
use strict;
our (@ISA) = qw(LWP::Protocol);
=head1 SYNOPSIS
#
## From shell, not perl.
cpan URI::virtual
echo 'CPAN http://cpan.mirror.com/pub/CPAN' > ~/.lwp_virt
GET virtual://CPAN/some/path/some-path-1.0.tgz > some-path-1.0.tgz
perl -MCPAN -e '
my $CPAN = CPAN->new();
CPAN::Config->load($CPAN);
$CPAN::Config->{urllist} = [ qw(virtual://CPAN/) ];
CPAN::Config->commit("MyConfig.pm");
'
## Move MyConfig to somewhere CPAN will find it.
=head1 FUNCTIONS
=head2 request
This processes a request, by calling $uri->resolve on the URI object
(which one would suspect is an instalnce of URI::virtual, and therefore
supports it) and returning a redirect to the uri returned. Any URI
subclass which satisfies the conditions:
$uri->can("resolve")->()->isa("URI")
ref $uri->can("path") eq 'CODE'
will be acceptable. How you would tell LWP to use this Protocol
for another scheme is anybody's guess.
see URI::virtual.
=cut
sub request {
my ($self, $req, $res) = (shift,shift);
$res = HTTP::Response->new(RC_FOUND);
$res->header("Location" => $req->uri()->resolve());
return $res;
};
1;
=head1 AUTHOR
Rich Paul, C<< <cpan@rich-paul.net> >>
Mail to this address bounces, but you'll think of something.
It's a poor man's Turing Test.
=head1 BUGS
Please report any bugs or feature requests to
C<bug-lwp-protocol-virtual@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LWP-Protocol-virtual>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.
=head1 ACKNOWLEDGEMENTS
The guys who wrote LWP. Nice job!
=head1 COPYRIGHT & LICENSE
Copyright 2005 Rich Paul, All Rights Reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1; # End of LWP::Protocol::virtual