File Coverage

blib/lib/URI/tag.pm

Criterion	Covered	Total	%
statement	30	30	100.0
branch	4	4	100.0
condition			n/a
subroutine	8	8	100.0
pod	1	3	33.3
total	43	45	95.5

package URI::tag;

use strict;
our $VERSION = '0.02';

use base qw(URI);

sub authority {
    my $self = shift;
    $self->_accessor('authority', @_);
}

sub date {
    my $self = shift;
    $self->_accessor('date', @_);
}

sub specific {
    my $self = shift;
    $self->_accessor('specific', @_);
}

sub _accessor {
    my $self = shift;
    my $attr = shift;

    my $stuff = $self->_from_opaque($self->opaque);
    my $old   = $stuff->{$attr};
    if (@_) {
        $stuff->{$attr} = shift;
        $self->opaque( $self->_to_opaque($stuff) );
    }
    return $old;
}

sub _from_opaque {
    my($self, $opaque) = @_;

    # relaxed regexp rather than from the ABNF in RFC 4151
    my $stuff;
    $opaque =~ /^([\w\-\.\@]*)(?:,(\d{4}(?:-\d\d(?:-\d\d)?)?)?(?::([$URI::uric]*))?)?$/;
    $stuff->{authority} = $1;
    $stuff->{date}      = $2;
    $stuff->{specific}  = $3;

    $stuff;
}

sub _to_opaque {
    my($self, $stuff) = @_;

    sprintf "%s,%s:%s", map { $stuff->{$_} || '' } qw( authority date specific );
}

1;
__END__