######################################################################
#
# Perl module: P3P::DataSchema
#
######################################################################
#
# $Id: dataschema.pl,v 1.2 2002/03/20 09:28:31 koike Exp $
# Created by Yuichi Koike (koike@w3.org)
#

use strict;

######################################################################
package P3P::DataSchema;
######################################################################

sub new {
	my ($class, %args) = @_;
	my $self = bless {}, $class;
	my @errors;
	$self->{errors} = \@errors;
	return $self;
}

sub uri {
	my ($self, $arg) = @_;
	if($arg) {
		$self->{uri} = $arg;
	} else {
		return $self->{uri};
	}
}

sub makeDic {
	my ($self) = @_;

	my $nullstr = "------------------";

	my $data_schema;
	my $schema_in_policy;
	# get XML document root
	my $xml;
	if($self->{uri} eq "##embedded") {
		$xml = $self->{embedded};
	} else {
		$xml = new P3P::XML;
		$xml->setURI($self->{uri});

		my $res_code = $xml->access;
		if($res_code ne 200){
			$self->{err_msg} = "Dataschema file <tt>[$self->{uri}]</tt> cannot be accessed.<br>".$xml->{error};
			return $self->{err_msg};
		}
		if(! $xml->well_formed) {
			$self->{err_msg} = "Dataschema file <tt>[$self->{uri}]</tt> is not well-formed.";
			return $self->{err_msg};
		}
	}

	my $doc = $xml->{doc};
	if(! $doc) {
		$self->{err_msg} = "Dataschema file <tt>[$self->{uri}]</tt> looks broken.";
		return $self->{err_msg};
	}

	my $root = $doc->getDocumentElement;
	if(! $root) {
		$self->{err_msg} = "Root element of the dataschema file <tt>[$self->{uri}]</tt> does not exist.";
		return $self->{err_msg};
	}

	if($root->getTagName eq "DATASCHEMA"){
		$data_schema = 1;
	} elsif(($root->getTagName eq "POLICY") || ($root->getTagName eq "POLICIES")){
		$schema_in_policy = 1;
	} else {
		$self->{err_msg} = "Invalid root element tag name of the dataschema file <tt>[$self->{uri}]</tt>.";
		return $self->{err_msg};
	}

	# Loop
	my %struct_dic;
	my $elem;
	my $elemOrg;
	if($data_schema){
		$elemOrg = $root->getFirstChild;
	} elsif($schema_in_policy){
		my @dataschema_element = $root->getElementsByTagName("DATASCHEMA");
		if($#dataschema_element > 0){
			$self->{err_msg} = "Multiple <tt>&lt;DATASCHEMA&gt;</tt> are found in the policy file.";
			return $self->{err_msg};
		} elsif($#dataschema_element eq 0){
			$elemOrg = $dataschema_element[0]->getFirstChild;
		} else {
			$self->{err_msg} = "<tt>&lt;DATASCHEMA&gt;</tt> does not exist in the policy file.";
			return $self->{err_msg};
		}
	}

	$elem = $elemOrg;
	while($elem) {
		my $tag = $elem->getTagName;
		my $name = $elem->getAttribute("name");

		# The structure of struct_dic is:
		# { "certificate" => 
		#	["key", "none", category_str, "format", "none", category_str],
		#	"contact" => 
		#	["postal", "postal", category_str,,,,,,,,,] }

		if($tag eq "DATA-STRUCT") {
			my $ref = $elem->getAttribute("structref");
			my $flag = P3P::Common::has_category($elem);

			my @structlist;
			my $type;
			my $prefix;
			while($name =~ /(.*?)\.(.*?)\.(.*)/) {
				$type = $1;
				$prefix = $2;
				$name = $2.".".$3;
				push(@structlist, $type);
				push(@structlist, $prefix);
				push(@structlist, "#".$prefix);
			}
			$name =~ /(.*?)\.(.*)/;
			push(@structlist, $1);
			push(@structlist, $2);
			push(@structlist, $ref);

			while($#structlist > 1) {
				$type = shift(@structlist);
				$prefix = shift(@structlist);
				$ref = shift(@structlist);

				# Get the list for the type
				my $list = $struct_dic{$type};
				if(!$list) {
					my @list;
					$list = \@list;
					$struct_dic{$type} = $list;
				}

				# Check if it is already added
				my $not_found = 1;
				foreach my $item (@{$list}) {
					if($item eq $prefix) {
						$not_found = 0;
						last;
					}
				}
				if($not_found) {
					# Add the prefix to the list
					push(@{$list}, $prefix);

					# Add the type of the prefix to the list
					if(! ($ref =~ s/^#//)) {
						$ref = "none";
					}
					push(@{$list}, $ref);

					# Add the category string to the list
					# category string is like "--o---o-----"
					push(@{$list}, $flag);
				}
			}
		}
		$elem = $elem->getNextSibling;
	}

	my %data_dic;
	my %top_level_dic;
	$elem = $elemOrg;
	while($elem) {
		my $tag = $elem->getTagName;
		my $name = $elem->getAttribute("name");

		# register the data element into data_dic
		# structure of data_dic is:
		# { "dynamic.cookies" => category_str, "dynamic.http" => category_str,,}

		if($tag eq "DATA-DEF") {
			my $ref = $elem->getAttribute("structref");
			if(! ($ref =~ s/^#//)) {
				$ref = "none";
			}

			# Add the flag whether it has category to the list
			my $flag = P3P::Common::has_category($elem);

			my @list;
			push(@list, $name);
			push(@list, $ref);
			push(@list, $flag);

			while($#list > 1) {
				my $dname = shift(@list);
				my $dtype = shift(@list);
				my $dcate = shift(@list);

				my $strinfo = $struct_dic{$dtype};
				if($strinfo) {

					# check if this struct is "no_category" struct
					my @list2 = @{$strinfo};
					my $no_cate = 1;
					while($#list2 > 1) {
						my $xname = shift(@list2);
						my $xtype = shift(@list2);
						my $xcate = shift(@list2);

						if($xcate ne $nullstr) {
							$no_cate = 0;
						}
					}

					# extends data elements
					@list2 = @{$strinfo};
					while($#list2 > 1) {
						my $xname = shift(@list2);
						my $xtype = shift(@list2);
						my $xcate = shift(@list2);

						# implementing "push-down" rule
						if($no_cate) {
							$xcate = $dcate;
						}

						push(@list, $dname.".".$xname);
						push(@list, $xtype);
						push(@list, $xcate);
					}
				}

				# implementing "bubble-up" rule
				if($dcate eq $nullstr && $dtype ne "none") {
					$dcate = $self->search_category(\%struct_dic, $dtype, $dcate);
				}
				$data_dic{$dname} = $dcate;
			}

			# register user, business, third-party,,,
			if($name =~ /(.*?)\.(.*?)/) {
				my $top = $1;
				my $top_cate = $top_level_dic{$top};
				my $cate = $data_dic{$name};;
				if(! $top_level_dic{$top}) {
					$top_level_dic{$top} = $cate;
				} else {
					$top_level_dic{$top} = P3P::Common::merge_category($top_cate, $cate);
				}
			}
		}
		$elem = $elem->getNextSibling;

		foreach my $top (keys(%top_level_dic)) {
			$data_dic{$top} = $top_level_dic{$top};
		}

	}

	$self->{data_dic} = \%data_dic;

	return "no error";
}


sub search_category {
	my ($self, $struct_dic, $dtype, $dcate) = @_;

	my $strinfo = ${$struct_dic}{$dtype};
	if($strinfo) {
		my @list2 = @{$strinfo};
		while($#list2 > 1) {
			my $xname = shift(@list2);
			my $xtype = shift(@list2);
			my $xcate = shift(@list2);
			$dcate = P3P::Common::merge_category($dcate, $xcate);
			if($xtype ne "none") {
				$dcate = $self->search_category($struct_dic, $xtype, $dcate);
			}
		}
	}

	return $dcate;
}

sub dataExist {
	my ($self, $data) = @_;

	my $ret = ${$self->{data_dic}}{$data};

	return $ret;
}


sub addError {
	my ($self, $status, $mes) = @_;
	my $err = new P3P::Error;
	$err->status($status);
	$err->message($mes);
	push(@{$self->errors}, $err);
}

sub clearError {
	my ($self) = @_;
	my @new_errors;
	$self->{errors} = \@new_errors;
}

sub errors {
	my ($self) = @_;
	return $self->{errors};
}

# module return code
1;

__END__
