#! perl
#
# Created by Yuichi Koike ($Id: policyref.pl,v 1.1 2000/10/05 21:31:06 koike Exp $)
#
#
use strict;

package P3P::PolicyRef;

sub new {
	my($class, $fn) = @_;
	my $self = bless {uri => "", base_uri => "" }, $class;
}

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

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

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

sub prefix {
	my ($self) = @_;
	if(! $self->{prefix}) {
		$self->{prefix} = [];
	}
	return $self->{prefix};
}

sub exclude {
	my ($self) = @_;
	if(! $self->{exclude}) {
		$self->{exclude} = [];
	}
	return $self->{exclude};
}

sub method {
	my ($self) = @_;
	if(! $self->{method}) {
		$self->{method} = [];
	}
	return $self->{method};
}

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

	my $base_uri = $self->{base_uri};
	my $uri = $self->{uri};
	$uri = $self->absolute($uri, $base_uri);
	$self->uri($uri);

	my @newarray = ();
	foreach my $rela (@{$self->prefix}) {
		push(@newarray, [$self->absolute($$rela[0], $base_uri), $$rela[1], $$rela[0]]);
	}
	$self->{prefix} = \@newarray;

	my @newarray2 = ();
	foreach my $rela (@{$self->exclude}) {
		push(@newarray2, [$self->absolute($$rela[0], $base_uri), $$rela[1], $$rela[0]]);
	}
	$self->{exclude} = \@newarray2;
}

sub absolute {
	my ($self, $uri, $base_uri) = @_;
	my $orguri = $uri;

	if($uri =~ /^http:/) {
	} elsif($uri =~ /^\//) {
		$base_uri =~ /(http:\/\/.*?)\//;
		$uri = $1.$uri;
	} else {
		$base_uri =~ /(.*\/)/;
		$uri = $1.$uri;
	}

	return $uri;
}

sub policy {
	my ($self, $target, $wellknown) = @_;

	if($#{$self->prefix} eq -1) {
		if($wellknown) {
			return "";
		} else {
			return $self->{uri};
		}
	}

	my $ok = 0;
	foreach my $rela (@{$self->prefix}) {
		if($target =~ /^$$rela[0]/) {
			$ok = 1;
		}
	}

	if($ok eq 0) {
		return "";
	}

	foreach my $rela (@{$self->exclude}) {
		if($target =~ /^$$rela[0]/) {
			return "";
		}
	}

	return $self->{uri};
}

1;
