view release on metacpan or  search on metacpan

lib/App/FuguVM/Proxy.pm  view on Meta::CPAN

# name at the end, so a directory listing with a trailing solidus
# stays outside the cache. It filters no extension, because a
# distfile carries every extension and sometimes none.
my $DISTFILE = qr{/pub/OpenBSD/distfiles/(?:[^/]+/)*[^/]+$};

# $class->new($cache_dir, $limit):
#	Build the cache. The optional limit is the distfile cap in
#	bytes, and 0 turns the distfile cache off.
sub new ( $class, $cache_dir, $limit = 0 )
{
	my $self = $class->SUPER::new(
		dir       => $cache_dir,
		cacheable => sub ($url) { _is_openbsd_content( $url, $limit ) },
		types     => {

			# A kernel has no extension, so the generic
			# table cannot name it
			qr{/bsd(\.mp|\.rd)?$} => 'application/octet-stream',
		},
	);
	$self->{distfile_limit} = $limit;

lib/App/FuguVM/Proxy.pm  view on Meta::CPAN

	return 0;
}

# $self->store($url, $content):
#	Store one response body, and hold the distfile tree under the
#	cap after a distfile store. A set store must not walk the
#	distfile tree.
sub store ( $self, $url, $content )
{
	my $path = $self->SUPER::store( $url, $content );
	return if !defined $path;

	$self->trim_distfiles if $url =~ $DISTFILE;

	return $path;
}

# $self->distfile_limit:
#	Return the distfile cap in bytes.
sub distfile_limit ($self)

t/fuguvm/diskcache.t  view on Meta::CPAN

# A cache whose two file-backed key inputs live in a scratch
# directory. Thus tests can rotate them and never touch the checkout.
package TestInputs;

# The inheritance must be in place before the tests above run
BEGIN { our @ISA = ('App::FuguVM::DiskCache'); }

sub new ( $class, $cache_dir, $input_dir )
{
	my $self = $class->SUPER::new($cache_dir);
	$self->{input_dir} = $input_dir;
	return $self;
}

sub _driver_script ( $self, $name )
{
	my $path = "$self->{input_dir}/$name";
	return -f $path ? $path : undef;
}