File Coverage

blib/lib/Web/Machine/Util.pm

Criterion	Covered	Total	%
statement	48	48	100.0
branch	21	24	87.5
condition			n/a
subroutine	14	14	100.0
pod	6	7	85.7
total	89	93	95.7

package Web::Machine::Util;
# ABSTRACT: General Utility module

use strict;
use warnings;

our $VERSION = '0.17';

use Carp         qw[ confess ];
use Scalar::Util qw[ blessed ];
use List::Util   qw[ first ];

use HTTP::Headers::ActionPack 0.07;

use Sub::Exporter -setup => {
    exports => [qw[
        first
        pair_key
        pair_value
        bind_path
        create_date
        create_header
        inflate_headers
    ]]
};

sub pair_key   { ( keys   %{ $_[0] } )[0] }
sub pair_value { ( values %{ $_[0] } )[0] }

{
    my $ACTION_PACK = HTTP::Headers::ActionPack->new;
    sub create_header   { $ACTION_PACK->create( @_ ) }
    sub create_date     { $ACTION_PACK->create( 'DateHeader' => shift ) }
    sub inflate_headers { $ACTION_PACK->inflate( @_ ) }
    sub get_action_pack { $ACTION_PACK }
}

sub bind_path {
    my ($spec, $path) = @_;
    my @parts = grep { defined $_ && $_ ne q{} } split /\// => $path;
    my @spec  = grep { defined $_ && $_ ne q{} } split /\// => $spec;

    my @results;
    foreach my $i ( 0 .. $#spec ) {
        if ( $spec[ $i ] =~ /^\*$/ ) {
            push @results => @parts;
            @parts = ();
            last;
        }
        elsif ( $spec[ $i ] =~ /^\:/ ) {
            return unless defined $parts[ 0 ];
            push @results => shift @parts;
        }
        elsif ( $spec[ $i ] =~ /^\?\:/ ) {
            push @results => shift @parts
                if defined $parts[ 0 ];
        }
        else {
            return unless defined $parts[ 0 ];
            return unless $spec[ $i ] eq $parts[ 0 ];
            shift @parts;
        }
    }

    return if @parts;

    wantarray
        ? @results
        : (scalar @results == 1)
            ? $results[0]
            : @results;
}

1;

__END__