Return to aclIcon.pl CVS log

Up to [Public] / perl / modules / CGI

changed standardAcl to standardMacro

#!/usr/bin/perl


## W3C aclIcon - Generate ACL Icon

#Copyright Massachusetts Institute of technology, 1998.
#Written by Eric Prud'hommeaux

#####
# set up module environment

BEGIN {unshift@INC,('..');}

$revision = '$Id: aclIcon.pl,v 1.10 2000/10/26 18:18:18 eric Exp $ ';
$VERSION=0.10;

# --- DEBUGGING MODE ---
use CGI;
#use CGI::Carp qw(fatalsToBrowser);
use W3C::Util::W3CDebugCGI;
$query = new W3C::Util::W3CDebugCGI($0, $ARGV[0] eq 'DEBUG', '/tmp', 1);
# ---- RELEASE MODE ----
#use CGI;
#$query = new CGI;

#####
# main - either aclIcon or show source

if ($target eq 'showSource') {
    &showMySources;
} else {
    &groups;
}

sub groups {
    # W3C ACL interface for all interractions with the underlying database
    use W3C::Rnodes::W3CAclInterface qw($ACCESS_CHACL $ACCESS_RACL);
    use W3C::Util::Properties;
    my $conf;
    eval {
	$conf= new W3C::Util::Properties('../Conf/chaclCGI.prop');
    }; if ($@) {if (my $ex = &catch('W3C::Util::NoSuchFileException')) {
	return print $self->confFileMissing($ex->getFile);
    } else {
	return print $self->unknownException($@);
    }}
    $AclInterface = new W3C::Rnodes::W3CAclInterface($conf);

#    my $resource = $query->param('_w3c_resource');
    my $resource = $AclInterface->canonicalizeUri($query->param('_w3c_resource'), $ENV{'SERVER_NAME'}, $ENV{'SERVER_PORT'});
#    print "DEBUG-EGP: $resource1\n";
    my $aclDB = new W3C::Rnodes::AclDB;
    my ($added, $standardMacro) = $AclInterface->getAclsFor($aclDB, [$resource], undef);
    my $location = $AclInterface->standardMacroToIcon($standardMacro);
    $location = '/Icons/toc6off.gif' if (!$location);

    my ($statusCode, $statusString) = (301, 'Found');
    print $query->header(-type=>'text/html',-status=>$statusCode.' '.$statusString, -location=>$location);
    print $query->start_html($statusCode.' '.$statusString);
    print $query->h1($statusString), "\nThe document has moved <A HREF=\"",$location,"\">here</A>.<P>\n";
    print $query->end_html;
    return;
}