CGI-Utils

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

    whether or not the url already contains a query string and modifies it
    accordingly. If you want to add a multivalued parameter, pass it as a
    reference to an array containing all the values.

    If the optional $sep parameter is passed, it is used as the parameter
    separator instead of ';', unless the URL already contains '&' chars, in
    which case it will use '&' for the separator.

    Aliases: add_params_to_url()

  getParsedCookies()
    Parses the cookies passed to the server. Returns a hash of key/value
    pairs representing the cookie names and values.

    Aliases: get_parsed_cookies

  param($name)
    Returns the CGI parameter with name $name. If called in array context,
    it returns an array. In scalar context, it returns an array reference
    for multivalued fields, and a scalar for single-valued fields.

README  view on Meta::CPAN

    assumed to be 'text/html'. The charset defaults to ISO-8859-1. A hash
    reference can also be passed. E.g.,

     print $cgi_obj->getHeader({ content_type => 'text/html', expires => '+3d' });

    The names 'content-type', and 'type' are aliases for 'content_type'. The
    arguments may also be passed CGI.pm style with a '-' in front, e.g.

     print $cgi_obj->getHeader( -content_type => 'text/html', -expires => '+3d' );

    Cookies may be passed with the 'cookies' key either as a string, a hash
    ref, or as a CGI::Cookies object, e.g.

     my $cookie = { name => 'my_cookie', value => 'cookie_val' };
     print $cgi_obj->getHeader(cookies => $cookie);

    You may also pass an array of cookies, e.g.,

     print $cgi_obj->getHeader(cookies => [ $cookie1, $cookie2 ]);

    Aliases: header(), get_header

README  view on Meta::CPAN

     return $utils->sendRedirect($url)

    n a mod_perl handler.

    Aliases: send_redirect()

  getLocalRedirect(), local_redirect(), get_local_redirect()
    Like getRedirect(), except that the redirect URL is converted from
    relative to absolute, including the host.

  getCookieString(\%hash), get_cookie_string(\%hash);
    Returns a string to pass as the value of a 'Set-Cookie' header.

  getSetCookieString(\%params), getSetCookieString([ \%params1, \%params2 ])
    Returns a string to pass as the 'Set-Cookie' header(s), including the
    line ending(s). Also accepts a simple hash with key/value pairs.

  setCookie(\%params), set_cookie(\%params);
    Sets the cookie generated by getCookieString. That is, in a mod_perl
    environment, it adds an outgoing header to set the cookie. In a CGI
    environment, it prints the value of getSetCookieString to STDOUT
    (including the end-of-line sequence).

  uploadInfo($file_name)
    Returns a reference to a hash containing the header information sent
    along with a file upload.

Apache constants under mod_perl
    Shortcut methods are provided for returning Apache constants under
    mod_perl. The methods figure out if they are running under mod_perl 1 or
    2 and make the appropriate call to get the right constant back, e.g.,

WhatsNew  view on Meta::CPAN

          - convertRelativeUrlWithParams
	  - getSelfRefUrlWithParams

Version 0.09
	* apache_* methods
	* support for mod_perl 2 in addition to mod_perl 1
	* added underscore versions of more methods
	* fixed some formatting issues with the POD documentation

Version 0.08
	* setCookie()
	* More underscore versions of methods
	* Command-line parsing is now available.
	* Fixed a bug where a mod_perl environment was always assumed
	  for some methods
	* sendHeader()
	* sendRedirect()
	* setCookie()

Version 0.07
        * Support for mod_perl and Mason (multipart/form-data for
          mod_perl requires Apache::Request)
        * getRemoteAddr()
	* getRemoteHost()
        * getHost()
	* getReferer()
	* getProtocol()
	* getLocalRedirect()

lib/CGI/Utils.pm  view on Meta::CPAN

        }
    }

    use constant MP2 => $CGI::Utils::MP2;
    
    require Exporter;
    @ISA = 'Exporter';
    @EXPORT = ();
    @EXPORT_OK = qw(urlEncode urlDecode urlEncodeVars urlDecodeVars getSelfRefHostUrl
                    getSelfRefUrl getSelfRefUrlWithQuery getSelfRefUrlDir addParamsToUrl
                    getParsedCookies escapeHtml escapeHtmlFormValue convertRelativeUrlWithParams
                    convertRelativeUrlWithArgs getSelfRefUri);
    $EXPORT_TAGS{all_utils} = [ qw(urlEncode urlDecode urlEncodeVars urlDecodeVars
                                   getSelfRefHostUrl
                                   getSelfRefUrl getSelfRefUrlWithQuery getSelfRefUrlDir
                                   addParamsToUrl getParsedCookies escapeHtml escapeHtmlFormValue
                                   convertRelativeUrlWithParams convertRelativeUrlWithArgs
                                   getSelfRefUri)
                              ];

