#!/usr/local/bin/perl
# This is -*- perl -*-
#!/usr/local/bin/suidperl

#
# $Id: nscache,v 1.6 1997/11/26 20:22:21 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 1997 Slaven Rezic. All rights reserved.
# This package is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: <URL:mailto:eserte@cs.tu-berlin.de>
# WWW:  <URL:http://www.cs.tu-berlin.de/~eserte/>
#

use Netscape::Cache;
use strict;

$| = 1;

print
  "Content-type: text/html\n\n",
  "<head><title>Cache</title><base target=o></head><body bgcolor=\"#ffffff\">",
  qq{<font size="-1" face="helvetica,arial">\n};

# fix $HOME since this script might be run under the uid of the web server
$ENV{HOME} = (getpwuid($>))[7];

my $indent = 3; # indentation for tree option

my $cache = new Netscape::Cache;
my @links;
if ($ENV{QUERY_STRING}) {
    my $req;
    eval { require CGI };
    if ($@) {
	eval { require CGI::Request };
	if ($@) {
	    print
	      "You need CGI.pm (standard in perl5.004)\n",
	      "or CGI-modules-2.74 to perform this action\n";
	    exit 0;
	}
	else {
	    $req = new CGI::Request;
	}
    } else {
	$req = new CGI;
    }
    my($o);
    my $type = $req->param('type');
    if ($type) {
	while($o = $cache->next_object()) {
	    push(@links, $o) if $o->{'MIME_TYPE'} =~ /$type/o;
	}
    } else {
	while($o = $cache->next_object()) {
	    push(@links, $o);
	}
    }

    my $sort = $req->param('sort');
    if ($sort eq 'type') {
	@links = sort {$a->{'MIME_TYPE'} cmp $b->{'MIME_TYPE'}} @links;
    } elsif ($sort eq 'size') {
	@links
	  = sort {$a->{'CACHEFILE_SIZE'} <=> $b->{'CACHEFILE_SIZE'}} @links;
    } elsif ($sort eq 'date') {
	@links = sort {$b->{'LAST_VISITED'} <=> $a->{'LAST_VISITED'}} @links;
    } else {
	@links = sort {$a->{'URL'} cmp $b->{'URL'}} @links;
    }

    my $mycache = ($req->param('mycache') eq 'on');
    my $tree    = ($req->param('tree') eq 'on');
    if ($tree) { print "<pre>" }

    my @last_component;
    foreach (@links) {
	my $printed_url;
	if ($tree) {
	    # split URL by scheme+host and path components
	    my @component;
	    if ($_->{'URL'} =~ m|^([^:]+://[^/]+)/?(.*)|) {
		@component = ($1, split(m|/|, $2));
	    } else {
		@component = ($_->{'URL'});
	    }
	    if ($component[0] ne $last_component[0]) { print "<hr>" }
	    # comparing how many components have changed
	    my $eq = _equal_components(\@component, \@last_component);
	    my $i;
	    foreach $i ($eq+1 .. $#component-1) {
		print " " x ($indent*$i) . "$component[$i]\n";
	    }
	    print " " x ($indent*$#component);
	    $printed_url = $component[$#component];
	    @last_component = @component;
	} else {
	    $printed_url = $_->{'URL'};
	}
	print
	  "<a href=\"",
	  ($mycache 
	   ? "file://$cache->{'CACHEDIR'}$_->{'CACHEFILE'}"
	   : $_->{'URL'}),
	     "\">", $printed_url, "</a>";
        if (!$tree) { print "<br>" }
        print "\n";
    }
    
    if ($tree) { print "</pre>\n" }

} else {
    my($url);
    while($url = $cache->next_url()) {
	push(@links, $url);
    }
 
    @links = sort @links;

    foreach (@links) {
	print "<a href=\"$_\">$_</a><br>\n";
    }
}

print "</font></body>\n";

sub _equal_components {
    my($new, $old) = @_;
    my $i;
    for($i = 0; $i <= $#$new; $i++) {
	if ($new->[$i] ne $old->[$i]) { return $i-1 }
    }
    $#$new;
}
