view release on metacpan or  search on metacpan

lib/POEx/URI.pm  view on Meta::CPAN

        $other->kernel( lc $kernel );
    }
    my $port = $other->_port;
    if( defined($port) && ($port eq "" || $port == $self->default_port) ) {
        $other = $other->clone if $other == $self;
        $other->port(undef);
    }

    if( $other =~ m(poe:/[^/]) ) {
        $other = $other->clone if $other == $self;
        $$other =~ s(poe:/)(poe:);        
    }

    my @seg = $other->path_segments;
    if( 2 < @seg ) {
        $other = $other->clone if $other == $self;
        $other->path_segments( @seg );   # enforce 2 segments
    }

    return $other;
}

##############################################
sub fragment
{
    return if 1==@_;
    croak "->fragment() currently not supported";
}

##############################################
sub as_array
{
    my $self = shift;
    my $kid;
    $kid = $POE::Kernel::poe_kernel->ID
        if $POE::Kernel::poe_kernel and $POE::Kernel::poe_kernel->can('ID');
    my $kernel = $self->kernel;
    my $alias = $self->session;
    if( $kernel and ( not $kid or $kernel ne $kid ) ) {
        $alias = join '/', $self->scheme.':/', $kernel, $alias;
    }

    my @ret = ( $alias, $self->event, $self->argument );

    return \@ret unless wantarray;
    return @ret;
}

##############################################
sub argument
{
    my $self = shift;
    my $old = $self->_argument;
    if( @_ ) {
        if( 1==@_ ) {
            my $new = shift;
            unless( ref $new ) {
                $self->query( $new );
            }
            elsif( 'ARRAY' eq ref $new ) {
                $self->query_keywords( $new );
            }
            else {
                $self->query_form( $new );
            }
        }
        else {
            $self->query_form( @_ );
        }
    }
    return unless defined $old;
    return $old;
}

sub _argument
{
    my $self = shift;
    my $args;

    my $q = $self->query;
    return unless defined $q;

    if( $q =~ /=/ ) {
        return { map { s/\+/ /g; uri_unescape($_) }
                 map { /=/ ? split(/=/, $_, 2) : ($_ => '')} 
                 split(/&/, $q)
               };
    }
    return [ map { uri_unescape($_) } split(/\+/, $q, -1) ];
} 

##############################################
sub abs
{
    my $self = shift;
    my $base = shift || croak "Missing base argument";

    $base = URI->new($base) unless ref $base;
    $base = $base->canonical;
    my $abs = $self->clone;

    $abs->scheme( $base->scheme ) unless $abs->scheme;
    foreach my $part ( qw( event session authority ) ) {
        my $f = $abs->$part;
        next if defined $f and length $f;
        $f = $base->$part;
        next unless length $f;
        $abs->$part( $base->$part );
    }
    return $abs;    
}

##############################################
sub rel
{
    my $self = shift;
    my $base = shift || croak "Missing base argument";

    my $rel = $self->clone;
    $base = URI->new($base) unless ref $base;

lib/POEx/URI.pm  view on Meta::CPAN

    $old = $uri->event( $name );

Sets and returns the event part of the $uri.  If the C<$name> contains a
forward-slash (/), it is escaped (%2F).

To clear the event name, use C<''> or C<undef>, which are equivalent.

=head2 session

    my $name = $uri->session
    $old = $uri->session( $name );

Sets and returns the session part of the $uri.  If the C<$name> contains a
forward-slash (/), it is escaped (%2F).

To clear the event name, use C<''> or C<undef>, which are equivalent

=head2 kernel

    my $kernel = $uri->kernel;
    $old = $uri->kernel( $name );

Sets and returns the kernel part of the $uri.  
A kernel may be a dotted quad IPv4 address (I<127.0.0.1>), an IPv6 address
(I<[::1]>) or a hostname (I<localhost.localdomain>) followed by a port number.
A kernel may also be kernel ID or alias.

The kernel only make sense when using IKC.

To clear the kernel name, use C<''> or C<undef>, which are equivalent.

=head2 host

    $host = $uri->host;
    $old = $uri->host( $host );

Sets and returns the host part of the $uri's kernel.  If the kernel wasn't 
host:port, then it is converted to that.

=head2 port

    $port = $uri->port;
    $old = $uri->port( $port );

Sets and retuns the port part of the $uri's kernel.  If the kernel wasn't a
host name, then it becomes one.

=head2 default_port

The default POE port is 603 which is POE upside-down and backwards.  Almost.


=head2 argument

    $arg = $uri->argument
    $old = $uri->argument( $new_arg );
    $old = $uri->argument( %new_arg );
    $old = $uri->argument( \@new_arg );

Sets and returns the argument for this $uri.  And argument may be a string,
a hash (L<URI/query_form>) or an arrayref (L<URI/query_keywords>).

See L</as_array> to see how the argument is passed to the event handler.

=head2 user

    $user = $uri->user;
    $old = $uri->user( $user );

Sets and returns the username part of the $uri's L<URI/userinfo>.  If the
user name contains C<:>, it is escaped.

A user only makes sense in IKC.

=head2 password

    $pw = $uri->password;
    $old = $uri->password( $passwd );

Sets and returns the password part of the $uri's L<URI/userinfo>.  If the
password contains C<:>, it is escaped.

The user name and password are seperated by C<:>.  This is might be a security
issue.  Beware.

While this method is called I<password>, it works just as well with pass
phrases.

A password only makes sense in IKC.

=head2 as_array

    $poe_kernel->post( @$uri, @args );
    $poe_kernel->post( $uri->as_array, @args );

Returns a URI object to a session/event tuple, suitable for posting or
calling. POEx::URI objects are also converted to arrays
automatically by overloading.  

If a kernel name is present, and it is not the local kernel ID, then it is
prepended to the session name.  This is compatible with IKC after
subscribing to the remote session.

If an argument is present, it is returned as the last item.  

=head2 canonical

    my $full = $uri->canonical;

Returns a normalized version of the URI.  For POE URIs, the hostname is 
folded to lower case.


=head2 path

    $path = $uri->path;
    $old = $uri->path( $new_path );

Sets and returns the session/event tupple of a $uri.  If the new path
contains more then one slash, the last segment of the path is the event, and
the others are the session and those slash are escaped.