#! /usr/bin/perl

# 
# Copyright 1999-2006 University of Chicago
# 
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
# 
# http://www.apache.org/licenses/LICENSE-2.0
# 
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# 

use warnings;
use strict;

my $prefix;
my $exec_prefix;
my $sbindir;
my $bindir;
my $libdir;
my $includedir;
my $datarootdir;
my $datadir;
my $libexecdir;
my $sysconfdir;
my $sharedstatedir;
my $localstatedir;
my $perlmoduledir;

BEGIN {
    $prefix="@prefix@";
    if ($ENV{GLOBUS_LOCATION}) {
        $prefix = $ENV{GLOBUS_LOCATION};
    }
    $exec_prefix="@exec_prefix@";
    $sbindir="@sbindir@";
    $bindir="@bindir@";
    $libdir="@libdir@";
    $includedir="@includedir@";
    $datarootdir="@datarootdir@";
    $datadir="@datadir@";
    $libexecdir="@libexecdir@";
    $sysconfdir="@sysconfdir@";
    $sharedstatedir="@sharedstatedir@";
    $localstatedir="@localstatedir@";
    $perlmoduledir = "@perlmoduledir@";

    unshift(@INC, $perlmoduledir);
}

$ENV{PATH} = $ENV{PATH}.":$bindir:$sbindir";

# Prototypes
sub main( @ );
sub GassCacheList ( );
sub GassCacheListNormal ( );
sub GassCacheListFlat ( );
sub GassCacheCleanupUrl ( );
sub GassCacheCleanupUrlNormal ( );
sub GassCacheCleanupUrlFlat ( );
sub GassCacheFlatDir ( $ );
sub DumpHelp( );


# ******************************************************
# Command line options
# ******************************************************
my $PerlOperations =<<END_OPERATIONS;
    -cleanup-url   - remove all tags for an URL in the cache
                     This operation requires that the URL be specified on
                     the command line.
    -list          - list the contents of the cache.
                     If either the [-t tag] or a URL is specified on the
                     command line, then only cache entries which match
                     those will be listed
END_OPERATIONS
my $PerlOptions =<<END_OPTIONS;
END_OPTIONS

my $Program = $0;
my $ProgramC = 'globus-gass-cache-util';
my $Verbose = 0;


# Option flags
my $OptionLong = 0;

# C Program flags & args
my @CprogFlags = (
		  '-a', '-add',
		  '-d', '-delete',
		  '-dirs',
		  '-m', '-mangle',
		  '-q', '-query',
		  '-cleanup-tag',
		  );
my $CprogFlagsRE =
    '(' . join( ')|(', @CprogFlags ) . ')';

# C Program flags & args
my @CprogArgs = (
		 '-r', '-resource',
		 '-n', '-newname',
		 '-t', '-tag' );
my $CprogArgsRE =
    '(' . join( ')|(', @CprogArgs ) . ')';

# Arguments that the "C" _doesn't_ understand, and need to be stripped
# off before we punt to the C program
my @CprogNonArgs = (
		    '-l', '-list',
		    '-cleanup-url',
		   );
my $CprogNonArgsRE =
    '(' . join( ')|(', @CprogNonArgs ) . ')';

# The manglings we know about..
my @Manglings = ( 'html', 'md5' );

# Hash of the "Root" directories & other cache info
my %CacheInfo;

# Make stdout sane
$|=1;

# Store the settings to use
my %Settings = (
		Url => '',		# URL to process
		MangleUrl => '',	#  Mangled version
		Tag => '',		# Tag to process
		MangledTag => '',	#  Mangled version
	       );

# Invoke "main"
main( @ARGV );

