view release on metacpan or  search on metacpan

lib/Carrot/Meta/Greenhouse/Writable_Overlay.pm  view on Meta::CPAN

				$logical = delete($xedni->{$redirected});
				delete($index->{$logical});
				$deleted += 1;

			} else {
				unless (substr($logical, 0, 1) eq '/')
				{
					$logical = $prefix.$logical;
				}
				$index->{$logical} = $redirected;
				$xedni->{$redirected} = $logical
			}

			$highest_id = $id;

		} else {
			die($line);
		}
	}
	$highest_id = int($highest_id);

#	if ($deleted > 1_000)
#	{
#		recreate_index();
#	}
	return;
}

sub recreate_index
# /type method
# /effect ""
# //parameters
# //returns
{
	create_index();
	my $keys = [sort(keys($index))];
	foreach my $key (@$keys)
	{
		update_index($index->{$key}, $key);
	}

	return;
}

sub create_index
# /type method
# /effect ""
# //parameters
# //returns
{
	print STDERR "CREATE CACHE $index_file\n" if (TRACE_FLAG);

	my $datetime = scalar(gmtime(time()));
	$file_content->overwrite_from($index_file,
		"# Automatically created on $datetime GMT.\n"
		."# Manual changes will get lost.\n");

	return;
}

sub update_index
# /type method
# /effect ""
# //parameters
# //returns
{
	my ($this, $id, $file_name) = @ARGUMENTS;

	if (substr($file_name, 0, 1) ne '/')
	{
			$prefix = '';
			$prefix_fnl = 1;

	} elsif (substr($file_name, 0, $prefix_fnl) ne $prefix)
	{
		foreach my $directory (@MODULE_SEARCH_PATH)
		{
			next unless (substr($file_name, 0, length($directory)) eq $directory);
			$prefix = $directory.'/';
			$prefix_fnl = length($prefix);
			$file_content->append_from($index_file, $prefix."\n");
			$file_name = substr($file_name, $prefix_fnl);
			last;
		}
	} else {
		$file_name = substr($file_name, $prefix_fnl);
	}
	$file_content->append_from($index_file, "$id\t$file_name\n");

	return;
}

sub redirect_read
# /type method
# /effect ""
# //parameters
#	file_name
# //returns
{
	my ($this, $file_name) = @ARGUMENTS;

	return(IS_FALSE) unless (REDIRECT_FLAG);
	return(IS_FALSE) unless (exists($index->{$$file_name}));
#	return(IS_FALSE) if (substr($$file_name, 0, $cache_fnl) eq $cache);

	print STDERR "CACHE HIT $$file_name\n" if (TRACE_FLAG);
	$$file_name = "$cache/$index->{$$file_name}";

	return(IS_TRUE);
}

sub direct_read
# /type method
# /effect ""
# //parameters
#	file_name
# //returns
{
	my ($this, $file_name) = @ARGUMENTS;

	return(IS_UNDEFINED) unless (REDIRECT_FLAG);