Commit | Line | Data |
5940e4c7 |
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'; |
2759ad98 |
77 | if ($part->{done}) { |
78 | $self->body($part->{data}); |
79 | } |
5940e4c7 |
80 | } |
81 | elsif ( defined $contentid ) { |
82 | $part->{name} = $contentid; |
83 | $part->{filename} = $contentid; |
84 | } |
85 | |
86 | return $self->SUPER::handler($part); |
87 | } |
88 | |
89 | =back |
90 | |
91 | =head1 AUTHOR |
92 | |
93 | Daniel Ruoso C<daniel@ruoso.com> |
94 | |
95 | =head1 LICENSE |
96 | |
97 | This library is free software . You can redistribute it and/or modify |
98 | it under the same terms as perl itself. |
99 | |
100 | =cut |
101 | |
102 | 1; |