#!/usr/bin/perl


## W3C W3C::Rnodes::AclParser - W3C PERL Library
# A W3C::XML::XmlHandler to store ACL information in a tree for later manipulation

# !!!!!!!!!!!!!!!!!!!! DEPRECATED !!!!!!!!!!!!!!!!!!!!
# now handled exclusively in RDF

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

#things that need to be done:
# rename to W3C::Rnodes::AclParser (including the corresponding java class)

package W3C::Rnodes::AclParser;
require 5.000;
use W3C::Rdf::RdfParser;
use W3C::Rnodes::AclDB;
use strict;
@W3C::Rnodes::AclParser::ISA = ("W3C::Rdf::RdfParser");


$W3C::Rnodes::AclParser::revision = '$Id: AclParser.pm,v 1.12 2004/03/29 06:45:50 eric Exp $ ';
$W3C::Rnodes::AclParser::VERSION = 0.96;

#####
# per-object data

#####
# new - prepare a W3C::Rnodes::AclParser with a new connection

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new();
    $self->{ACL_PREFIX} = '<'; # cheap way to guarantee no match until initialized
    $self->{ACL_RULES} = {};
    $self->{ACL_RESOURCES} = {};
    $self->{ACL_SCHEMA_URI} = 'http://www.w3.org/schema/certHTMLv1';
    bless ($self, $class);
    return $self;
}

sub setAclSchemaURI {
    my $self = shift;
    $self->{ACL_SCHEMA_URI} = shift;
}

sub getAclPrefix {
    my $self = shift;
    return $self->{ACL_PREFIX};
}

sub addNamespace {
    my $self = shift;
    my $sAs = shift;
    my $sHref = shift;
    $self->SUPER::addNamespace($sAs, $sHref);
    $self->{ACL_PREFIX} = $sAs if ($sHref eq $self->{ACL_SCHEMA_URI});
}

sub startElement {
    my $self = shift;
    my $name = shift;
    my $attributeList = shift;
    my $newEl = $self->SUPER::startElement($name, $attributeList);
    my $rdfPrefix = 'rdf'; # !!! this is junk
    my $aclPrefix = $self->{ACL_PREFIX};
    if ($name eq $rdfPrefix.':Description') {
	if (defined $attributeList->getOne($self->{ACL_PREFIX}.':access')) {
	    push (@{$self->{ACL_RULES}{$self->getCurrentBag}}, [$attributeList->getOne($rdfPrefix.':ID'), 
								$attributeList->getOne($self->{ACL_PREFIX}.':access')]);
	}
    } elsif ($name eq $aclPrefix.':hasAccessTo') {
	push (@{$self->{ACL_RESOURCES}{$attributeList->getOne($rdfPrefix.':ID')}}, $self->getCurrentDescription);
    }
    return $newEl;
}

sub buildAclDB {
    my $self = shift;
    my $aclDB = new W3C::Rnodes::AclDB;

    my $tree = $self->getTree;
    foreach my $resource (keys %{$self->{ACL_RESOURCES}}) {
	foreach my $bagId (@{$self->{ACL_RESOURCES}{$resource}}) {
	    if ($bagId =~ m/\A\#(.*)\Z/) {
		# local bag of access descriptors
		$bagId = $1;
	    } else {
		# remote bag of access descriptors
		die 'W3C::Rnodes::AclParser does not (yet) support remote access rules \"'.$resource.'\"';
	    }
	    foreach my $rule (@{$self->{ACL_RULES}{$bagId}}) {
		$aclDB->addRule($resource, $rule->[0], $rule->[1]);
	    }
	}
    }
    return $aclDB;
}

1;

