#! perl
#
# wrtten by Yuichi Koike ($Id: step4.pl,v 1.1 2000/10/05 21:31:06 koike Exp $)
#
# Modules
use vars;
use XML::Parser;
require "mylib.pl";
require "xml.pl";

package P3P::PolicyCheck;

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

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

sub check2 {
	my ($self, $content, $uri, $pr, $step) = @_;

	$self->{content} = $content;
	$self->{pr} = $pr;
	$self->{step} = $step;
	$self->{uri} = $uri;

	# initialize
	$self->init;

	# syntax check
	my $syn_ret = $self->plc_syntax;
	if($syn_ret eq 0) {
		$pr->pri("<p class='result'>Validation process aborted.</p>\n");
		return 0;
	}

	# vocab check
	my $voc_ret = $self->plc_voc;
	if($voc_ret eq 0) {
		$pr->pri("<p class='result'>Validation process aborted.</p>\n");
		return 0;
	}
}

sub check {
	my ($self, $uri, $pr, $step) = @_;

	$self->{uri} = $uri;
	$self->{pr} = $pr;
	$self->{step} = $step;

	# initialize
	$self->init;

	# exsiting check
	my $res = $self->plc_exist;
	if($res eq 0) {
		$pr->pri("<p class='result'>Validation process aborted.</p>\n");
		return 0;
	}

	# syntax check
	my $syn_ret = $self->plc_syntax;
	if($syn_ret eq 0) {
		$pr->pri("<p class='result'>Validation process aborted.</p>\n");
		return 0;
	}

	# vocab check
	my $voc_ret = $self->plc_voc;
	if($voc_ret eq 0) {
		$pr->pri("<p class='result'>Validation process aborted.</p>\n");
		return 0;
	}
}

sub init {
	my ($self) = @_;
	my $pr = $self->{pr};
	my $uri = $self->{uri};
	my $step = $self->{step};

	$pr->pri("<hr>");
	$pr->pri("<p><span class='step'>Step $step: </span>\n");
	$pr->pri("<span class='big'>Policy File Validation</span></p>\n");
	$pr->pri("<p><span class='result'>URI: </span>\n");
	my $line_pl = ($uri =~ /^http:/) ? "line.pl?url=" : "";
	$pr->pri("<a target='refwin' href='$line_pl$uri'>\n<tt>$uri</tt>\n</a>\n");
}

sub plc_voc {
	my ($self) = @_;
	my $content = $self->{content};
	my $pr = $self->{pr};
	my $uri = $self->{uri};
	my $step = $self->{step};

	# first message
	$pr->pri("<p class='result'><font color='#0050B2'>Step $step-3:</font>\n");
	$pr->pri("Vocabulary check</p>\n");

	# read base data schema
	my $schema_parser = new P3P::SchemaParser;
	my %base = $schema_parser->parse("/home/koike/validator/20000510/base.xml");
	my @result = P3P::DataChecker::check($content, \%base);
	foreach my $x (@result) {
		$pr->err($x);
	}

	# print result
	if($#result eq -1) {
		$pr->pri("<p class='result2'>Policy file has \n");
		$pr->pri("<font color='blue'>no vocabulary errors</font>.</p>\n");
	} else {
		$pr->pri("<p class='result2'>Policy file syntax has ");
		$pr->pri("<font color='red'>vocabulary errors</font>.</p>");
	}

	$pr->print_all;
	return 1;
}

sub plc_exist {
	my ($self) = @_;
	my $pr = $self->{pr};
	my $step = $self->{step};

	my $plc_uri = $self->{uri};
	my $method = "GET";
	my %ret = &main'retrieve($plc_uri, $method);

	# first message
	$pr->pri("<p class='result'><font color='#0050B2'>Step $step-1:</font>\n");
	$pr->pri("Access check</p>\n");

	# error handling
	if($ret{"error"}) {
		$pr->err($ret{"error"}." [url=".$plc_uri."]");
		$pr->pri("<p class='result'>&nbsp;&nbsp;Policy File \n");
		$pr->pri("<font color='red'>can not</font> be retrieved.</p>\n");
		$pr->print_all;

		return 0;
	}

	# redirect handling
	if($ret{"redirect"}) {
		$pr->mes("HTTP request was redirected to \n[<tt>".$ret{"redirect"}."</tt>]");
	}

	# content type
	my $str = "The content type of the policy file is \n<b>";
	$pr->mes($str.$ret{"response"}->headers->content_type."</b>\n");

	# successful
	$pr->pri("<p class='result2'>Policy File \n");
	$pr->pri("<font color='blue'>can be retrieved</font>.</p>\n");

	$pr->print_all;

	$self->{content} = $ret{"response"}->content;
	return 1;
}

sub plc_syntax {
	my ($self) = @_;
	my $content = $self->{content};
	my $pr = $self->{pr};
	my $uri = $self->{uri};
	my $step = $self->{step};

	# first message
	$pr->pri("<p class='result'><font color='#0050B2'>Step $step-2:</font>\n");
	$pr->pri("Syntax check</p>\n");

	# Check if well-formed
	my $xml = new P3P::XML;
	my $well_res = $xml->well_form($content);
	if($well_res eq 0) {
		$pr->pri("<p class='result2'>Policy file is ");
		$pr->pri("<font color='red'>NOT an well-formed XML file</font>.</p>");
		$pr->code($xml->error);
		$pr->print_all;

#		my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
#		my $fn = sprintf("%02d%02d%02d%02d.xml", $mday, $hour, $min, $sec);
#		open AAA, "> $fn";
#		print AAA $content;
#		close AAA;

#		return 0;
	}

	# XML Validation check
	$pr->clear_ew;
	my $vres = $xml->validate($uri, "http://www.w3.org/P3P/validator/p3p.xml", $content);
	foreach my $err (@{$xml->errors}) {
		$pr->err($err);
	}

	# print result
	if($vres eq 0 || $well_res eq 0) {
		$pr->pri("<p class='result2'>Policy file syntax has ");
		$pr->pri("<font color='red'>syntax errors</font>.</p>");
	} else {
		$pr->pri("<p class='result2'>Policy file syntax is syntactically \n");
		$pr->pri("<font color='blue'>valid</font>.</p>\n");
	}

	$pr->print_all;
	if($well_res eq 0) {
		return 0;
	}
	return 1;
}

1;
