| Subject: | (PATCH) Support for XForms submissions |
Hi,
XForms describes two new unique ways of posting. These are identified by
a POST with Content-type: application/xml or a POST with Content-type:
multipart/related; boundary=xxx; start=xxx; where start is the
Content-ID of the XML data.
Attached is a patch that implements the support for this two types of
POST, the patch includes a new test script which test the new
feature. All the tests continue to pass in my environment.
Please consider applying this patch, XForms is starting to become an
option for new web applications in controlled environments.
Thanks in advance,
Daniel Ruoso
| Subject: | HTTP-Body-0.6-xforms.patch |
diff -uNard HTTP-Body-0.6-ori/Changes HTTP-Body-0.6/Changes
--- HTTP-Body-0.6-ori/Changes 2006-01-06 11:40:59.000000000 +0000
+++ HTTP-Body-0.6/Changes 2006-10-12 16:08:30.000000000 +0100
@@ -1,5 +1,8 @@
This file documents the revision history for Perl extension HTTP::Body.
+Patch on 0.6 2006-10-12 16:08:00 WEST
+ - Adding support for XForms submissions, Daniel Ruoso <daniel@ruoso.com>
+
0.6 2006-01-06 00:00:00
- Fixed buffer bug in OctetStream, reported by Daisuke Murase <typester@cpan.org>.
- Fixed YAML prereq, reported by Jess Robinson
diff -uNard HTTP-Body-0.6-ori/lib/HTTP/Body/MultiPart.pm HTTP-Body-0.6/lib/HTTP/Body/MultiPart.pm
--- HTTP-Body-0.6-ori/lib/HTTP/Body/MultiPart.pm 2005-11-17 12:59:02.000000000 +0000
+++ HTTP-Body-0.6/lib/HTTP/Body/MultiPart.pm 2006-10-12 15:26:04.000000000 +0100
@@ -270,17 +270,12 @@
$part->{name} = $name;
$part->{filename} = $filename;
-
- if ($filename) {
-
- my $fh = File::Temp->new( UNLINK => 0 );
-
- $part->{fh} = $fh;
- $part->{tempname} = $fh->filename;
- }
}
if ( $part->{filename} && ( my $length = length( $part->{data} ) ) ) {
+ my $fh = File::Temp->new( UNLINK => 0 );
+ $part->{fh} = $fh;
+ $part->{tempname} = $fh->filename;
$part->{fh}->write( substr( $part->{data}, 0, $length, '' ), $length );
}
diff -uNard HTTP-Body-0.6-ori/lib/HTTP/Body/XFormsMultipart.pm HTTP-Body-0.6/lib/HTTP/Body/XFormsMultipart.pm
--- HTTP-Body-0.6-ori/lib/HTTP/Body/XFormsMultipart.pm 1970-01-01 01:00:00.000000000 +0100
+++ HTTP-Body-0.6/lib/HTTP/Body/XFormsMultipart.pm 2006-10-12 16:10:39.000000000 +0100
@@ -0,0 +1,96 @@
+package HTTP::Body::XFormsMultipart;
+
+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 overrided 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 overrided 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';
+ } elsif (defined $contentid) {
+ $part->{name} = $contentid;
+ $part->{filename} = $contentid;
+ }
+
+ return $self->SUPER::handler($part);
+}
+
+=back
+
+=head1 AUTHOR
+
+Daniel Ruoso C<daniel@ruoso.com>
+
+=head1 LICENSE
+
+This library is free software . You can redistribute it and/or modify
+it under the same terms as perl itself.
+
+=cut
+
+1;
diff -uNard HTTP-Body-0.6-ori/lib/HTTP/Body/XForms.pm HTTP-Body-0.6/lib/HTTP/Body/XForms.pm
--- HTTP-Body-0.6-ori/lib/HTTP/Body/XForms.pm 1970-01-01 01:00:00.000000000 +0100
+++ HTTP-Body-0.6/lib/HTTP/Body/XForms.pm 2006-10-12 16:08:43.000000000 +0100
@@ -0,0 +1,56 @@
+package HTTP::Body::XForms;
+
+use strict;
+use base 'HTTP::Body';
+use bytes;
+
+use File::Temp 0.14;
+
+=head1 NAME
+
+HTTP::Body::XForms - HTTP Body XForms Parser
+
+=head1 SYNOPSIS
+
+ use HTTP::Body::XForms;
+
+=head1 DESCRIPTION
+
+HTTP Body XForms Parser. This module parses single part XForms
+submissions, which are identifiable by the content-type
+application/xml. The XML is stored unparsed on the parameter
+XForms:Model.
+
+=head1 METHODS
+
+=over 4
+
+=item spin
+
+This method is overwrited to set the param XForms:Model with
+the buffer content.
+
+=cut
+
+sub spin {
+ my $self = shift;
+ $self->param('XForms:Model',$self->{buffer});
+ $self->{buffer} = '';
+ $self->{state} = 'done';
+ return $self->SUPER::init();
+}
+
+=back
+
+=head1 AUTHOR
+
+Daniel Ruoso, C<daniel@ruoso.com>
+
+=head1 LICENSE
+
+This library is free software . You can redistribute it and/or modify
+it under the same terms as perl itself.
+
+=cut
+
+1;
diff -uNard HTTP-Body-0.6-ori/lib/HTTP/Body.pm HTTP-Body-0.6/lib/HTTP/Body.pm
--- HTTP-Body-0.6-ori/lib/HTTP/Body.pm 2005-11-22 23:15:16.000000000 +0000
+++ HTTP-Body-0.6/lib/HTTP/Body.pm 2006-10-12 16:13:20.000000000 +0100
@@ -9,12 +9,16 @@
our $TYPES = {
'application/octet-stream' => 'HTTP::Body::OctetStream',
'application/x-www-form-urlencoded' => 'HTTP::Body::UrlEncoded',
- 'multipart/form-data' => 'HTTP::Body::MultiPart'
+ 'multipart/form-data' => 'HTTP::Body::MultiPart',
+ 'multipart/related' => 'HTTP::Body::XFormsMultipart',
+ 'application/xml' => 'HTTP::Body::XForms'
};
require HTTP::Body::OctetStream;
require HTTP::Body::UrlEncoded;
require HTTP::Body::MultiPart;
+require HTTP::Body::XFormsMultipart;
+require HTTP::Body::XForms;
=head1 NAME
diff -uNard HTTP-Body-0.6-ori/t/07xforms.t HTTP-Body-0.6/t/07xforms.t
--- HTTP-Body-0.6-ori/t/07xforms.t 1970-01-01 01:00:00.000000000 +0100
+++ HTTP-Body-0.6/t/07xforms.t 2006-10-12 16:05:30.000000000 +0100
@@ -0,0 +1,49 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 12;
+
+use Cwd;
+use HTTP::Body;
+use File::Spec::Functions;
+use IO::File;
+use YAML;
+
+my $path = catdir( getcwd(), 't', 'data', 'xforms' );
+
+for ( my $i = 1; $i <= 2; $i++ ) {
+
+ my $test = sprintf( "%.3d", $i );
+ my $headers = YAML::LoadFile( catfile( $path, "$test-headers.yml" ) );
+ my $results = YAML::LoadFile( catfile( $path, "$test-results.yml" ) );
+ my $content = IO::File->new( catfile( $path, "$test-content.dat" ) );
+ my $body = HTTP::Body->new( $headers->{'Content-Type'}, $headers->{'Content-Length'} );
+
+ binmode $content, ':raw';
+
+ while ( $content->read( my $buffer, 1024 ) ) {
+ $body->add($buffer);
+ }
+
+ for my $field ( keys %{ $body->upload } ) {
+
+ my $value = $body->upload->{$field};
+
+ for ( ( ref($value) eq 'ARRAY' ) ? @{$value} : $value ) {
+ delete $_->{tempname};
+ }
+ }
+
+ is_deeply( $body->body, $results->{body}, "$test XForms body" );
+ is_deeply( $body->param, $results->{param}, "$test XForms param" );
+ is_deeply( $body->upload, $results->{upload}, "$test XForms upload" );
+ if ($body->isa('HTTP::Body::XFormsMultipart')) {
+ cmp_ok( $body->start, 'eq', $results->{start}, "$test XForms start" );
+ } else {
+ ok(1,"$test XForms start");
+ }
+ cmp_ok( $body->state, 'eq', 'done', "$test XForms state" );
+ cmp_ok( $body->length, '==', $headers->{'Content-Length'}, "$test XForms length" );
+}
diff -uNard HTTP-Body-0.6-ori/t/data/xforms/001-content.dat HTTP-Body-0.6/t/data/xforms/001-content.dat
--- HTTP-Body-0.6-ori/t/data/xforms/001-content.dat 1970-01-01 01:00:00.000000000 +0100
+++ HTTP-Body-0.6/t/data/xforms/001-content.dat 2006-10-12 16:04:53.000000000 +0100
@@ -0,0 +1,13 @@
+------------0xKhTmLbOuNdArY
+Content-ID: <asdfg@asdfg.com>
+
+<model><data1>asdfg</data1><data2>asdfg</data2></model>
+------------0xKhTmLbOuNdArY
+Content-ID: <qwert@qwerty.com>
+
+Attachment file 1
+------------0xKhTmLbOuNdArY
+Content-ID: <zxcvb@zxcvb.com>
+
+Attachment file 2
+------------0xKhTmLbOuNdArY--
diff -uNard HTTP-Body-0.6-ori/t/data/xforms/001-headers.yml HTTP-Body-0.6/t/data/xforms/001-headers.yml
--- HTTP-Body-0.6-ori/t/data/xforms/001-headers.yml 1970-01-01 01:00:00.000000000 +0100
+++ HTTP-Body-0.6/t/data/xforms/001-headers.yml 2006-10-12 16:04:59.000000000 +0100
@@ -0,0 +1,4 @@
+---
+Content-Length: 313
+Content-Type: multipart/related; boundary=----------0xKhTmLbOuNdArY; start=<asdfg@asdfg.com>
+User-Agent: 'Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en) AppleWebKit/312.1 (KHTML, like Gecko) Safari/312'
diff -uNard HTTP-Body-0.6-ori/t/data/xforms/001-results.yml HTTP-Body-0.6/t/data/xforms/001-results.yml
--- HTTP-Body-0.6-ori/t/data/xforms/001-results.yml 1970-01-01 01:00:00.000000000 +0100
+++ HTTP-Body-0.6/t/data/xforms/001-results.yml 2006-10-12 15:28:02.000000000 +0100
@@ -0,0 +1,18 @@
+---
+body: ~
+start: asdfg@asdfg.com
+param:
+ XForms:Model: <model><data1>asdfg</data1><data2>asdfg</data2></model>
+upload:
+ qwert@qwerty.com:
+ filename: qwert@qwerty.com
+ headers:
+ Content-ID: <qwert@qwerty.com>
+ name: qwert@qwerty.com
+ size: 17
+ zxcvb@zxcvb.com:
+ filename: zxcvb@zxcvb.com
+ headers:
+ Content-ID: <zxcvb@zxcvb.com>
+ name: zxcvb@zxcvb.com
+ size: 17
diff -uNard HTTP-Body-0.6-ori/t/data/xforms/002-content.dat HTTP-Body-0.6/t/data/xforms/002-content.dat
--- HTTP-Body-0.6-ori/t/data/xforms/002-content.dat 1970-01-01 01:00:00.000000000 +0100
+++ HTTP-Body-0.6/t/data/xforms/002-content.dat 2006-10-12 15:50:53.000000000 +0100
@@ -0,0 +1 @@
+<model><data1>asdfg</data1><data2>asdfg</data2></model>
\ Não há quebra de linha no final do arquivo
diff -uNard HTTP-Body-0.6-ori/t/data/xforms/002-headers.yml HTTP-Body-0.6/t/data/xforms/002-headers.yml
--- HTTP-Body-0.6-ori/t/data/xforms/002-headers.yml 1970-01-01 01:00:00.000000000 +0100
+++ HTTP-Body-0.6/t/data/xforms/002-headers.yml 2006-10-12 15:57:37.000000000 +0100
@@ -0,0 +1,4 @@
+---
+Content-Length: 55
+Content-Type: application/xml
+User-Agent: 'Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en) AppleWebKit/312.1 (KHTML, like Gecko) Safari/312'
diff -uNard HTTP-Body-0.6-ori/t/data/xforms/002-results.yml HTTP-Body-0.6/t/data/xforms/002-results.yml
--- HTTP-Body-0.6-ori/t/data/xforms/002-results.yml 1970-01-01 01:00:00.000000000 +0100
+++ HTTP-Body-0.6/t/data/xforms/002-results.yml 2006-10-12 16:03:22.000000000 +0100
@@ -0,0 +1,5 @@
+---
+body: ~
+param:
+ XForms:Model: <model><data1>asdfg</data1><data2>asdfg</data2></model>
+upload: {}