package Url;
# $Id: Url.pm,v 1.2 2000/06/25 10:15:32 tom Exp $
################################################################

=head1 NAME

Url - URL のオブジェクトクラス

=head1 SYNOPSIS

 use Uri;
 my $uri = new Uri(uri=>"http://www.foo.com/bar/a.html");
 print $uri->Query;
 print $uri->QueryOmitted;
 print $uri->QueryDecoded;

=head1 MEMBER VARIABLES

 uri    URI
 scheme http:// などのスキーム
 host   ホスト名
 path   パス部
 query  ? を含んだクエリー部

=head1 DESCRIPTION

必ず Set() でセットすること。

=cut

use strict;
use vars qw(@ISA);
@ISA = qw(ObjectTemplate);

use JConv;
use ObjectTemplate;

attributes qw(uri scheme host port path filename query);

################################################################
sub initialize ($)
{
    my $self = shift;

    $self->Rationize if $self->uri;
    
    $self->SUPER::initialize;
}

=head2 $u->Set($uri);

URIをセットする。
内部情報として分解する。

=cut
sub Set ($$)
{
    my ($self, $uri) = @_;

    $self->uri($uri);
    $self->Rationize;
}

=head2 $u->AsUri;

URI としてそのまま返す

=cut

sub AsUri ($)
{
    my $self = shift;

    my $port;
    if ($self->port != 80){
	$port = ":" . $self->port;
    }
    return $self->uri(sprintf("%s%s%s%s%s",
			      $self->scheme,
			      $self->host,
			      $port,
			      $self->path,
			      $self->query));
}

=head2 $u->Rationize

正規化して返す

  %7e -> ~
  query 以外を小文字に変換

=cut

sub Rationize
{
    my $self = shift;

    my ($scheme, $host, $path, $query, $port) = $self->split;
    $host = lc($host);
    $path =~ s/%7e/~/i;
#    $path = lc($path);
    $self->scheme($scheme);
    $self->host($host);
    $self->path($path);
    $self->query($query);
    $self->port($port);

    # filename
    $path =~ m!^.*/([^/]*)!;
    $self->filename($1);
    
    return $self->AsUri;
}


=head2 $u->QueryOmitted;

Query を省略して返す

=cut

sub QueryOmitted
{
    my $self = shift;

    return sprintf("%s%s%s",
		   $self->scheme,
		   $self->host,
		   $self->path);


}

=head2 $u->QueryDecoded

Query をデコードした uri を返す

=cut
    
sub QueryDecoded
{
    my $self = shift;

    my $decoded_query = $self->query;
    if ($decoded_query =~ /^\?/){
#	$decoded_query =~ s/^\?//;
	$decoded_query =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
	jconv(\$decoded_query, 'euc');
    }
    return sprintf("%s%s%s%s",
		   $self->scheme,
		   $self->host,
		   $self->path,
		   $decoded_query);
}

=head2 $q->Query;

? を除いた query

=cut

sub Query
{
    my $self = shift;
    my $q = $self->query;
    $q =~ s/^\?//;
    return $q;
}

################################################################
# private:
# スキーム、ホスト、パスとクエリーを分離して返す
sub split
{
    my $self = shift;

    my ($tmp, $query) = $self->uri =~ /^([^\?]*)(\??.*)$/;
    my ($scheme, $host, $path);
    my $port =80;
    
    if ($tmp =~ m!^[a-z]+://!){
#	print "http\n";
	($scheme, $host, $path) =
	    $tmp =~ m!^([a-z]+://)([^/]+)(.*)$!;
	if ($host =~ /^([^:]+):([\d]+)/){
	    $host = $1;
	    $port = $2;
	}
#	print "$tmp, $scheme, $host, $path, $query\n";
    } else {
	$scheme = undef;
	$path = $tmp;
    }
    
    return ($scheme, $host, $path, $query, $port);
}

1;
