File Coverage

blib/lib/URI/Match.pm

Criterion	Covered	Total	%
statement	30	31	96.7
branch	12	14	85.7
condition	4	5	80.0
subroutine	6	6	100.0
pod	0	1	0.0
total	52	57	91.2

# $Id: /mirror/perl/URI-Match/trunk/lib/URI/Match.pm 8767 2007-11-08T01:41:57.358392Z daisuke  $
#
# Copyright (c) 2007 Daisuke Maki
# All rights reserved.

package URI::Match;
use strict;
use warnings;
use URI();
use vars ('$VERSION');
$VERSION = '0.00001';

sub URI::match_parts
{
    my $self = shift;

    if (@_ == 1) {
        return $self->_match( undef, $_[0] );
    }

    my $matched = 0;
    my $count   = 0;
    while (@_) {
        my($part, $cond) = splice(@_, 0, 2);
        $count++;

        $matched++ if $self->_match( $part, $cond );
    }
    return $matched == $count;
}

sub URI::_match
{
    my ($self, $part, $cond) = @_;

    my $target =
        ! defined $part ? $self :
        $self->can($part) ? ( $self->$part || '' ) : ''
    ;

    my $ref = ref $cond ;
    if (! $ref || $ref eq 'Regexp') {
        return $target =~ /$cond/;
    } elsif ($ref eq 'CODE') {
        return $cond->($target, $self);
    } elsif ( my $code = eval { $cond->can('match') } ) {
        return $code->( $cond, $target, $self );
    }

    return ();
}

1;

__END__