LS::ID - Life Science Identifiers

 use LS::ID;

 $lsid = LS::ID->new('URN:LSID:pdb.org:PDB:112L:');

 $authority_id = $lsid->authority;
 $namespace = $lsid->namespace;
 $object_id = $lsid->object;
 $revision = $lsid->revision;

# =====================================================================
# Copyright (c) 2002,2003 IBM Corporation 
# All rights reserved.   This program and the accompanying materials
# are made available under the terms of the Common Public License v1.0
# which accompanies this distribution, and is available at
# http://www.opensource.org/licenses/cpl.php
# 
# =====================================================================
package LS::ID;

use strict;
use warnings;

use base 'URI::urn';


#
# new - Creates a new LS::ID object from a string
#
#	Parameters: A URI containing the LSID
#
#	Returns: An LS::ID object if successful,
#		 undef if the URI is not in the correct form
#
sub new {
	my ($class, $uri) = @_;

	return undef unless _is_valid($uri);

	return bless \$uri, $class;
}


#
# _is_valid - Determines whether or not the LSID is a valid LSID
#
#	Returns: undef if the LSID is not valid,
#		 true if the LSID is valid
#
sub _is_valid {
	my ($string) = @_;

	return $string =~ /^[uU][rR][nN]:[lL][sS][iI][dD]:[A-Za-z0-9][\w\(\)\+\,\-\.\=\@\;\$\"\!\*\']*:[A-Za-z0-9][\w\(\)\+\,\-\.\=\@\;\$\"\!\*\']*:[A-Za-z0-9][\w\(\)\+\,\-\.\=\@\;\$\"\!\*\']*(:[A-Za-z0-9][\w\(\)\+\,\-\.\=\@\;\$\"\!\*\']*)?$/;
}


#
# _component -
#
sub _component {
	my $self = shift;
	my $index = shift;

	my @components = split(/:/, $self->nss());
	my $value = $components[$index];

	if (@_) {
		if (($index == 3 && $_[0] eq '') || ($_[0] =~ /^[A-Za-z0-9][\w\(\)\+\,\-\.\=\@\;\$\"\_\!\*\']*$/)) {
			$components[$index] = $_[0];
			$self->nss(join(':', @components));
			
			return 1;
		}
		else {
			return undef;
		}
	}

	return $value;
}


#
# _authority - Access to the raw authority component of the LSID
#
#	Returns: The raw string of the authority component
#
sub _authority {
	my $self = shift;
	return $self->_component(0, @_);
}


#
# authority - Access to the authority component of the LSID
#
#	Returns: The authority component
#
sub authority {
	my $self = shift;
	return lc $self->_authority(@_);
}


#
# _namespace -
#
sub _namespace {
	my $self = shift;
	return $self->_component(1, @_);
}


#
# namespace - Access to the namespace component of the LSID
#
#	Returns: The namespace component
#
sub namespace {
	my $self = shift;
	return $self->_namespace(@_);
}


#
# _object -
#
sub _object {
	my $self = shift;
	return $self->_component(2, @_);
}


#
# object - Access to the object component of the LSID
#
#	Returns: The object component
#
sub object {
	my $self = shift;
	return $self->_object(@_);
}


#
# _revision -
#
sub _revision {
	my $self = shift;
	return $self->_component(3, @_);
}


#
# revision - Access to the revision component of the LSID
#
#	Returns: The revision component
#
sub revision {
	my $self = shift;
	return $self->_revision(@_);
}


#
# canonical - Retrieves the canonicalized form of the LSID
#
#	Parameters:
#
#	Returns: The canonicalized LSID if successful,
#		 undef if unsuccessful
#
sub canonical {

	my $self = shift;	
	my $nss = $self->nss;

	my $new = $self->SUPER::canonical();

	# If the scheme portion of the URN is not lowercase, e.g. "URN",
	# URI::canonical will reset the scheme to lc scheme, which in turn will
	# rebless the object as a URI::urn. In case this happens, we need to
	# rebless it as an LS::ID here.

	bless ($new, __PACKAGE__) if (ref $new ne __PACKAGE__);

	return $new if $nss !~ /[A-Z]/ && $nss !~ /:$/;

	$nss =~ s/:$//;

	$new = $new->clone() if $new == $self;
	$new->authority(lc($self->authority()));

	return $new;
}


1;

__END__