File Coverage

blib/lib/HTTP/Body/XFormsMultipart.pm

Criterion	Covered	Total	%
statement	32	34	94.1
branch	5	8	62.5
condition			n/a
subroutine	8	8	100.0
pod	3	3	100.0
total	48	53	90.5

package HTTP::Body::XFormsMultipart;
$HTTP::Body::XFormsMultipart::VERSION = '1.23';
use strict;
use base 'HTTP::Body::MultiPart';
use bytes;

use IO::File;
use File::Temp 0.14;

=head1 NAME

HTTP::Body::XFormsMultipart - HTTP Body XForms multipart/related submission Parser

=head1 SYNOPSIS

    use HTTP::Body::XForms;

=head1 DESCRIPTION

HTTP Body XForms submission Parser. Inherits HTTP::Body::MultiPart.

This body type is used to parse XForms submission. In this case, the
XML part that contains the model is indicated by the start attribute
in the content-type. The XML content is stored unparsed on the
parameter XForms:Model.

=head1 METHODS

=over 4

=item init

This function is overridden to detect the start part of the
multipart/related post.

=cut

sub init {
    my $self = shift;
    $self->SUPER::init(@_);
    unless ( $self->content_type =~ /start=\"?\<?([^\"\>;,]+)\>?\"?/ ) {
        my $content_type = $self->content_type;
        Carp::croak( "Invalid boundary in content_type: '$content_type'" );
    }

    $self->{start} = $1;

    return $self;
}

=item start

Defines the start part of the multipart/related body.

=cut

sub start {
    return shift->{start};
}

=item handler

This function is overridden to differ the start part, which should be
set as the XForms:Model param if its content type is application/xml.

=cut

sub handler {
    my ( $self, $part ) = @_;

    my $contentid = $part->{headers}{'Content-ID'};
    $contentid =~ s/^.*[\<\"]//;
    $contentid =~ s/[\>\"].*$//;

    if ( $contentid eq $self->start ) {
        $part->{name} = 'XForms:Model';
        if ($part->{done}) {
            $self->body($part->{data});
        }
    }
    elsif ( defined $contentid ) {
        $part->{name}     = $contentid;
        $part->{filename} = $contentid;
    }

    return $self->SUPER::handler($part);
}

=back

=head1 SUPPORT

See L<HTTP::Body>

=head1 AUTHOR

Daniel Ruoso C<[e-mail]>

=head1 LICENSE

This library is free software . You can redistribute it and/or modify
it under the same terms as perl itself.

=cut

1;