URI::Attr - associate attributes with the URI name space

LWPng-alpha documentation Contained in the LWPng-alpha distribution.

Index

Code Index:

NAME

Top

URI::Attr - associate attributes with the URI name space

SYNOPSIS

Top

 use URI::Attr;
 $attr = URI::Attr->new;
 $attr->attr_update(SERVER => "http://www.perl.com")->{visit} = "yes";
 if ($attr->attr_plain($url, "visit")) {
     #...
 }

DESCRIPTION

Top

Instances of the URI::Attr class is able to associate attributes with "places" in the URI name space. The main idea is to be able to look up all attributes that are relevant to a specific absolute URI efficiently and to be able to override attributes at different hierarchal levels of the URI namespace.

The levels of the URI namespace is given the following names:

   GLOBAL  - affect all URIs
   SCHEME  - affect all URIs of the given scheme
   DOMAIN  - affect all URIs within the given domain (domains nest)
   HOST    - a given host
   SERVER  - a specific server (port) on the host
   DIR     - a directory component (nestable)
   PATH    - the final path component

GLOBAL and SCHEME are the only levels available for all URIs. The other levels only make sense for URIs that follow the generic URL pattern (like http: and ftp: schemes). Other level names can be used for specific schemes.

Lets take a look at an example. Consider the following URL:

   http://www.perl.com/cgi-bin/cpan_mod?module=LWP

This URL can be broken up into the following hierarchal levels:

   SCHEME  http
   DOMAIN  .com
   DOMAIN  .perl
   HOST    www
   SERVER  80        (implicit port)
   DIR     cgi-bin
   PATH    cpan-mod

METHODS

Top

The following methods are provided by this class:

$db = URI::Attr->new

The constructor takes now arguments. It returns a newly allocated URI::Attr object.

$db->attr($uri, [$attr_name])

Look up all attributes that are relevant to the given $uri. In scalar context only the most specific attribute is returned. In list context all attributes are returned, with the most specific first. Each attribute is represented by a reference to a 2 element array. The first element is the name of the level. The second element is the attribute(s).

If the optional $attr_name is given, only the attribute with the given name is considered. If no $attr_name is given, then the attributes are returned as a hash reference.

$db->attr_plain($uri, [$attr_name])

Same as attr() but only return the attribute(s), not the associated level names.

$db->attr_update($level, $uri)

Returns a hash reference associated with $uri at the given $level. If the given $level name does not make sense for the given $uri return <undef>. If the $level is nestable, then the most specific instance related to the $uri is used.

The hash returned can then be updated in order to assign attributes to the given place in the URI name space.

$db->as_string

Dump the content of the URI::Attr object. Mainly useful for debugging.

BUGS

Top

There ought to be a way to associate attributes with domains/hosts without regard to scheme (and for several schemes and several domain/hosts). Think, think,...

Perhaps there should be defined relationships between schemes, so that for instace everything that is valid for http is also valid for https, but not the other way around. Same goes for nntp and news which should be treated as the same thing and their relation to snews.

A similar concept is present in w3c-libwww under the name URL Tree. The scheme is simply ignored here and the root of the tree is the hostname part of the URL.

A totally different approach would be associate attributes with regular expressions that are matched against URLs. Perhaps this would have been a better way?

SEE ALSO

Top

URI

COPYRIGHT

Top

Copyright 1998, Gisle Aas

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

LWPng-alpha documentation Contained in the LWPng-alpha distribution. 
package URI::Attr; # $Id: Attr.pm,v 1.7 1999/04/12 13:17:25 gisle Exp $

use strict;
use URI;

use vars qw($VERSION);
$VERSION = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/);


# The URI::Attr is a tree.  The nodes are arrays with 2 hash elements.
# The first hash define the next level of the tree and the values in
# this hash are new 2 element arrays.  The second hash is the
# attributes at the given level (or undef).
#
# For instance the attribute "foo" at the SERVER level of
# http://www.perl.com is found here:
#
# $self->[0]{"http"}[0]{".com"}[0]{".perl"}[0]{"www"}[0]{"80"}[1]{"foo"}
#

sub new
{
    my $class = shift;
    bless [undef, undef], $class;
}


sub _attr  # this method should probably be implemented by URI itself
{
    my($self, $url) = @_;
    $url = URI->new($url) unless ref($url);

    my @attr;
    my $scheme = $url->scheme;

    if (!$scheme) {
	die "URL '$url' is not absolute";

    } elsif ($scheme eq "mailto") {
	push(@attr, [SCHEME => $scheme]);
	
    } elsif ($scheme eq "news") {
	push(@attr, [SCHEME => $scheme]);
	
    } else {
	# assume generic stuff
	push(@attr, [SCHEME => $scheme]);
	if (my $h = $url->host) {

	    if ($h =~ /^\d+/) {
		# IP address (could be splitted from beginning)
	    } else {
		push(@attr, [DOMAIN => $1]) while $h =~ s/(\.[^.]+)$//;
	    }
	    push(@attr, [HOST => $h]);
	    if (UNIVERSAL::isa($url, 'URI::_server')) {
		push(@attr, [SERVER => $url->port]);
	    }
	}
	my $p = $url->path;
	$p =~ s,^/,,;
	if (length $p) {
	    push(@attr, [DIR => $1]) while $p =~ s,^([^/]*/),,;
	    push(@attr, [PATH => $p]) if length $p;
	}
    }
    \@attr;
}


sub attr
{
    my($self, $url, $name) = @_;
    my $attr = $self->_attr($url);
    my @val;
    push(@val, [GLOBAL => $self->[1]]) if $self->[1];
    
    my $cur = $self;
    while (@$attr &&
	   $cur->[0] &&
	   ($cur = $cur->[0]{$attr->[0][1]})) {
	push(@val, [$attr->[0][0], $cur->[1]]) if $cur->[1];
	shift(@$attr);
    }
    if ($name) {
	my @copy = @val;
	@val = ();
	for (@copy) {
	    next unless exists $_->[1]{$name};
	    push(@val, [$_->[0], $_->[1]{$name}]);
	}
    }
    wantarray ? reverse(@val) : $val[-1];
}


sub attr_plain
{
    my $self = shift;
    my @attr = map {$_->[1]} $self->attr(@_);
    wantarray ? @attr : $attr[0];
}


sub attr_update
{
    my($self, $type, $url) = @_;
    $type ||= "";
    return _make_hash($self->[1]) if $type eq "GLOBAL";
    my $attr = $self->_attr($url);
    my %type = ($type => 1);
    if ($type eq "PATH") {
	$type{"DIR"}++;
	$type{"SERVER"}++;
    } elsif ($type eq "DIR") {
	$type{"SERVER"}++;
    }
    pop(@$attr) while @$attr && !$type{$attr->[-1][0]};
    return undef unless @$attr;

    my $cur = $self;
    while (@$attr) {
	my $elem = shift(@$attr)->[1];
	$cur = \@{$cur->[0]{$elem}};
    }
    _make_hash($cur->[1]);
}


sub _make_hash
{
    $_[0] = {} unless defined($_[0]);
    $_[0];
}


sub as_string
{
    my $self = shift;
    my $level = shift || 0;
    my($down, $attr) = @$self;
    my $str = "";
    if ($attr) {
	$str = "(" . join(", ", sort keys %$attr) . ")\n";
    } elsif ($level) {
	$str .= "\n";
    }
    if ($down) {
	for (sort keys %$down) {
	    $str .= "$_";
	    my $s = as_string($down->{$_}, $level+1);
	    $s =~ s/^/  /gm;
	    $str .= $s;
	}
    }
    $str;
}

1;

__END__