URI::virtual - virtual URI, refers to a list of prefixes.


LWP-Protocol-virtual documentation Contained in the LWP-Protocol-virtual distribution.

Index


Code Index:

NAME

Top

URI::virtual - virtual URI, refers to a list of prefixes.

VERSION

Top

Version 0.02

package URI::virtual;

REQUIRES

Top

URI::http, Carp

SYNOPSIS

Top

 #
use lib "$ENV{PWD}/lib";
use URI;
use Data::Dumper;
my @uris = (
	URI->new("virtual://CPAN/authors/"),
	map { URI->new("virtual://CPAN/modules/")->resolve() } 1 .. 5,
);
for ( @uris ) {
	print ref, " => ", $_, "\n";
};
__DATA__
#my config
CPAN 	ftp://mirror.hiwaay.net/CPAN/ 
CPAN	ftp://csociety-ftp.ecn.purdue.edu/pub/CPAN
CPAN	ftp://cpan.mirrors.redwire.net/pub/CPAN/
#include /usr/portage/profiles/thirdpartymirrors
#my results
URI::virtual => virtual://CPAN/authors/
URI::ftp => ftp://cpan.mirrors.redwire.net/pub/CPAN///modules/
URI::ftp => ftp://cpan.mirrors.redwire.net/pub/CPAN///modules/
URI::ftp => ftp://csociety-ftp.ecn.purdue.edu/pub/CPAN//modules/
URI::ftp => ftp://csociety-ftp.ecn.purdue.edu/pub/CPAN//modules/
URI::ftp => ftp://cpan.mirrors.redwire.net/pub/CPAN///modules/




load_lists accepts a list of filenames, and adds their contents to the lookup table.


LWP-Protocol-virtual documentation Contained in the LWP-Protocol-virtual distribution.
# vim: ts=4 sw=4

package URI::virtual;

our $VERSION = '0.02';
use warnings;
use URI::http;
our(@ISA) = qw(URI::http);


#private
use strict;
my @defaults = qw( ~/.lwp_virt );
my %lists;

sub fail {
	require "Carp";
	goto &Carp::confess;
};
sub lists {
	%lists = ();
	@defaults = @_;
	load_lists();
};
sub load_lists(@) {
	## discard self if called as method.  What would Sigmond say?
	my $self = shift if ref $_[0];
	local (@_,$_) = map { split } ( @_, @defaults );
	while ( @_ ) {
		$_ = shift;
		s/^~/$ENV{HOME}/;
		my $MAP;
		unless (open($MAP,$_)){
			warn("open:$_:$!\n");
			next;
		};
		while(<$MAP>){
			my ( $name, @urls ) = split;
			next unless defined($name);
			if ( $name eq "#include" ) {
				push(@_, @urls);
			} else {
				my $list = \$lists{$name};
				$$list=[] unless $$list;
				push(@{$$list},grep s{/*$}{}, @urls);
			};
		}
		close($MAP) or warn "error reading";
	};
};
sub resolve() {
	my $self = shift;
	die "I demand a paternity test!" unless $self->isa("URI::virtual");
	$self->load_lists();
	die "invalid scheme" unless $self->scheme eq 'virtual';
	my $name = $self->host();
	die "invalid host" unless defined $name;
	my $list = $lists{$name};
	die "no list for $name" unless  ( $list );
	my $mirr = $list->[int(rand(@{$list}))];
	unless ( defined $mirr ) {
		die "no urls for $name";
	};
	return URI->new( $mirr . $self->path() )->canonical();
};
1;