=pod

=head2 new(\%params)

Returns a new CGI::Utils object.  Parameters are optional.
CGI::Utils supports mod_perl if the Apache request object is

lib/CGI/Utils.pm  view on Meta::CPAN

            $url .= $sep unless $url =~ /\?$/;
        } else {
            $url .= '?';
        }

        $url .= $self->urlEncodeVars($param_hash, $sep);
        return $url;
    }
    *add_params_to_url = \&addParamsToUrl;

    sub _getRawCookie {
        my $self = shift;

        if ($self->_isModPerl) {
            my $r = $self->_getApacheRequest;
            return $r ? $r->headers_in()->{Cookie} : ($ENV{HTTP_COOKIE} || $ENV{COOKIE} || '');
        }
        else {
            return $ENV{HTTP_COOKIE} || $ENV{COOKIE} || '';
        }
    }

=pod

=head2 getParsedCookies()

Parses the cookies passed to the server.  Returns a hash of
key/value pairs representing the cookie names and values.

Aliases: get_parsed_cookies

=cut
    sub getParsedCookies {
        my ($self) = @_;
        my %cookies = map { (map { $self->urlDecode($_) } split(/=/, $_, 2)) }
            split(/;\s*/, $self->_getRawCookie);
        return \%cookies;
    }
    *get_parsed_cookies = \&getParsedCookies;

    # added for v0.06
    # for compatibility with CGI.pm
    # may want to create an object here
    sub cookie {
        my ($self, @args) = @_;
        my $map_list = [ 'name', [ 'value', 'values' ], 'path', 'expires', 'domain', 'secure' ];
        my $params = $self->_parse_sub_params($map_list, \@args);
        if (exists($$params{value})) {
            return $params;
        } else {
            my $cookies = $self->getParsedCookies;
            if ($cookies and %$cookies) {
                return $$cookies{$$params{name}};
            }
            return '';
        }
        return $params;
    }

# =pod

lib/CGI/Utils.pm  view on Meta::CPAN

to ISO-8859-1.  A hash reference can also be passed.  E.g.,

 print $cgi_obj->getHeader({ content_type => 'text/html', expires => '+3d' });

The names 'content-type', and 'type' are aliases for
'content_type'.  The arguments may also be passed CGI.pm style
with a '-' in front, e.g.

 print $cgi_obj->getHeader( -content_type => 'text/html', -expires => '+3d' );

Cookies may be passed with the 'cookies' key either as a string,
a hash ref, or as a CGI::Cookies object, e.g.

 my $cookie = { name => 'my_cookie', value => 'cookie_val' };
 print $cgi_obj->getHeader(cookies => $cookie);

You may also pass an array of cookies, e.g.,

 print $cgi_obj->getHeader(cookies => [ $cookie1, $cookie2 ]);

Aliases: header(), get_header

