Lite.pm

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use 5.010000;
use autodie;

package URI::Lite {
    use Class::Accessor::Lite 0.05 (
        rw => [qw(scheme user password host port path query)],
    );
    use URL::Encode::XS qw/url_encode/;
    use overload (
        q{""} => \&as_string,
    );

    sub parse {
        my ($class, $url) = @_;

        $url =~ m{\A
                ([a-z]+)                    # scheme
                ://
                (?:
                    ([^/:@?]+) # user
                    :
                    ([^/:@?]+) # password
                    @
                )?
                ([^/:?]+)                   # host
                (?: : (\d+) )?              # port
                (?:
                    ( /? | / [^?]*)    # path
                    (?: \? ( .* ) )    # query
                )?  # path_query
        \z}xms or Carp::croak("Passed malformed URL: $url");

        my %args = (
            scheme     => $1,
            user       => $2,
            password   => $3,
            host       => $4,
            port       => $5,
            path       => $6,
        );

        if (defined $7) {
            $args{query} = URL::Encode::XS::url_params_flat($7);
        } else {
            $args{query} = [];
        }

        return bless { %args }, $class;
    }

    sub push_query {
        my ($self, $k, $v) = @_;
        push @{$self->{query}}, $k, $v;
    }

    sub as_string {
        my $self = shift;

        my $ret = $self->{scheme};
           $ret .= "://";
        if (defined($self->{user}) && defined($self->{password})) {
           $ret .= $self->{user} . ':' . $self->{password} . '@';
        }
        $ret .= $self->{host};
        if (defined($self->{port})) {
            $ret .= ':' . $self->{port};
        }
        $ret .= $self->{path};
        my @query = @{$self->{query}};
        if (@query) {
            $ret .= '?';
            while (@query) {
                $ret .= shift(@query) . '=' . url_encode(shift(@query));
                $ret .= '&' if @query;
            }
        }
        return $ret;
    }
}