File Coverage

blib/lib/SOAPjr/request.pm

Criterion	Covered	Total	%
statement	24	68	35.2
branch	0	22	0.0
condition	0	3	0.0
subroutine	8	10	80.0
pod	0	1	0.0
total	32	104	30.7

package SOAPjr::request;

use strict;
use warnings;
use File::Basename;
use File::Temp;
use File::Copy;
use URI::Escape;

=head1 NAME

SOAPjr::request - the SOAPjr request object

=head1 VERSION

Version 1.0.3

=cut

our $VERSION = "1.0.3";

=head1 SYNOPSIS

    See perldoc SOAPjr for more info.

=cut

use base qw(SOAPjr::message);
use Carp;

sub _init {
    my $self = shift;
    $self->{server} = shift;
    my $query = shift;
    $self = $self->SUPER::_init(@_);
    my $update_count = $self->set($query);
    return $self;
}

sub set {
    my $self  = shift;
    my $query = shift;
    my $cgi_query;
    my $count = 0;
    my $json;
    if (ref($query) ne 'HASH' && $query->can("param")) {
        # Make a copy
        $cgi_query = $query;
        my @names = $query->param;
        my %params = ( map { $_ => $query->param($_) } @names );
        $query = { params => \%params };
    }
    if (exists $query->{params}) {
        if (exists $query->{params}->{json} ) {
            my $url_decoded_json = uri_unescape($query->{params}->{json});
            if ($self->{json}->can("decode")) {
                # Modern-ish 2.x JSON API
                $json = $self->{json}->decode( $url_decoded_json );
            } elsif ($self->{json}->can("jsonToObj")) {
                # Olde Version 1.x JSON API
                $json = $self->{json}->jsonToObj( $url_decoded_json );
            } else {
                # TODO: handle unknown JSON API
                carp "WARNING: unknown JSON API";
            }
            if ( $json->{HEAD} ) {
                $self->{_data}->{HEAD} = $json->{HEAD};
            } else {
                carp "WARNING: HEAD missing";
            }
            if ( $json->{BODY} ) {
                $self->{_data}->{BODY} = $json->{BODY};
            } else {
                carp "WARNING: BODY missing";
            }
            # TODO: what about json_type

            # Check for "RELATED" components
            if (exists $json->{HEAD}->{related}) {
                while (my ($k, $v) = each %{$json->{HEAD}->{related}}) {
                    # TODO: handle other types of related content
                    next unless ($v eq 'binary');
                    # Append file data
                    unless ($cgi_query) {
                        carp "WARNING: related item is a file but query not a CGI object";
                    }
                    my $filename = $cgi_query->param($k);
                    my $fh = $cgi_query->upload($k);
                    # Save CGI tmp file into our own tmp file (for lifecycle
                    # reasons)
                    my $tmp_fh = File::Temp->new(UNLINK => 0);
                    my $tmp_file = $tmp_fh->filename;
                    copy ($fh, $tmp_file) or die $!;
                    close $tmp_fh;
                    $self->{_data}->{BODY}->{$k}->{filepath} = $tmp_file;
                }
            }
        }
    }

    return $self->SUPER::set( $query, $count );
}

=head1 AUTHOR

Rob Manson,

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc SOAPjr


You can also look for information at:

=over 4

=item * SOAPjr.org

L

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back

=head1 ACKNOWLEDGEMENTS

See L for further information on related RFC's and specifications.

=head1 COPYRIGHT & LICENSE

    Copyright 2008 Rob Manson, Sean McCarthy and http://SOAPjr.org, some rights reserved.

    This file is part of SOAPjr.

    SOAPjr is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    SOAPjr is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with SOAPjr.  If not, see .

=cut

1;