lib/CGI/Utils.pm  view on Meta::CPAN

        # FIXME: handle NPH stuff

        my $headers = [];
        push @$headers, "Status: $$params{status}" if defined($$params{status});
        push @$headers, "Window-Target: $$params{target}" if defined($$params{target});
        
        my $cookies = $$params{cookie};
        if (defined($cookies) and $cookies) {
            my $cookie_array = ref($cookies) eq 'ARRAY' ? $cookies : [ $cookies ];
            foreach my $cookie (@$cookie_array) {
                # handle plain strings as well as CGI::Cookie objects and hashes
                my $str = '';
                if (UNIVERSAL::isa($cookie, 'CGI::Cookie')) {
                    $str = $cookie->as_string;
                } elsif (ref($cookie) eq 'HASH') {
                    $str = $self->_createCookieStrFromHash($cookie);
                } else {
                    $str = $cookie;
                }
                push @$headers, "Set-Cookie: $str" unless $str eq '';
            }
        }

        if (defined($$params{expires})) {
            my $expire = $self->_canonicalizeHttpDate($$params{expires});
            push @$headers, "Expires: $expire";
        }

        if (defined($$params{expires}) or (defined($cookies) and $cookies)) {
            push @$headers, "Date: " . $self->_canonicalizeHttpDate(0);

lib/CGI/Utils.pm  view on Meta::CPAN

        unless ($params->{location} =~ m{^https?://}) {
            $params->{location} = $self->convertRelativeUrlWithParams($params->{location}, {});
        }
        return $self->getRedirect(%$params);
    }
    *local_redirect = \&getLocalRedirect;
    *get_local_redirect = \&getLocalRedirect;

=pod

=head2 getCookieString(\%hash), get_cookie_string(\%hash);

Returns a string to pass as the value of a 'Set-Cookie' header.

=cut
    sub getCookieString {
        my ($self, $hash) = @_;
        return $self->_createCookieStrFromHash($hash);
    }
    *get_cookie_string = \&getCookieString;

=pod

=head2 getSetCookieString(\%params), getSetCookieString([ \%params1, \%params2 ])

Returns a string to pass as the 'Set-Cookie' header(s), including
the line ending(s).  Also accepts a simple hash with key/value pairs.

=cut
    sub getSetCookieString {
        my ($self, $cookies) = @_;
        if (ref($cookies) eq 'HASH') {
            my $array = [ map { { name => $_, value => $cookies->{$_} } } keys %$cookies ];
            $cookies = $array;
        }
        my $cookie_array = ref($cookies) eq 'ARRAY' ? $cookies : [ $cookies ];

        my $headers = [];
        foreach my $cookie (@$cookie_array) {
            # handle plain strings as well as CGI::Cookie objects and hashes
            my $str = '';
            if (UNIVERSAL::isa($cookie, 'CGI::Cookie')) {
                $str = $cookie->as_string;
            } elsif (ref($cookie) eq 'HASH') {
                $str = $self->_createCookieStrFromHash($cookie);    
            } else {
                $str = $cookie;
            }
            push @$headers, "Set-Cookie: $str" unless $str eq '';
        }

        # FIXME: make line endings work on windoze
        return join("\r\n", @$headers) . "\r\n";
    }
    *get_set_cookie_string = \&getSetCookieString;

=pod

=head2 setCookie(\%params), set_cookie(\%params);

Sets the cookie generated by getCookieString.  That is, in a
mod_perl environment, it adds an outgoing header to set the
cookie.  In a CGI environment, it prints the value of
getSetCookieString to STDOUT (including the end-of-line
sequence).

=cut
    sub setCookie {
        my $self = shift;
        my $params = shift;

        my $str = $self->_createCookieStrFromHash($params);
        my $r = $self->_getApacheRequest;

        if ($r) {
            $r->err_headers_out()->add('Set-Cookie' => $str);
        }
        else {
            print STDOUT "Set-Cookie: $str\r\n";
        }
    }
    *set_cookie = \&setCookie;
    
    sub _createCookieStrFromHash {
        my ($self, $hash) = @_;
        my $pairs = [];

        my $map_list = [ 'name', [ 'value', 'values', 'val' ],
                         'path', 'expires', 'domain', 'secure',
                       ];
        my $params = $self->_parse_sub_params($map_list, [ $hash ]);

        my $value = $$params{value};
        if (my $ref = ref($value)) {

lib/CGI/Utils.pm  view on Meta::CPAN

            $value = $self->urlEncode($value);
        }
        push @$pairs, qq{$$params{name}=$value};

        my $path = $$params{path} || '/';
        push @$pairs, qq{path=$path};
        
        push @$pairs, qq{domain=$$params{domain}} if $$params{domain};

        if ($$params{expires}) {
            my $expire = $self->_canonicalizeCookieDate($$params{expires});
            push @$pairs, qq{expires=$expire};
        }

        push @$pairs, qq{secure} if $$params{secure};

        return join('; ', @$pairs);
    }
    
    sub _canonicalizeCookieDate {
        my ($self, $expire) = @_;
        return $self->_canonicalizeDate('-', $expire);
    }
    
    sub _canonicalizeHttpDate {
        my ($self, $expire) = @_;
        return $self->_canonicalizeDate(' ', $expire);
        
        my $time = $self->_get_expire_time_from_offset($expire);
        return $time unless $time =~ /^\d+$/;

t/03cookies.t  view on Meta::CPAN

    local($SIG{__DIE__}) = sub { &Carp::cluck(); exit 0 };


    use Test;
    BEGIN { plan tests => 1 }

    use CGI::Utils;

    $ENV{HTTP_COOKIE} = 'cook1=val1;cook2=val2; cook3=val3';
    my $utils = CGI::Utils->new;
    my $cookies = $utils->getParsedCookies;

    ok(&test_parsed_cookies($cookies));
}

exit 0;

###############################################################################
# Subroutines

sub test_parsed_cookies {



( run in 0.672 second using v1.01-cache-2.11-cpan-e9199f4ba4c )