[Catalyst-commits] r7452 - in trunk/HTTP-Body: . lib/HTTP
lib/HTTP/Body t t/data t/data/xforms
andyg at dev.catalyst.perl.org
andyg at dev.catalyst.perl.org
Sat Feb 23 15:57:08 GMT 2008
Author: andyg
Date: 2008-02-23 15:57:07 +0000 (Sat, 23 Feb 2008)
New Revision: 7452
Added:
trunk/HTTP-Body/lib/HTTP/Body/XForms.pm
trunk/HTTP-Body/lib/HTTP/Body/XFormsMultipart.pm
trunk/HTTP-Body/t/07xforms.t
trunk/HTTP-Body/t/data/xforms/
trunk/HTTP-Body/t/data/xforms/001-content.dat
trunk/HTTP-Body/t/data/xforms/001-headers.yml
trunk/HTTP-Body/t/data/xforms/001-results.yml
trunk/HTTP-Body/t/data/xforms/002-content.dat
trunk/HTTP-Body/t/data/xforms/002-headers.yml
trunk/HTTP-Body/t/data/xforms/002-results.yml
Modified:
trunk/HTTP-Body/Changes
trunk/HTTP-Body/lib/HTTP/Body.pm
trunk/HTTP-Body/lib/HTTP/Body/MultiPart.pm
Log:
HTTP::Body, patch from Daniel Ruoso to add XForms support
Modified: trunk/HTTP-Body/Changes
===================================================================
--- trunk/HTTP-Body/Changes 2008-02-23 15:19:50 UTC (rev 7451)
+++ trunk/HTTP-Body/Changes 2008-02-23 15:57:07 UTC (rev 7452)
@@ -2,6 +2,7 @@
1.00
- Added support for chunked requests if no $length value is passed to new().
+ - Added support for XForms submissions. (Daniel Ruoso)
- Fixed urlencoded parser to handle spaces after semicolons and equal signs
in the value. (Tom Heady, http://rt.cpan.org/Ticket/Display.html?id=31055)
- Fixed multipart test to properly clean up temporary files.
Modified: trunk/HTTP-Body/lib/HTTP/Body/MultiPart.pm
===================================================================
--- trunk/HTTP-Body/lib/HTTP/Body/MultiPart.pm 2008-02-23 15:19:50 UTC (rev 7451)
+++ trunk/HTTP-Body/lib/HTTP/Body/MultiPart.pm 2008-02-23 15:57:07 UTC (rev 7452)
@@ -286,7 +286,7 @@
if ( exists $part->{filename} ) {
if ( $part->{filename} ne "" ) {
- $part->{fh}->close;
+ $part->{fh}->close if defined $part->{fh};
delete @{$part}{qw[ data done fh ]};
Added: trunk/HTTP-Body/lib/HTTP/Body/XForms.pm
===================================================================
--- trunk/HTTP-Body/lib/HTTP/Body/XForms.pm (rev 0)
+++ trunk/HTTP-Body/lib/HTTP/Body/XForms.pm 2008-02-23 15:57:07 UTC (rev 7452)
@@ -0,0 +1,59 @@
+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 at 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;
Property changes on: trunk/HTTP-Body/lib/HTTP/Body/XForms.pm
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/HTTP-Body/lib/HTTP/Body/XFormsMultipart.pm
===================================================================
--- trunk/HTTP-Body/lib/HTTP/Body/XFormsMultipart.pm (rev 0)
+++ trunk/HTTP-Body/lib/HTTP/Body/XFormsMultipart.pm 2008-02-23 15:57:07 UTC (rev 7452)
@@ -0,0 +1,99 @@
+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 at 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;
Property changes on: trunk/HTTP-Body/lib/HTTP/Body/XFormsMultipart.pm
___________________________________________________________________
Name: svn:keywords
+ Id
Modified: trunk/HTTP-Body/lib/HTTP/Body.pm
===================================================================
--- trunk/HTTP-Body/lib/HTTP/Body.pm 2008-02-23 15:19:50 UTC (rev 7451)
+++ trunk/HTTP-Body/lib/HTTP/Body.pm 2008-02-23 15:57:07 UTC (rev 7452)
@@ -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;
use HTTP::Headers;
use HTTP::Message;
Added: trunk/HTTP-Body/t/07xforms.t
===================================================================
--- trunk/HTTP-Body/t/07xforms.t (rev 0)
+++ trunk/HTTP-Body/t/07xforms.t 2008-02-23 15:57:07 UTC (rev 7452)
@@ -0,0 +1,56 @@
+#!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);
+ }
+
+ # Save tempnames for later deletion
+ my @temps;
+
+ for my $field ( keys %{ $body->upload } ) {
+
+ my $value = $body->upload->{$field};
+
+ for ( ( ref($value) eq 'ARRAY' ) ? @{$value} : $value ) {
+ push @temps, 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" );
+
+ # Clean up temp files created
+ unlink map { $_ } grep { defined $_ && -e $_ } @temps;
+}
Property changes on: trunk/HTTP-Body/t/07xforms.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/HTTP-Body/t/data/xforms/001-content.dat
===================================================================
--- trunk/HTTP-Body/t/data/xforms/001-content.dat (rev 0)
+++ trunk/HTTP-Body/t/data/xforms/001-content.dat 2008-02-23 15:57:07 UTC (rev 7452)
@@ -0,0 +1,13 @@
+------------0xKhTmLbOuNdArY
+Content-ID: <asdfg at asdfg.com>
+
+<model><data1>asdfg</data1><data2>asdfg</data2></model>
+------------0xKhTmLbOuNdArY
+Content-ID: <qwert at qwerty.com>
+
+Attachment file 1
+------------0xKhTmLbOuNdArY
+Content-ID: <zxcvb at zxcvb.com>
+
+Attachment file 2
+------------0xKhTmLbOuNdArY--
Property changes on: trunk/HTTP-Body/t/data/xforms/001-content.dat
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/HTTP-Body/t/data/xforms/001-headers.yml
===================================================================
--- trunk/HTTP-Body/t/data/xforms/001-headers.yml (rev 0)
+++ trunk/HTTP-Body/t/data/xforms/001-headers.yml 2008-02-23 15:57:07 UTC (rev 7452)
@@ -0,0 +1,4 @@
+---
+Content-Length: 313
+Content-Type: multipart/related; boundary=----------0xKhTmLbOuNdArY; start=<asdfg at asdfg.com>
+User-Agent: 'Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en) AppleWebKit/312.1 (KHTML, like Gecko) Safari/312'
Property changes on: trunk/HTTP-Body/t/data/xforms/001-headers.yml
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/HTTP-Body/t/data/xforms/001-results.yml
===================================================================
--- trunk/HTTP-Body/t/data/xforms/001-results.yml (rev 0)
+++ trunk/HTTP-Body/t/data/xforms/001-results.yml 2008-02-23 15:57:07 UTC (rev 7452)
@@ -0,0 +1,18 @@
+---
+body: ~
+start: asdfg at asdfg.com
+param:
+ XForms:Model: <model><data1>asdfg</data1><data2>asdfg</data2></model>
+upload:
+ qwert at qwerty.com:
+ filename: qwert at qwerty.com
+ headers:
+ Content-ID: <qwert at qwerty.com>
+ name: qwert at qwerty.com
+ size: 17
+ zxcvb at zxcvb.com:
+ filename: zxcvb at zxcvb.com
+ headers:
+ Content-ID: <zxcvb at zxcvb.com>
+ name: zxcvb at zxcvb.com
+ size: 17
Property changes on: trunk/HTTP-Body/t/data/xforms/001-results.yml
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/HTTP-Body/t/data/xforms/002-content.dat
===================================================================
--- trunk/HTTP-Body/t/data/xforms/002-content.dat (rev 0)
+++ trunk/HTTP-Body/t/data/xforms/002-content.dat 2008-02-23 15:57:07 UTC (rev 7452)
@@ -0,0 +1 @@
+<model><data1>asdfg</data1><data2>asdfg</data2></model>
\ No newline at end of file
Property changes on: trunk/HTTP-Body/t/data/xforms/002-content.dat
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/HTTP-Body/t/data/xforms/002-headers.yml
===================================================================
--- trunk/HTTP-Body/t/data/xforms/002-headers.yml (rev 0)
+++ trunk/HTTP-Body/t/data/xforms/002-headers.yml 2008-02-23 15:57:07 UTC (rev 7452)
@@ -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'
Property changes on: trunk/HTTP-Body/t/data/xforms/002-headers.yml
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/HTTP-Body/t/data/xforms/002-results.yml
===================================================================
--- trunk/HTTP-Body/t/data/xforms/002-results.yml (rev 0)
+++ trunk/HTTP-Body/t/data/xforms/002-results.yml 2008-02-23 15:57:07 UTC (rev 7452)
@@ -0,0 +1,5 @@
+---
+body: ~
+param:
+ XForms:Model: <model><data1>asdfg</data1><data2>asdfg</data2></model>
+upload: {}
Property changes on: trunk/HTTP-Body/t/data/xforms/002-results.yml
___________________________________________________________________
Name: svn:keywords
+ Id
More information about the Catalyst-commits
mailing list