Mirror-URI

 view release on metacpan or  search on metacpan

lib/Mirror/URI.pm  view on Meta::CPAN

	# Find the file within the root path
	my %self = (
		uri => URI->new($class->filename)->abs($base)->canonical,
	);

	# Pull the file and time it
	$self{lastget} = Time::HiRes::time;
	$self{string}  = LWP::Simple::get($self{uri});
	$self{lag}     = Time::HiRes::time - $self{lastget};
	unless ( defined $self{string} ) {
		return $class->new( %self, valid => 0 );
	}

	# Parse the file
	my $hash = $class->parse( $self{string} );
	unless ( ref $hash eq 'HASH' ) {
		return $class->new( %self, valid => 0 );
	}

	$class->new( %$hash, %self, valid => 1 );
}





#####################################################################
# Populate Elements

sub get_master {
	my $self = shift;
	if ( _INSTANCE($self->master, 'URI') ) {
		# Load the master
		my $master = $self->class->get($self->master);
		$self->{master} = $master;
	}
	return $self->master;
}

sub get_mirror {
	my $self = shift;
	my $i    = shift;
	my $uri  = $self->{mirrors}->[$i];
	unless ( defined $uri ) {
		Carp::croak("No mirror with index $i");
	}
	if ( _INSTANCE($uri, 'URI') ) {
		my $mirror = $self->class->get($uri);
		$self->{mirrors}->[$i] = $mirror;
	}
	return $self->{mirrors}->[$i];
}





#####################################################################
# High Level Methods

sub update {
	my $self = shift;

	# Handle various shortcuts
	unless ( $self->valid ) {
		Carp::croak("Cannot update invalid mirror");
	}
	if ( $self->is_master ) {
		return 1;
	}

	# Pull the master and overwrite ourself with it
	my $master = $self->get_master;
	unless ( _INSTANCE($master, $self->class) ) {
		Carp::croak("Failed to fetch master record");
	}

	# Overwrite the current version with the master
	foreach ( qw{
		version uri name lastget timestamp
		mirrors lag valid master
	} ) {
		$self->{$_} = delete $master->{$_};
	}

	return 1;
}

# Get all the mirrors
sub get_mirrors {
	my $self    = shift;
	my $mirrors = $self->{mirrors};
	foreach ( 0 .. $#$mirrors ) {
		$self->get_mirror($_);
	}
	return 1;
}

1;

__END__

=pod

=head1 NAME

Mirror::URI - Mirror Configuration and Auto-Discovery

=head1 DESCRIPTION

B<Mirror::URI> is an abstract base class for the mirror
auto-discovery modules L<Mirror::YAML> and L<Mirror::JSON>.

See their documentation for more details.

=head1 SUPPORT

Bugs should be reported via the CPAN bug tracker at

L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Mirror-URI>



( run in 0.632 second using v1.01-cache-2.11-cpan-0bb4e1dffa6 )