File Coverage

blib/lib/Apache/Sling/URL.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	16	16	100.0
condition			n/a
subroutine	9	9	100.0
pod	5	5	100.0
total	74	74	100.0

#!/usr/bin/perl -w

package Apache::Sling::URL;

use 5.008001;
use strict;
use warnings;

require Exporter;

use base qw(Exporter);

our @EXPORT_OK = ();

our $VERSION = '0.27';

#{{{sub add_leading_slash

sub add_leading_slash {
    my ($value) = @_;
    if ( defined $value ) {
        if ( $value !~ /^\//msx ) {
            $value = "/$value";
        }
    }
    return ($value);
}

#}}}

#{{{sub strip_leading_slash

sub strip_leading_slash {
    my ($value) = @_;
    if ( defined $value ) {
        $value =~ s/^\///msx;
    }
    return ($value);
}

#}}}

#{{{sub properties_array_to_string

sub properties_array_to_string {
    my ($properties) = @_;
    my $property_post_vars;
    foreach my $property ( @{$properties} ) {

        # Escaping single quotes:
        $property =~ s/'/\\'/gmsx;
        $property =~ /^([^=]*)=(.*)/msx;
        if ( defined $1 ) {
            $property_post_vars .= "'$1','$2',";
        }
    }
    if ( defined $property_post_vars ) {
        $property_post_vars =~ s/,$//msx;
    }
    else {
        $property_post_vars = q{};
    }
    return $property_post_vars;
}

#}}}

#{{{sub urlencode

sub urlencode {
    my ($value) = @_;
    $value =~
      s/([^a-zA-Z_0-9 ])/"%" . uc(sprintf "%lx" , unpack("C", $1))/egmsx;
    $value =~ tr/ /+/;
    return ($value);
}

#}}}

#{{{sub url_input_sanitize

sub url_input_sanitize {
    my ($url) = @_;
    $url = ( defined $url ? $url : 'http://localhost:8080' );
    $url = ( $url ne q{} ? $url : 'http://localhost:8080' );
    $url =~ s/(.*)\/$/$1/msx;
    $url = ( $url !~ /^http/msx ? "http://$url" : "$url" );
    return ($url);
}

#}}}

1;

__END__