######################################################################
#
# Perl module: P3P::Common
#
######################################################################
#
# $Id: common.pl,v 1.2 2001/10/17 01:58:03 koike Exp $
# Created by Yuichi Koike (koike@w3.org)
#

use strict;
use XML::DOM;

######################################################################
package P3P::Common;
######################################################################

#
# Dealing with Form parameters
#
sub read_params {
	my $type = $_[0];

	my @ret;
	my $buffer;
	if ($type eq "POST") {
		# Form
		read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
		return make_dic($buffer);
	} else {
		# Query String
		my $buffer = $ENV{'QUERY_STRING'};
		return make_dic($buffer);
	}
}

sub make_dic {
	my $buffer = $_[0];

	my @pairs = split(/&/, $buffer);
	my ($pair, $name, $value, %FORM);
	foreach $pair (@pairs) {
		($name, $value) = split(/=/, $pair);
		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
#		&jcode'convert(*value, 'euc');
		$FORM{$name} = $value;
	}

	return %FORM;
}

#
# Complete URI
#
sub correctURI {
	my ($u) = @_;

	# "" -> ""
	if(! $u) {
		return $u;
	}


	# www.w3.org -> http://www.w3.org
	if(! ($u =~ /^http:/ || $u =~ /^https:/)) {
		$u = "http://".$u;
	}

	# http://www.w3.org -> http://www.w3.org/
	if(! ($u =~ /^http:\/\/.*\//)) {
		$u = $u."/";
	}

	return $u;
}

#
# Make well-known location URI
#
sub wellknownURI {
	my ($uri) = @_;
	$uri =~ s/(http:\/\/.*?)\/.*/$1\/\w3c\/p3p.xml/;
	return $uri;
}


#
# Check if the element has <CATEGORIES> as a child
#
sub merge_category {
	my ($str1, $str2) = @_;
	my $str3;

	my $nullstr = "------------------";
	if($str1 eq $nullstr) {
		return $str2;
	}
	if($str2 eq $nullstr) {
		return $str1;
	}

	for(my $i=0; $i<18; $i++) {
		my $token1 = substr($str1, $i, 1);
		my $token2 = substr($str2, $i, 1);

		if($token1 eq "o" || $token2 eq "o") {
			$str3 = $str3."o";
		} else {
			$str3 = $str3."-";
		}
	}

	return $str3;
}

sub has_category {
	my ($elem) = @_;

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

	my $categories = $elem->getFirstChild;
	while($categories) {
		if($categories->getNodeType eq XML::DOM::ELEMENT_NODE
			&& $categories->getTagName eq "CATEGORIES") {
			my $child = $categories->getFirstChild;
			while($child) {
				if($child->getTagName eq "physical") {
					$str =~ s/^(\S)/o/;
				} elsif($child->getTagName eq "online") {
					$str =~ s/^(\S{1})(\S)/$1o/;
				} elsif($child->getTagName eq "uniqueid") {
					$str =~ s/^(\S{2})(\S)/$1o/;
				} elsif($child->getTagName eq "purchase") {
					$str =~ s/^(\S{3})(\S)/$1o/;
				} elsif($child->getTagName eq "financial") {
					$str =~ s/^(\S{4})(\S)/$1o/;
				} elsif($child->getTagName eq "computer") {
					$str =~ s/^(\S{5})(\S)/$1o/;
				} elsif($child->getTagName eq "navigation") {
					$str =~ s/^(\S{6})(\S)/$1o/;
				} elsif($child->getTagName eq "interactive") {
					$str =~ s/^(\S{7})(\S)/$1o/;
				} elsif($child->getTagName eq "demographic") {
					$str =~ s/^(\S{8})(\S)/$1o/;
				} elsif($child->getTagName eq "content") {
					$str =~ s/^(\S{9})(\S)/$1o/;
				} elsif($child->getTagName eq "state") {
					$str =~ s/^(\S{10})(\S)/$1o/;
				} elsif($child->getTagName eq "political") {
					$str =~ s/^(\S{11})(\S)/$1o/;
				} elsif($child->getTagName eq "health") {
					$str =~ s/^(\S{12})(\S)/$1o/;
				} elsif($child->getTagName eq "preference") {
					$str =~ s/^(\S{13})(\S)/$1o/;
				} elsif($child->getTagName eq "location") {
					$str =~ s/^(\S{14})(\S)/$1o/;
				} elsif($child->getTagName eq "government") {
					$str =~ s/^(\S{15})(\S)/$1o/;
				} elsif($child->getTagName eq "other-category") {
					$str =~ s/^(\S{16})(\S)/$1o/;
				}
				$child = $child->getNextSibling;
			}
		}
		$categories = $categories->getNextSibling;
	}

	return $str;
}


#
# Absolute the URI
#
sub absoluteURI {
	my ($rela, $base) = @_;

	# invalid base!!
	if(! $base =~ /^http/) {
		return "";
	}

	# http://foo/bar.html -> http://foo/bar.html
	if($rela =~ /^http/) {
		return $rela;
	}

	if($rela =~ /^\//) {
		# /bar.html -> http://foo/bar.html
		$base =~ /(http:\/\/.*?)\//;
		return $1.$rela;
	} elsif($rela =~ /^\#/) {
		# #bobo -> http://foo/bar.html#bobo
		return $base.$rela;
	} else {
		# bar.html -> http://foo/foo2/bar.html
		$base =~ /(.*\/)/;
		return $1.$rela;
	}

}

#
# get site name from URI
#
sub getSite {
	my ($uri) = @_;

	# no HTTP uri
	if(! $uri =~ /^http:\/\//) {
		return "";
	}

	if($uri =~ /^http:\/\/(.*?)\//) {
		# normal
		return $1;
	} else {
		# no / at the end
		if($uri =~ /^http:\/\/(.*)/) {
			return $1;
		}
	}
}


######################################################################
package P3P::Print;
######################################################################

sub new {
	my($class, $fn) = @_;
	bless {warn => "on", mes_str => ""}, $class;
}

sub pri {
	my ($self, $str) = @_;
	print $str;
}

sub print_all {
	my ($self) = @_;
	print $self->{mes_str};
	$self->{mes_str} = "";
}

sub print_clear {
	my ($self) = @_;
	$self->{mes_str} = "";
}

sub warn {
	my ($self, $str) = @_;
	print "<p class='mes'><b>Warning:</b> $str</p>\n";
}

sub mes {
	my ($self, $str) = @_;
	print "<p class='mes'><b>Message:</b> $str</p>\n";
}

sub err {
	my ($self, $str) = @_;
	print "<p class='mes'><b><font color='red'>Error:</font></b> $str</p>\n";
}

sub code {
	my ($self, $str) = @_;
	print "<pre class='mes'>\n$str</pre>\n";
}

sub step {
	my ($self, $step, $substep, $str, $str2) = @_;
	if(! $substep) {
		print "<p><span class='step'>Step ".$step.": </span>
<span class='big'>".$str."</span>$str2</p>\n";
	} else {
		print "<p><span class='step2'>Step ".$step."-".$substep.": </span>
<span class='result'>".$str."</span>$str2</p>\n";
	}
}

sub printError {
	my ($self, $errors) = @_;

	foreach my $err (@{$errors}) {
		if($err->status eq "warn") {
			$self->warn($err->message);
		} elsif($err->status eq "err") {
			$self->err($err->message);
		} elsif($err->status eq "code") {
			$self->code($err->message);
		} else {
			$self->mes($err->message);
		}
	}
	$self->print_all;
}

######################################################################
package P3P::Error;
######################################################################

sub new {
	my($class, $fn) = @_;
	bless {}, $class;
}

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

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


1;
