File Coverage

blib/lib/POE/Component/IKC/Specifier.pm

Criterion	Covered	Total	%
statement	22	43	51.1
branch	9	30	30.0
condition	6	9	66.6
subroutine	4	7	57.1
pod	2	4	50.0
total	43	93	46.2

package POE::Component::IKC::Specifier;

############################################################
# $Id: Specifier.pm 1247 2014-07-07 09:06:34Z fil $
#
# Copyright 1999-2014 Philip Gwyn.  All rights reserved.
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# Contributed portions of IKC may be copyright by their respective
# contributors.

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

use Carp;

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw( specifier_parse specifier_name specifier_part);
$VERSION = '0.2402';

sub DEBUG { 0 }

#----------------------------------------------------
# Turn an specifier into a hash ref
sub specifier_parse ($)
{
    my($specifier)=@_;
    return if not $specifier;
    my $kernelRE = q((?:\*)                             |
                     (?:[-. \w]+)                       |
                     (?:[a-zA-Z0-9][-.a-zA-Z0-9]+:\d+)  |
                     (?:unix:[-.\w]+(?::\d+-\d+)?)
                    );
    unless(ref $specifier) {
        if($specifier=~m(^poe:
                        (?:
                            (//)
                            ($kernelRE)?
                        )?
                        (?:
                            (/)
                            ([- \w]+)
                        )?
                        (?:
                            (/)?
                            ([- \w]*)
                        )?
                        (?: \x3f
                            (\w+)
                        )?
                        $)x) {
            $specifier={kernel=>$2, session=>$4, state=>$6};
            $specifier->{args}=$7 if $7;
        }
        elsif( $specifier =~ m(^  (?:(?://)($kernelRE)/)?
                                 (?:([- \w]+)/)?
                                 (?:([- \w]+))?
                                 (?: \x3f (\w+) )?
                               $)x ) {
            $specifier = { kernel=>$1, session=>$2, state=>$3 };
            $specifier->{args} = $4 if $4;
        }
        else {
            return;
        }
    }
    elsif('HASH' ne ref $specifier) {
#        carp "Why is specifier a ", ref $specifier;
        return;
    }

    $specifier->{kernel}||='';
    $specifier->{session}||='';
    $specifier->{state}||='';
    return $specifier;
}

sub specifier_part ($$)
{
    my($specifier, $part)=@_;
    return if not $specifier;

    $specifier="poe://$specifier" unless ref $specifier or $specifier=~/^poe:/;
    $specifier=specifier_parse $specifier;
    return if not $specifier;
    return $specifier->{$part};
}

#----------------------------------------------------
# Turn an specifier into a string
sub specifier_name ($)
{
    my($specifier)=@_;
    return $specifier unless(ref $specifier);
    if(ref($specifier) eq 'ARRAY')
    {
        $specifier={kernel=>'',
                    session=>$specifier->[0],
                    state=>$specifier->[1],
                   };
    }

    my $name='poe:';
    if($specifier->{kernel})
    {
        $name.='//';
        $name.=$specifier->{kernel};
    }
    if($specifier->{session})
    {
        $name.='/'.$specifier->{session};
    }
    $name.="/$specifier->{state}"    if $specifier->{state};
    return $name;
}


1;

__END__