our
@SEPARATORS
=
qw( / * : )
;
our
@GCS_CHARS
=
qw( @ = + $ * )
;
sub
new {
my
$self
=
shift
;
my
$xri
=
shift
;
my
$this
= {
token
=>
undef
,
remainder
=>
undef
,
authority
=>
undef
,
xri
=>
$xri
};
bless
$this
,
$self
;
}
sub
escapeURI {
my
$this
=
shift
;
my
$result
;
while
(
my
$seg
=
$this
->nextSegment) {
$result
=
shift
@$seg
;
foreach
my
$subseg
(
@$seg
) {
if
(
$subseg
=~ m|^\(|) {
$result
.= uri_escape(
$subseg
,
"^A-Za-z0-9\\\-\_\.\!\~\*\'"
);
}
else
{
$result
.= uri_escape(
$subseg
,
"^A-Za-z0-9\\\-\_\.\!\~\*\'"
);
}
}
}
return
$result
;
}
sub
splitAuthLocal {
my
$this
=
shift
;
my
$firstRef
=
$this
->nextSegment;
if
(
defined
$this
->{
'authority'
} ) {
my
@auth
= ();
foreach
my
$seg
(
@$firstRef
) {
push
@auth
,
lc
$seg
;
}
return
[ \
@auth
,
$this
->{remainder} ];
}
else
{
return
$this
->{xri};
}
}
sub
nextSegment {
my
$this
=
shift
;
my
(
$token
,
@segment
);
if
(
defined
$this
->{token}) {
@segment
= (
$this
->{token} );
undef
$this
->{token};
}
else
{
if
(
$token
=
$this
->nextToken ) {
@segment
= (
$token
);
}
else
{
return
undef
;
}
}
while
((
$token
=
$this
->nextToken ) &&
$token
!~ m|^\/| ) {
push
@segment
,
$token
;
}
$this
->{token} =
$token
if
$token
;
return
\
@segment
;
}
sub
getCrossReference {
my
$this
=
shift
;
my
$xri
=
shift
;
while
((
$this
->{remainder} =
$xri
) =~ m|^\(|) {
my
$xref
;
(
$xref
,
$xri
) = extract_bracketed(
$xri
,
'()'
);
next
if
$xref
=~ m|^\(\!|;
$this
->{remainder} =
$xri
;
return
$xref
;
}
return
undef
;
}
sub
getAuthority {
my
$this
=
shift
;
my
$xri
=
$this
->{xri};
my
$xref
;
if
(
$xref
=
$this
->getCrossReference(
$xri
)) {
$this
->{
'authority'
} =
$xref
;
return
$xref
;
}
if
(
$this
->{remainder} =~ m|^\/\/(.*)$|) {
$this
->{
'authority'
} =
'//'
;
$this
->{remainder} = $1;
return
'//'
;
}
if
(
$this
->{remainder} =~ m|^([\@\=\*])(.*)$|) {
my
(
$gcs
,
$rem
) = ($1, $2);
$this
->{remainder} = ((
$rem
=~ m|^[\/\*\:]|)?
''
:
'*'
) .
$rem
;
$this
->{
'authority'
} =
$gcs
;
return
$gcs
;
}
$this
->{remainder} =
$xri
;
return
;
}
sub
nextToken {
my
$this
=
shift
;
my
$auth
;
if
(!
defined
$this
->{remainder} && (
$auth
=
$this
->getAuthority)) {
return
$auth
;
}
return
$xref
if
$xref
=
$this
->getCrossReference(
$this
->{remainder} );
if
(
$this
->{remainder} =~ m|^([\/\*\:])(.*)$|) {
my
(
$sep
,
$rem
) = ($1, $2);
if
(
$sep
eq
'/'
) {
if
(
$rem
=~ m|^([\*\:])(.*)$|) {
$sep
.= $1;
$rem
= $2;
}
else
{
$sep
=
'/*'
;
}
}
$this
->{remainder} =
$rem
;
return
$sep
;
}
if
(
$this
->{remainder} =~ m|^([^\/\*\:]+)(.*)$|) {
$this
->{remainder} = $2;
return
$1;
}
return
undef
;
}
1;