lib/HTTP/Body/XFormsMultipart.pm

   1 package HTTP::Body::XFormsMultipart;
   2
   3 use strict;
   4 use base 'HTTP::Body::MultiPart';
   5 use bytes;
   6
   7 use IO::File;
   8 use File::Temp 0.14;
   9
  10 =head1 NAME
  11
  12 HTTP::Body::XFormsMultipart - HTTP Body XForms multipart/related submission Parser
  13
  14 =head1 SYNOPSIS
  15
  16     use HTTP::Body::XForms;
  17
  18 =head1 DESCRIPTION
  19
  20 HTTP Body XForms submission Parser. Inherits HTTP::Body::MultiPart.
  21
  22 This body type is used to parse XForms submission. In this case, the
  23 XML part that contains the model is indicated by the start attribute
  24 in the content-type. The XML content is stored unparsed on the
  25 parameter XForms:Model.
  26
  27 =head1 METHODS
  28
  29 =over 4
  30
  31 =item init
  32
  33 This function is overrided to detect the start part of the
  34 multipart/related post.
  35
  36 =cut
  37
  38 sub init {
  39     my $self = shift;
  40     $self->SUPER::init(@_);
  41     unless ( $self->content_type =~ /start=\"?\<?([^\"\>;,]+)\>?\"?/ ) {
  42         my $content_type = $self->content_type;
  43         Carp::croak( "Invalid boundary in content_type: '$content_type'" );
  44     }
  45
  46     $self->{start} = $1;
  47
  48     return $self;
  49 }
  50
  51 =item start
  52
  53 Defines the start part of the multipart/related body.
  54
  55 =cut
  56
  57 sub start {
  58     return shift->{start};
  59 }
  60
  61 =item handler
  62
  63 This function is overrided to differ the start part, which should be
  64 set as the XForms:Model param if its content type is application/xml.
  65
  66 =cut
  67
  68 sub handler {
  69     my ( $self, $part ) = @_;
  70
  71     my $contentid = $part->{headers}{'Content-ID'};
  72     $contentid =~ s/^.*[\<\"]//;
  73     $contentid =~ s/[\>\"].*$//;
  74
  75     if ( $contentid eq $self->start ) {
  76         $part->{name} = 'XForms:Model';
  77     }
  78     elsif ( defined $contentid ) {
  79         $part->{name}     = $contentid;
  80         $part->{filename} = $contentid;
  81     }
  82
  83     return $self->SUPER::handler($part);
  84 }
  85
  86 =back
  87
  88 =head1 AUTHOR
  89
  90 Daniel Ruoso C<daniel@ruoso.com>
  91
  92 =head1 LICENSE
  93
  94 This library is free software . You can redistribute it and/or modify
  95 it under the same terms as perl itself.
  96
  97 =cut
  98
  99 1;