######################################################################
#
# Perl module: P3P::HTMLCheck
#
######################################################################
#
# $Id: html.pl,v 1.1 2001/01/12 09:10:50 koike Exp $
# Created by Yuichi Koike (koike@w3.org)
#

use strict;

######################################################################
package P3P::HTMLCheck;
######################################################################

sub new {
    my ($class, %args) = @_;
	my $self = bless {}, $class;
	my @errors;
	$self->{errors} = \@errors;
	return $self;
}

sub targetURI {
	my ($self, $arg) = @_;
	if($arg) {
		$self->{target_uri} = $arg;
	} else {
		return $self->{target_uri};
	}
}

sub content {
	my ($self, $arg) = @_;
	if($arg) {
		$self->{content} = $arg;
	} else {
		return $self->{content};
	}
}

sub prf_uri {
	my ($self, $arg) = @_;
	if($arg) {
		$self->{prf_uri} = $arg;
	} else {
		return $self->{prf_uri};
	}
}

sub check {
	my ($self, $step, $pr, $prf_uri1, $prf_uri2) = @_;
	$self->{step} = $step;
	$self->{pr} = $pr;
	my $target_uri = $self->{target_uri};

	# Intial message
	$pr->pri("<hr>\n");
	$pr->step($step, 0,  " HTML File Validation");

	# Extract <head>...</head>
	my $in_head = $self->{content};
	if(! ($in_head =~ s/.*?<head.*?>(.*?)<\/head>.*/\1/is)) {
		# No good header
		$pr->pri("<p class='result'>HTML document has 
 no P3P compliant link tags.");
		$self->addError("mes", "No valid HTML <tt>&lt;head&gt;</tt> element.");
		$pr->printError($self->errors);
		$self->clearError;
		return 1;
	}

	# extract <link>
	my @links;
	my $linkstr;
	while($in_head =~ s/(<link\s+.*?>)//is) {
		my $link = $1;
		if($link =~ /<link\s+.*?rel\s*=\s*(?:\"|\')P3Pv1(?:\"|\')\s*.*?>/i) {
			push(@links, $link);
			$linkstr = ($linkstr ? ($linkstr."\n".$link) : $link);
		}
	}
	if($#links eq -1) {
		$pr->pri("<p class='result'>HTML document has 
 no P3P compliant link tags.");
		$self->addError("mes", "No valid P3P compliant <tt>&lt;link&gt;</tt> element.");
		$pr->printError($self->errors);
		$self->clearError;
		return 1;
	}

	# extract href="URI"
	my $zero_err = 0;
	my $multi_err = 0;
	my %uridic;
	foreach my $out_link (@links) {
		if($out_link =~ /(<link\s+(.*?)rel\s*=\s*(?:\"|\')P3Pv1(?:\"|\')\s*(.*?)>)/is) {
			my $in_link = " ".$1." ".$2." ";
			my $count = 0;
			while($in_link =~ s/\s+.*?href\s*=\s*(?:\"|\')(.*?)(?:\"|\')//is) {
				$count++;
				$uridic{P3P::Common::absoluteURI($1, $target_uri)} = "ok";
			}
			if($count > 1) {
				$multi_err = 1;
			} elsif($count eq 0) {
				$zero_err = 1;
			}
		}
	}
	my @uris = keys(%uridic);

	# print result

	# Warnings
	# Too many links
	if($#links > 0) {
		$self->addError("warn", "Too many P3P compliant <tt>&lt;link&gt;</tt> elements.");
	}
	# <link> includes no 'href=' directive
	if($zero_err) {
		$self->addError("warn", "Each <tt>&lt;link&gt;</tt> element 
<font color='green'>MUST include</font> 
one [<tt>href=\"URI\"</tt>] directive");
	}


	# Errors
	# <link> includes multiple 'href=' directive
	my $has_error = 0;
	if($multi_err) {
		$has_error = 1;
		$self->addError("err", "P3P <tt>&lt;link&gt;</tt> element 
<font color='red'>can not include</font> 
more than one [<tt>href=\"URI\"</tt>] directive");
	}

	if($#uris > 0) {
		# Multiple PRF URIs
		$has_error = 1;
		$self->addError("err", "Multiple policy reference file URIs are specified.");
	} elsif($#uris eq -1) {
		# No PRF URI
		$has_error = 1;
		$self->addError("err", "No policy reference file URI is specified.");
	}

	if($#uris eq 0) {
		if($prf_uri1) {
			# Different URI from well-known location
			if($uris[0] ne $prf_uri1) {
				$has_error = 1;
				$self->addError("err", "HTML document specifies different URI than 
<tt>/w3c/p3p.xml</tt>.");
			}
		} else {
			# Different URI from HTTP header
			if($prf_uri2 && $uris[0] ne $prf_uri2) {
				$has_error = 1;
				$self->addError("err", "HTML document specifies different URI than HTTP header.");
			}
		}
	}

	if(! $has_error) {
		# Perfectly OK
		$pr->pri("<p class='result'>HTML document is 
<font color='blue'>P3P compliant</font>.</p>");
		$self->addError("mes", "HTML document has P3P compliant 
<tt>&lt;link&gt;</tt> element.");
		$self->prf_uri($uris[0]);
	} else {
		# Errors
		$pr->pri("<p class='result'>HTML document has 
<font color='red'>P3P errors</font>.</p>");
	}

	$self->addError("code", HTML::Entities::encode($linkstr));
	$pr->printError($self->errors);
	$self->clearError;

	return 1;
}

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__
