The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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.17';

#{{{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__

=head1 NAME

Apache::Sling::URL - Functions for handling urls to be passed from/to an Apache Sling instance.

=head1 ABSTRACT

useful utility functions for manipulating URLs.

=head1 METHODS

=head2 add_leading_slash

Function to add a leading slash to a string if one does not exist.

=head2 strip_leading_slash

Function to remove any leading slashes from a string.

=head2 properties_array_to_string

Function to convert an array of a property values to a suitable string
representation.

=head2 urlencode

Function to encode a string so it is suitable for use in urls.

=head2 url_input_sanitize

Sanitizes input url by removing trailing slashes and adding a protocol if
missing.

=head1 USAGE

use Apache::Sling::URL;

=head1 DESCRIPTION

Utility library providing useful URL functions for general Rest functionality.

=head1 REQUIRED ARGUMENTS

None required.

=head1 OPTIONS

n/a

=head1 DIAGNOSTICS

n/a

=head1 EXIT STATUS

0 on success.

=head1 CONFIGURATION

None required.

=head1 DEPENDENCIES

=head1 INCOMPATIBILITIES

None known.

=head1 BUGS AND LIMITATIONS

None known.

=head1 AUTHOR

Daniel David Parry <perl@ddp.me.uk>

=head1 LICENSE AND COPYRIGHT

LICENSE: http://dev.perl.org/licenses/artistic.html

COPYRIGHT: (c) 2011 Daniel David Parry <perl@ddp.me.uk>