Filename | /usr/local/share/perl/5.18.2/HTTP/Body/XFormsMultipart.pm |
Statements | Executed 14 statements in 328µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 12µs | 79µs | BEGIN@11 | HTTP::Body::XFormsMultipart::
1 | 1 | 1 | 9µs | 21µs | BEGIN@6 | HTTP::Body::XFormsMultipart::
1 | 1 | 1 | 8µs | 66µs | BEGIN@7 | HTTP::Body::XFormsMultipart::
1 | 1 | 1 | 8µs | 9µs | BEGIN@8 | HTTP::Body::XFormsMultipart::
1 | 1 | 1 | 7µs | 117µs | BEGIN@10 | HTTP::Body::XFormsMultipart::
0 | 0 | 0 | 0s | 0s | handler | HTTP::Body::XFormsMultipart::
0 | 0 | 0 | 0s | 0s | init | HTTP::Body::XFormsMultipart::
0 | 0 | 0 | 0s | 0s | start | HTTP::Body::XFormsMultipart::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package HTTP::Body::XFormsMultipart; | ||||
2 | { | ||||
3 | 2 | 800ns | $HTTP::Body::XFormsMultipart::VERSION = '1.19'; | ||
4 | } | ||||
5 | |||||
6 | 2 | 24µs | 2 | 33µs | # spent 21µs (9+12) within HTTP::Body::XFormsMultipart::BEGIN@6 which was called:
# once (9µs+12µs) by Plack::Request::BEGIN@10 at line 6 # spent 21µs making 1 call to HTTP::Body::XFormsMultipart::BEGIN@6
# spent 12µs making 1 call to strict::import |
7 | 2 | 24µs | 2 | 124µs | # spent 66µs (8+58) within HTTP::Body::XFormsMultipart::BEGIN@7 which was called:
# once (8µs+58µs) by Plack::Request::BEGIN@10 at line 7 # spent 66µs making 1 call to HTTP::Body::XFormsMultipart::BEGIN@7
# spent 58µs making 1 call to base::import |
8 | 2 | 18µs | 2 | 10µs | # spent 9µs (8+1) within HTTP::Body::XFormsMultipart::BEGIN@8 which was called:
# once (8µs+1µs) by Plack::Request::BEGIN@10 at line 8 # spent 9µs making 1 call to HTTP::Body::XFormsMultipart::BEGIN@8
# spent 1µs making 1 call to bytes::import |
9 | |||||
10 | 2 | 25µs | 2 | 226µs | # spent 117µs (7+110) within HTTP::Body::XFormsMultipart::BEGIN@10 which was called:
# once (7µs+110µs) by Plack::Request::BEGIN@10 at line 10 # spent 117µs making 1 call to HTTP::Body::XFormsMultipart::BEGIN@10
# spent 110µs making 1 call to Exporter::import |
11 | 3 | 235µs | 3 | 146µs | # spent 79µs (12+67) within HTTP::Body::XFormsMultipart::BEGIN@11 which was called:
# once (12µs+67µs) by Plack::Request::BEGIN@10 at line 11 # spent 79µs making 1 call to HTTP::Body::XFormsMultipart::BEGIN@11
# spent 57µs making 1 call to Exporter::import
# spent 10µs making 1 call to UNIVERSAL::VERSION |
12 | |||||
13 | =head1 NAME | ||||
14 | |||||
15 | HTTP::Body::XFormsMultipart - HTTP Body XForms multipart/related submission Parser | ||||
16 | |||||
17 | =head1 SYNOPSIS | ||||
18 | |||||
19 | use HTTP::Body::XForms; | ||||
20 | |||||
21 | =head1 DESCRIPTION | ||||
22 | |||||
23 | HTTP Body XForms submission Parser. Inherits HTTP::Body::MultiPart. | ||||
24 | |||||
25 | This body type is used to parse XForms submission. In this case, the | ||||
26 | XML part that contains the model is indicated by the start attribute | ||||
27 | in the content-type. The XML content is stored unparsed on the | ||||
28 | parameter XForms:Model. | ||||
29 | |||||
30 | =head1 METHODS | ||||
31 | |||||
32 | =over 4 | ||||
33 | |||||
34 | =item init | ||||
35 | |||||
36 | This function is overridden to detect the start part of the | ||||
37 | multipart/related post. | ||||
38 | |||||
39 | =cut | ||||
40 | |||||
41 | sub init { | ||||
42 | my $self = shift; | ||||
43 | $self->SUPER::init(@_); | ||||
44 | unless ( $self->content_type =~ /start=\"?\<?([^\"\>;,]+)\>?\"?/ ) { | ||||
45 | my $content_type = $self->content_type; | ||||
46 | Carp::croak( "Invalid boundary in content_type: '$content_type'" ); | ||||
47 | } | ||||
48 | |||||
49 | $self->{start} = $1; | ||||
50 | |||||
51 | return $self; | ||||
52 | } | ||||
53 | |||||
54 | =item start | ||||
55 | |||||
56 | Defines the start part of the multipart/related body. | ||||
57 | |||||
58 | =cut | ||||
59 | |||||
60 | sub start { | ||||
61 | return shift->{start}; | ||||
62 | } | ||||
63 | |||||
64 | =item handler | ||||
65 | |||||
66 | This function is overridden to differ the start part, which should be | ||||
67 | set as the XForms:Model param if its content type is application/xml. | ||||
68 | |||||
69 | =cut | ||||
70 | |||||
71 | sub handler { | ||||
72 | my ( $self, $part ) = @_; | ||||
73 | |||||
74 | my $contentid = $part->{headers}{'Content-ID'}; | ||||
75 | $contentid =~ s/^.*[\<\"]//; | ||||
76 | $contentid =~ s/[\>\"].*$//; | ||||
77 | |||||
78 | if ( $contentid eq $self->start ) { | ||||
79 | $part->{name} = 'XForms:Model'; | ||||
80 | if ($part->{done}) { | ||||
81 | $self->body($part->{data}); | ||||
82 | } | ||||
83 | } | ||||
84 | elsif ( defined $contentid ) { | ||||
85 | $part->{name} = $contentid; | ||||
86 | $part->{filename} = $contentid; | ||||
87 | } | ||||
88 | |||||
89 | return $self->SUPER::handler($part); | ||||
90 | } | ||||
91 | |||||
92 | =back | ||||
93 | |||||
94 | =head1 AUTHOR | ||||
95 | |||||
96 | Daniel Ruoso C<daniel@ruoso.com> | ||||
97 | |||||
98 | =head1 LICENSE | ||||
99 | |||||
100 | This library is free software . You can redistribute it and/or modify | ||||
101 | it under the same terms as perl itself. | ||||
102 | |||||
103 | =cut | ||||
104 | |||||
105 | 1 | 2µs | 1; |