# vim: ts=4 sw=4 =head1 NAME URI::virtual - virtual URI, refers to a list of prefixes. =cut package URI::virtual; =head1 VERSION Version 0.02 =cut our $VERSION = '0.02'; =pod package URI::virtual; =head1 REQUIRES URI::http, Carp =cut use warnings; use URI::http; our(@ISA) = qw(URI::http); =head1 SYNOPSIS # 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/ =cut #private use strict; my @defaults = qw( ~/.lwp_virt ); my %lists; sub fail { require "Carp"; goto &Carp::confess; }; =function lists accepts a list of files, and uses the contents of those files as the the package's lookup table. =cut sub lists { %lists = (); @defaults = @_; load_lists(); }; =function load_lists load_lists accepts a list of filenames, and adds their contents to the lookup table. =cut 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"; }; }; =function resolve returns a randomly selected concrete uri for a given URI::virtual object. =cut 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;