# "Main" logic
sub main( @ )
{
    # Empty command line; punt it
    if ( $#_ < 0 )
    {
	exec ( "$ProgramC", @_ );
    }

    # Build list of C program arguments..
    my @CprogArgv = grep{!/^$CprogNonArgsRE$/} @_;

    # Help; punt + our own processing...
    if ( grep( /^-help$/, @_ ) >= 1 )
    {
	DumpHelp();
	exit 0;
    }

    # Walk through the command line
    my @JobList;
    my $ArgNo;
    my $Skip = 0;
    for ($ArgNo = 0; $ArgNo <= $#_; $ArgNo++)
    {
	my $Arg = $_[$ArgNo];
	if ( $Skip > 0 )
	{
	    $Skip--;
	    next;
	}

	if ( ( $Arg eq '-l' ) || ( $Arg eq '-list' ) )
	{
	    push @JobList, 'list';
	}
	elsif ( ( $Arg eq '-cu' ) || ( $Arg eq '-cleanup-url' ) )
	{
	    push @JobList, 'cleanup-url';
	}
	elsif ( $Arg eq '-long' )
	{
	    $OptionLong = 1;
	}
	elsif ( ( $Arg eq '-v' ) || ( $Arg eq '-verbose' ) )
	{
	    $Verbose++;
	}
	elsif ( ( $Arg eq '-t' ) || ( $Arg eq '-tag' ) )
	{
	    if ( $ArgNo >= $#_ )
	    {
		print STDERR "-tag: no tag specified!\n";
		die;
	    }
	    $Settings{Tag} = $_[$ArgNo+1];
	    $Skip = 1;
	}
	elsif ( $Arg =~ /^($CprogFlagsRE)$/ )
	{
	    # Invoke the C program
	    exec ( "$ProgramC", @CprogArgv );
	}
	elsif ( $Arg =~ /^($CprogArgsRE)$/ )
	{
	    # Skip next arg...
	    $ArgNo++;
	}
	elsif ( $Arg =~ /^-/ )
	{
	    # Not sure what the hell it is, punt it off to the C prog...
	    exec ( "$ProgramC", @CprogArgv );
	}
	# Must be the URL
	else
	{
	    $Settings{Url} = $Arg;
	}
    }

    # Did we do anything?  If not, punt to the C program...
    if ( $#JobList < 0 )
    {
	exec ( "$ProgramC", @CprogArgv ) || die "exec $ProgramC";
    }

    # Ok, here we have real work to do..
    $#_ = -1;

    # Disable debugging output while learnging about the cache...
    {
	local $ENV{GLOBUS_GASS_CACHE_DEBUG};
	delete( $ENV{GLOBUS_GASS_CACHE_DEBUG} );

	# Get the cache type...
	my $Cmd = "$ProgramC -type";
	open( TYPE, "$Cmd|" ) || die "Can't run '$Cmd'";
	while ( <TYPE> )
	{
	    chomp;
	    if ( /^CACHE_TYPE: '(.*)'/o )
	    {
		$CacheInfo{CACHE_TYPE} = $1;
	    }
	}
	close( TYPE );
	die "Cache type unknown" if ( ! exists $CacheInfo{CACHE_TYPE} );

	# Get the main cache directory
	$Cmd = "$ProgramC -dirs";
	open( DIRS, "$Cmd|" ) || die "Can't run '$Cmd'";
	while ( <DIRS> )
	{
	    if ( /^CACHE_DIRECTORY: '(.*)'/o )
	    {
		$CacheInfo{CACHE_DIR} = $1;
	    }
	    elsif ( /^(\w+_ROOT): '(.*)'/o )
	    {
		$CacheInfo{$1} = $2;
	    }
	}
	close( DIRS );
    }

    # Mangle the URLs
    if ( $Settings{Url} ne '' )
    {
	$Settings{MangledUrl} = Mangle( $Settings{Url} )
    }
    # Mangle the Tags
    if ( $Settings{Tag} ne '' )
    {
	$Settings{MangledTag} = Mangle( $Settings{Tag} );
    }

    # Do the work...
    foreach my $Job ( @JobList )
    {
	if ( $Job eq 'list' )
	{
	    GassCacheList( );
	}
	elsif ( $Job eq 'cleanup-url' )
	{
	    GassCacheCleanupUrl( );
	}
    }

}   # End of logical "main"
# ******************************************************

# ******************************************************
# Function: GassCacheList()
#
# Description:
#	List the contents of the Cache
#
# Parameters:
#  None
#
# Return Values:
#  None
#
# ******************************************************
sub GassCacheList ( )
{
    my $Settings = shift;

    # Check the type & invoke the proper
    if ( $CacheInfo{CACHE_TYPE} eq 'normal' )
    {
	print "-- Normal cache --\n" if ( $Verbose );
	GassCacheListNormal( );
    }
    elsif ( $CacheInfo{CACHE_TYPE} eq 'flat' )
    {
	print "-- Flat cache --\n" if ( $Verbose );
	GassCacheListFlat( );
    }
    else
    {
	printf STDERR "Unknown cache type '%s'\n", $CacheInfo{CACHE_TYPE};
    }

}   # GassCacheList()
# ******************************************************

# ******************************************************
# Function: GassCacheListNormal()
#
# Description:
#	List the contents of the Cache "Normal" mode
#
# Parameters:
#  None
#
# Return Values:
#  None
#
# ******************************************************
sub GassCacheListNormal ( )
{

    # Verify the directories
    die "No GLOBAL root" if ( ! defined $CacheInfo{GLOBAL_ROOT} );
    die "No LOCAL root" if ( ! defined $CacheInfo{LOCAL_ROOT} );

    # This will be used several times...
    my $Cmd;


    # *************************************************
    # Now, let's do the real fun...
    #  Scan through the global directory for all URLs
    # *************************************************
    print "Scanning the global entries in $CacheInfo{GLOBAL_ROOT}\n" if( $Verbose );
    my %Global;
    $Cmd = "find $CacheInfo{GLOBAL_ROOT} -name \"data*\" -print";
    foreach my $FullPath (`$Cmd` )
    {
	chomp $FullPath;
	my @Stat = stat( $FullPath );
	my $Inode = $Stat[1];
	my $Size = $Stat[7];

	# And, let's get it's directory
	my @Dirs = split( /\//, $FullPath );
	$#Dirs--;
	my $Dir = join( "/", @Dirs );

	# Read the URL from the "url" file
	my $Url = "";
	if ( open( URL, "$Dir/url" ) )
	{
	    $Url = <URL>; chomp $Url;
	    close( URL );
	}

	# Pull out it's mangled dir
	my $Mangled = $Dir;
	$Mangled =~ s/$CacheInfo{GLOBAL_ROOT}\///;

	# Store it all in a (perl) hash
	my $r = ();
	$r->{Inode} = $Inode;
	$r->{Size} = $Size;
	$r->{Url} = $Url;
	$r->{Mangled} = $Mangled;
	$r->{Dir} = $Dir;
	$Global{$Inode} = $r;
	$r = ();
    }
    close( FIND );


    # ******************************************
    # Scan through the local directory, now..
    # ******************************************
    print "Scanning the local entries in $CacheInfo{LOCAL_ROOT}\n" if( $Verbose );
    my %Local;
    $Cmd = "find $CacheInfo{LOCAL_ROOT} -name \"data*\" -print";
    foreach my $FullPath (`$Cmd` )
    {
	chomp $FullPath;
	my @Stat = stat( $FullPath );
	my $Inode = $Stat[1];
	my $Size = $Stat[7];

	# Get the directory portion of the path
	my @Dirs = split( /\//, $FullPath );
	$#Dirs--;
	my $Dir = join( "/", @Dirs );

	# Read the tag from the tag file..
	my $Tag = "";
	if ( open( TAG, "$Dir/tag" ) )
	{
	    $Tag = <TAG>;
	    close( TAG );
	}

	# Strip the local dir portion off the hash
	my $Mangled = $Dir;
	$Mangled =~ s/$CacheInfo{LOCAL_ROOT}\///;

	# There *should* be a matching global... Let's look
	my $MangledOk = 0;
	if ( defined( $Global{$Inode} ) )
	{
	    my $GlobalMangled = $Global{$Inode}->{Mangled};
	    $Mangled =~ s/\/$GlobalMangled//;
	    $MangledOk = 1;
	}
	# Otherwise, we should be able to get the hash from the tag..
	elsif ( $Tag ne "" )
	{
	    my $Cmd = "$ProgramC -t $Tag -m";
	    if ( open ( MANGLE, "$Cmd|" ) )
	    {
		while( <MANGLE> )
		{
		    if ( /^TAG: '(.*)'/ )
		    {
			$Mangled = $1;
			$MangledOk = 1;
		    }
		}
		close( MANGLE );
	    }
	}

	# Otherwise, let's make some guesses..
	if ( ! $MangledOk )
	{
	    # Should currently be something like: md5/local/md5/global
	    foreach my $GlobalStr ( @Manglings )
	    {
		$GlobalStr = "/" . $GlobalStr . "/";
		my $GlobalStart = rindex( $Mangled, $GlobalStr );
		if ( $GlobalStart > 0 )
		{
		    $Mangled = substr( $Mangled, 0, $GlobalStart );
		    last;
		}
	    }
	}

	# Store it all away in an Inode based hash of arrays
	my $r = ();
	$r->{Inode} = $Inode;
	$r->{Size} = $Size;
	$r->{Tag} = $Tag;
	$r->{Mangled} = $Mangled;
	$r->{Dir} = $Dir;
	push( @{$Local{$Inode}}, $r );
	$r = ();
    }


    # ********************
    # Dump it all out..
    # ********************
    if ( $Verbose )
    {
	print "Matching URL=$Settings{Url}\n" if ( $Settings{Url} ne "" );
	print "Matching Tag=$Settings{Tag}\n" if ( $Settings{Tag} ne "" );
    }
    foreach my $Inode ( keys %Global )
    {
	# Does it match??
	next if (  ( $Settings{MangledUrl} ) &&
		   ( $Settings{MangledUrl} ne $Global{$Inode}->{Mangled} )  );
	if ( $Settings{Tag} ne "" )
	{
	    my $Match = 0;
	    foreach my $Local ( @{$Local{$Inode}} )
	    {
		if ( $Local->{Tag} eq $Settings{Tag} )
		{
		    $Match++;
		    last;
		}
	    }
	    next if ( ! $Match );
	}

	# Matching URL found
	print "URL: $Global{$Inode}->{Url}\n";
	if ( $OptionLong )
	{
	    print "\tSize: $Global{$Inode}->{Size}\n";
	    print "\tMangled: $Global{$Inode}->{Mangled}\n";
	}
	foreach my $Local ( @{$Local{$Inode}} )
	{
	    next if (  ( $Settings{Tag} ne "" ) && ( $Local->{Tag} ne $Settings{Tag} ) );

	    print "\tTag:" . $Local->{Tag} . "\n";
	}
    }

}   # GassCacheListNormal()
# ******************************************************

# ******************************************************
# Function: GassCacheListFlat()
#
# Description:
#	List the contents of the Cache "Flat" mode
#
# Parameters:
#  None
#
# Return Values:
#  None
#
# ******************************************************
sub GassCacheListFlat ( )
{

    # Requested URL logic
    my $ReqUrl = $Settings{Url};
    my $ReqUrlKey = "";
    if ( $Settings{MangledUrl} ne "" )
    {
	my @UrlKey;
	( $ReqUrlKey, @UrlKey ) = split( /_/, $Settings{MangledUrl} );
	$ReqUrlKey = join( "_", @UrlKey );
    }

    # Requested Tag logic
    my $ReqTag = $Settings{Tag};
    my $ReqTagKey = "";
    if ( $Settings{MangledTag} ne "" )
    {
	my @TagKey;
	( $ReqTagKey, @TagKey ) = split( /_/, $Settings{MangledTag} );
	$ReqTagKey = join( "_", @TagKey );
    }


    # *************************************************
    # Now, let's do the real fun...
    #  Scan through the global directory for all URLs
    # *************************************************
    my %Dir;
    GassCacheFlatDir( \%Dir );


    # ********************
    # Dump it all out..
    # ********************
    if ( $Verbose )
    {
	print "Matching URL=$ReqUrl K=$ReqUrlKey\n";
	print "Matching Tag=$ReqTag K=$ReqTagKey\n";
    }
    foreach my $Type ( keys %{$Dir{MangleTypes}} )
    {
	foreach my $UrlKey ( keys %{$Dir{Urls}{$Type}} )
	{
	    # Does it match the request????
	    next if (  ( $ReqUrlKey ne "" ) &&
		       ( $ReqUrlKey ne $Dir{Urls}{$Type}{$UrlKey}{Data}->{Mangled} )  );
	    next if (  ( $ReqTagKey ne "" ) &&
		       ( ! exists $Dir{Urls}{$Type}{$UrlKey}{TagKeys}{$ReqTagKey} )  );

	    print "URL: " . $Dir{Urls}{$Type}{$UrlKey}{Url}->{Text} . "\n";
	    if ( $OptionLong )
	    {
		print "\tSize: " .
		    $Dir{Urls}{$Type}{$UrlKey}{Data}->{Size} . "\n";
		print "\tMangled: " .
		    $Dir{Urls}{$Type}{$UrlKey}{Data}->{Mangled} . "\n";
	    }

	    my @TagKeys = keys %{$Dir{Urls}{$Type}{$UrlKey}{TagKeys}};
	    foreach my $TagType ( keys %{$Dir{MangleTypes}} )
	    {
		foreach my $TagKey ( @TagKeys )
		{
		    next if ( ! exists $Dir{Tags}{$TagType}{$TagKey} );
		    next if (  ( $ReqTagKey ne "" ) && ( $ReqTagKey ne $TagKey ) );

		    my $r = $Dir{Tags}{$TagType}{$TagKey};
		    print "\tTag: $r->{Tag}->{Text}\n";

		    # Sanity check...
		    if ( ! exists $r->{Keys}{$UrlKey} )
		    {
			print STDERR "$UrlKey does not exist for tag!!\n";
			next;
		    }
		}
	    }
	}
    }


}   # GassCacheListFlat()
# ******************************************************

# ******************************************************
# Function: GassCacheCleanupUrl
#
# Description:
#	Cleanup a URL in the GASS Cache
#
# Parameters:
#  URL to cleanup
#
# Return Values:
#  None
#
# ******************************************************
sub GassCacheCleanupUrl ( )
{

    # Sanity check...
    if ( $Settings{Url} eq "" )
    {
	print STDERR "CleanupUrl requires a URL to cleanup\n";
	DumpHelp( );
	exit 1;
    }

    # Check the type & invoke the proper sub function
    if ( $CacheInfo{CACHE_TYPE} eq "normal" )
    {
	print "-- Normal cache --\n" if ($Verbose);
	GassCacheCleanupUrlNormal(  );
    }
    elsif ( $CacheInfo{CACHE_TYPE} eq "flat" )
    {
	print "-- Flat cache --\n" if ($Verbose);
	GassCacheCleanupUrlFlat(  );
    }
    else
    {
	print STDERR "Unknown cache type '%s'\n", $CacheInfo{CACHE_TYPE};
    }


}   # GassCacheCleanupUrl()
# ******************************************************

# ******************************************************
# Function: GassCacheCleanupUrlNormal
#
# Description:
#	Cleanup a URL in a "normal" GASS Cache
#
# Parameters:
#  URL to cleanup
#
# Return Values:
#  None
#
# ******************************************************
sub GassCacheCleanupUrlNormal ( )
{
    my $Url = $Settings{Url};
    my $Mangled = $Settings{MangledUrl};

    # Sanity checks

    # Let's learn all about our data file...
    my $FullGlobalDir = "$CacheInfo{GLOBAL_ROOT}/$Mangled";
    if ( ! -d $FullGlobalDir )
    {
	print STDERR "Could not clean up file because ".
	    "the URL was not found in the GASS cache.\n";
	exit 1;
    }
    my $FullGlobalData = "$FullGlobalDir/data";
    if ( ! -f $FullGlobalData )
    {
	print STDERR "Could not clean up file because ".
	    "the URL was not found in the GASS cache.\n";
	exit 1;
    }
    my $FullGlobalDataInode = -1;
    {
	my @Stat = stat( $FullGlobalData );
	if ( $#Stat < 0 )
	{
	    print STDERR "Could not stat data file for URL '$Url'\n";
	    print STDERR "Should be '$FullGlobalData'\n";
	    exit 1;
	}
	$FullGlobalDataInode = $Stat[1];
    }

    # Tell the user...
    print "Found global data file @ $FullGlobalData\n" if( $Verbose );

    # Scan through the local directory, now..
    my %Local;
    my $LocalCount = 0;
    my $Cmd = "find $CacheInfo{LOCAL_ROOT} -inum $FullGlobalDataInode -print";
    open( FIND, "$Cmd|" ) || die "Can't run '$Cmd'";
    print "Scanning the local entries in $CacheInfo{LOCAL_ROOT}\n"
	if( $Verbose );
    while( <FIND> )
    {
	chomp;
	my $FullDataPath = $_;

	my @Dirs = split( /\//, $FullDataPath );
	my $DataFile = pop @Dirs;
	my $Dir = join( "/", @Dirs );
	die "Oops" if ( "$Dir/$DataFile" ne $FullDataPath );
	my $TagFile = "$Dir/tag";

	# Check it out..
	if ( ! -f $FullDataPath )
	{
	    print STDERR "$FullDataPath is not a file!\n";
	    next;
	}
	if ( ! ( $FullDataPath =~ /\/data/ ) )
	{
	    print STDERR "$FullDataPath is not a data file!!\n";
	    next;
	}
	if ( ! -d $Dir )
	{
	    print STDERR "$Dir is not a directory!!\n";
	    next;
	}
	my $Tag;
	if ( ! -f $TagFile )
	{
	    print STDERR "$TagFile <tag file> not found\n";
	    my $Tag = "";
	}
	else
	{
            local(*TAGFILE);
            open(TAGFILE, "<$TagFile");
            chomp($Tag = <TAGFILE>);
            close(TAGFILE);
	}

	# Store it...
	my $r = {};
	$r->{Tag} = $Tag;
	$r->{File} = $DataFile;
	push @{$Local{$Dir}}, $r;
	$r = {};
	$LocalCount++;
    }
    close( FIND );

    # Print results to the user...
    if( $Verbose )
    {
	if ( $LocalCount <= 0 )
	{
	    print "No local links found\n";
	}
	else
	{
	    print "Found $LocalCount local links:\n";
	    foreach my $Dir ( keys %Local )
	    {
		foreach my $FileRec ( @{$Local{$Dir}} )
		{
		    my $File = $FileRec->{File};
		    my $Tag = $FileRec->{Tag};
		    if ( $Tag eq "" )
		    {
			print "\t$Dir/$File\n";
		    }
		    else
		    {
			print "\t$Tag\n";
		    }
		}
	    }
	}
    }

    # Clean it all up...
    foreach my $Dir ( keys %Local )
    {
	foreach my $FileRec ( @{$Local{$Dir}} )
	{
	    print "$FileRec->{Tag}.. ($FileRec->{File}) " if ( $Verbose );
	    unlink "$Dir/$FileRec->{File}";
	    print "\n" if ( $Verbose );
	}

	# Blow away the extras..
	unlink "$Dir/url";
	unlink "$Dir/tag";

	# Temp dir for working in..
	my $TmpDir;

	# Blow away the directories..
	my @Dirs = split( /\//, $Dir );
	while( 1 )
	{
	    $TmpDir = join ('/', @Dirs );
	    last if ( $TmpDir eq $CacheInfo{LOCAL_ROOT} );
	    last if ( ! rmdir( $TmpDir ) );
	    print "\t$TmpDir\n " if ( $Verbose );
	    pop @Dirs;
	}

	# Check: does this directory have only a "tag" file?
	my $TagFile = "$TmpDir/tag";
	if (  ( $TmpDir ne $CacheInfo{LOCAL_ROOT} ) && ( -f "$TagFile" )  )
	{
	    my @Stat = stat( "$TagFile" );

	    # Unlink it if it's the last one..
	    if ( $Stat[3] == 1 )
	    {
		unlink( "$TagFile" );
	    }

	    # Try cleaning up more...
	    while( 1 )
	    {
		$TmpDir = join ('/', @Dirs );
		last if ( $TmpDir eq $CacheInfo{LOCAL_ROOT} );
		last if ( ! rmdir( $TmpDir ) );
		print "\t$TmpDir\n " if ( $Verbose );
		pop @Dirs;
	    }
	}
    }

    # And, remove the global dir
    {
	my $Dir = $FullGlobalDir;
	print "Global.. " if ( $Verbose );
	unlink "$Dir/data";
	unlink "$Dir/url";

	my @Dirs = split( /\//, $Dir );
	while( 1 )
	{
	    my $TmpDir = join ('/', @Dirs );
	    last if ( $TmpDir eq $CacheInfo{GLOBAL_ROOT} );
	    last if ( ! rmdir( $TmpDir ) );
	    print "\n\t$TmpDir " if( $Verbose );
	    pop @Dirs;
	}
	print "\n" if ( $Verbose );
    }

}   # GassCacheCleanupUrlNormal()
# ******************************************************

# ******************************************************
# Function: GassCacheCleanupUrlFlat
#
# Description:
#	Cleanup a URL in a "flat" GASS Cache
#
# Parameters:
#  URL to cleanup
#
# Return Values:
#  None
#
# ******************************************************
sub GassCacheCleanupUrlFlat ( )
{
    my $Url = $Settings{Url};
    my $Mangled = $Settings{MangledUrl};
    my ( $UrlMangle, @UrlKey ) = split( /_/, $Mangled );
    my $UrlKey = join( "_", @UrlKey );

    # Let's go hunting..  :-)
    my %Dir;
    GassCacheFlatDir( \%Dir );

    # Does it exist in the cache anywhere??
    if ( ! exists $Dir{Urls}{$UrlMangle}{$UrlKey} )
    {
	print STDERR "Could not clean up file because ".
	    "the URL was not found in the GASS cache.\n";
	return 1;
    }

    # Shortcut...
    my $UrlRec = $Dir{Urls}{$UrlMangle}{$UrlKey};

    # Report to the user...
    if ( $Verbose )
    {
	print "URL: " . $UrlRec->{Url}->{Text} . "\n";
	print "Local:\n";
	if ( ! exists $UrlRec->{LocalData} )
	{
	    print "\tNo local links found\n";
	}
	else
	{
	    print "\tFound " . $UrlRec->{LocalData} . " local links:\n";
	}
    }

    # Ok, now let's find tags that match this URL
    my @TagKeys = keys %{$UrlRec->{TagKeys}};
    foreach my $TagKey ( @TagKeys )
    {
	foreach my $TagType ( keys %{$Dir{MangleTypes}} )
	{
	    next if ( ! exists $Dir{Tags}{$TagType}{$TagKey} );

	    my $r = $Dir{Tags}{$TagType}{$TagKey};

	    # Sanity check!
	    if ( ! exists $r->{Keys}{$UrlKey} )
	    {
		print STDERR "$Url does not exist for tag!!\n";
		next;
	    }

	    # For verbose output, let's go count the data files...
	    if ( $Verbose )
	    {
		my $DataCount = 0;
		if ( exists $r->{Keys}{$UrlKey}{Data} )
		{
		    $DataCount = $#{$r->{Keys}{$UrlKey}{Data}} + 1;
		}
		print "\tTag [$DataCount]: " . $r->{Tag}->{Text} . "\n";
	    }

	    # Data files..
	    if ( exists $r->{Keys}{$UrlKey}{Data} )
	    {
		foreach my $Data ( @{$r->{Keys}{$UrlKey}{Data}} )
		{
		    print "\tL.Data = " . $Data->{Name} . "\n" if ( $Verbose );
		    unlink( $CacheInfo{CACHE_DIR} . "/" . $Data->{Name} );
		}
	    }

	    # Tag file?
	    if ( exists $r->{Keys}{$UrlKey}{Tag} )
	    {
		print "\tL.Tag File: " .
		    $r->{Keys}{$UrlKey}{Tag}->{Name} . "\n" if ( $Verbose > 1 );
		unlink( $CacheInfo{CACHE_DIR} . "/" .
			$r->{Keys}{$UrlKey}{Tag}->{Name} );
	    }

	    # Entry file?
	    if ( exists $r->{Keys}{$UrlKey}{Entry} )
	    {
		if ( $Verbose > 1 )
		{
		    print "\tL.Entry File: " .
			$r->{Keys}{$UrlKey}{Entry}->{Name} . "\n";
		}
		unlink( $CacheInfo{CACHE_DIR} . "/" .
			$r->{Keys}{$UrlKey}{Entry}->{Name} );
	    }
	}
    }

    # Ok, now the global files...
    print "Global..\n" if ( $Verbose );
    if ( exists $UrlRec->{DataLinks} )
    {
	foreach my $Data ( @{$UrlRec->{DataLinks}} )
	{
	    print "\tG.DataLink = " . $Data->{Name} . "\n" if ( $Verbose );
	    unlink( $CacheInfo{CACHE_DIR} . "/" . $Data->{Name} );
	}
    }
    if ( exists $UrlRec->{Data} )
    {
	print "\tG.Data = " . $UrlRec->{Data}->{Name} . "\n" if ( $Verbose );
	unlink( $CacheInfo{CACHE_DIR} . "/" . $UrlRec->{Data}->{Name} );
    }
    if ( exists $UrlRec->{Url} )
    {
	if ( $Verbose > 1 )
	{
	    print "\tG.Url = " . $UrlRec->{Url}->{Name} . "\n";
	    print "\tG.Url = '" . $UrlRec->{Url}->{Text} . "'\n";
	}
	unlink( $CacheInfo{CACHE_DIR} . "/" . $UrlRec->{Url}->{Name} );
    }
    if ( exists $UrlRec->{Entry} )
    {
	print "\tG.Entry = " . $UrlRec->{Entry}->{Name} . "\n"
	    if ( $Verbose > 1 );
	unlink( $CacheInfo{CACHE_DIR} . "/" . $UrlRec->{Entry}->{Name} );
    }

}   # GassCacheCleanupUrlFlat()
# ******************************************************

# ******************************************************
# Function: GassCacheFlatDir()
#
# Description:
#	Gather info on a "Flat" cache
#
# Parameters:
#  None
#
# Return Values:
#  None
#
# ******************************************************
sub GassCacheFlatDir ( $ )
{
    my $Dir = shift;


    # *************************************************
    # Now, let's do the real fun...
    #  Scan through the global directory for all URLs
    # *************************************************
    print "Scanning the global entries in $CacheInfo{CACHE_DIR}\n"
	if( $Verbose );
    opendir( CACHE, $CacheInfo{CACHE_DIR} );
    while( $_ = readdir( CACHE ) )
    {
	next if ( ! /_/ );
	study;

	my $FullPath = "$CacheInfo{CACHE_DIR}/$_";
	my @Stat = stat( $FullPath );
	my $Inode = $Stat[1];
	my $Size = $Stat[7];

	# Record to store...
	my %r = ( Inode => $Stat[1], Size => $Stat[7],
		  Links=>$Stat[3], Name => $_ );

	# global_md5_hash_data
	if ( /^global_([^_]+)_(.*)_data$/ )
	{
	    my $Type = $1;
	    my $Mangled = $2;
	    $r{Mangled} = $Mangled;
	    $r{Type} = "data";

	    $Dir->{MangleTypes}{$Type} = 1;
	    $Dir->{Urls}{$Type}{$Mangled}{Data} = \%r;
	}
	# global_md5_hash_data...
	elsif ( /^global_([^_]+)_(.*)_data/ )
	{
	    my $Type = $1;
	    my $Mangled = $2;
	    $r{Mangled} = $Mangled;
	    $r{Type} = "data";

	    $Dir->{MangleTypes}{$Type} = 1;
	    push( @{$Dir->{Urls}{$Type}{$Mangled}{DataLinks}}, \%r );
	}
	# global_md5_hash_url
	elsif ( /^global_([^_]+)_(.*)_url/ )
	{
	    my $Type = $1;
	    my $Mangled = $2;

	    local($/,*FP);	# slurp mode
	    open( FP, '<' . $FullPath );
	    $r{Text} = <FP>;
	    close(FP);
	    $r{Type} = "url";

	    $Dir->{MangleTypes}{$Type} = 1;
	    $Dir->{Urls}{$Type}{$Mangled}{Url} = \%r;
	}
	# global_md5_hash
	elsif ( /^global_([^_]+)_(.*)/ )
	{
	    my $Type = $1;
	    my $Mangled = $2;
	    $r{Type} = "entry";

	    $Dir->{MangleTypes}{$Type} = 1;
	    $Dir->{Urls}{$Type}{$Mangled}{Entry} = \%r;
	}
	# local_md5_hash_.*
	elsif ( /^local_([^_]+)_(.*)/ )
	{
	    my $Type = $1;
	    my $Details = $2;
	    my $Separator = "_" . $Type . "_";

	    $Dir->{MangleTypes}{$Type} = 1;

	    study $Details;

	    # local_md5_hash_md5_hash_data
	    if ( $Details =~ /^(.*)$Separator(.*)_data/ )
	    {
		my $LKey = $1;
		my $GKey = $2;
		$r{Type} = "data";

		# Update local data count for this URL
		if ( ! exists $Dir->{Urls}{$Type}{$GKey}{LocalData} )
		{
		    $Dir->{Urls}{$Type}{$GKey}{LocalData} = 0;
		}
		$Dir->{Urls}{$Type}{$GKey}{LocalData}++;

		# Add this to "Tag" list for this URL
		$Dir->{Urls}{$Type}{$GKey}{TagKeys}{$LKey} = 1;

		# Store the data file reference
		push( @{$Dir->{Tags}{$Type}{$LKey}{Keys}{$GKey}{Data}}, \%r );
	    }
	    # local_md5_hash_md5_hash_tag
	    elsif ( $Details =~ /^(.*)$Separator(.*)_tag/ )
	    {
		my $LKey = $1;
		my $GKey = $2;
		local($/,*FP);
		$r{Type} = "tag";
		open( FP, '<' . $FullPath );
		$r{Text} = <FP>;
		close(FP);

		# Add this to "Tag" list for this URL
		$Dir->{Urls}{$Type}{$GKey}{TagKeys}{$LKey} = 1;

		# Store the file reference
		$Dir->{Tags}{$Type}{$LKey}{Keys}{$GKey}{Tag} = \%r;
	    }
	    # local_md5_hash_tag
	    elsif ( $Details =~ /^(.*)_tag/ )
	    {
		local($/,*FP);
		my $LKey = $1;
		$r{Type} = "tag";
		open( FP, '<' . $FullPath );
		$r{Text} = <FP>;
		close(FP);
		$Dir->{Tags}{$Type}{$LKey}{Tag} = \%r;
	    }
	    # local_md5_hash_md5_hash
	    elsif ( $Details =~ /^(.*)$Separator(.*)/ )
	    {
		my $LKey = $1;
		my $GKey = $2;
		$r{Type} = "entry";

		# Add this to "Tag" list for this URL
		$Dir->{Urls}{$Type}{$GKey}{TagKeys}{$LKey} = 1;

		# Store the file reference
		$Dir->{Tags}{$Type}{$LKey}{Keys}{$GKey}{Entry} = \%r;
	    }
	    else
	    {
		print STDERR "Warning: Ignoring local file '$_'\n";
	    }
	}
	else
	{
	    print STDERR "Warning; Ignoring '$_'\n";
	}
    }
    closedir( CACHE );

}   # GassCacheFlatDir()
# ******************************************************

# ******************************************************
# Function: Mangle
#
# Description:
#	Mangle a string
#
# Parameters:
#  String to mangle
#
# Return Values:
#  None
#
# ******************************************************
sub Mangle( $ )
{
    my $String = shift;

    local $ENV{GLOBUS_GASS_CACHE_DEBUG};
    delete( $ENV{GLOBUS_GASS_CACHE_DEBUG} );
    my $Mangled = "";

    my $Cmd = "$ProgramC -mangle $String";
    open( MANGLE, "$Cmd|" ) || die "Can't run '$Cmd'\n";
    while ( <MANGLE> )
    {
	chomp;
	if ( /URL:\s+\'(.*)\'/ )
	{
	    $Mangled = $1;
	}
    }
    close( MANGLE );

    if ( $Mangled eq "" )
    {
	print STDERR "Failed to mangle URL!\n";
    }

    return $Mangled;

}   # Mangle()
# ******************************************************

# ******************************************************
# Function: DumpHelp
#
# Description:
#	Dumps out some help
#
# Parameters:
#  URL to cleanup
#
# Return Values:
#  None
#
# ******************************************************
sub DumpHelp( )
{
    # help does not need to be efficient...
    open( PROGC,  "$ProgramC -help 2>&1 |" )
	or die "Can't run '$ProgramC' for help";

    # Just print everything up 'til the "Valid optoins" line
    $_ = <PROGC>;
    while ( <PROGC> )
    {
	print;
	last if ( /^Valid oper/ );
    }

    # Now, all the C program operations..
    while ( <PROGC> )
    {
	chomp; s/\s+$//;
	last if ( $_ eq "" );
	print "$_\n";
    }

    # Print out _our_ operations
    print "$PerlOperations\n";

    # Now, all the C program options..
    while ( <PROGC> )
    {
	chomp; s/\s+$//;
	last if ( $_ eq "" );
	print "$_\n";
    }
    # Print out _our- options
    print "$PerlOptions\n";
    close( PROGC );

}   # DumpHelp()
# ******************************************************