SuikaWiki/Input/HTTP.pm


=head1 NAME

SuikaWiki::Input::HTTP --- SuikaWiki: HTTP or HTTP CGI input support

=head1 DESCRIPTION

This module provides HTTP or HTTP CGI input support,
although current version of this module supports HTTP CGI only.

This module is part of SuikaWiki.

=cut

package SuikaWiki::Input::HTTP;
use strict;
our $VERSION = do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};

=head1 METHODS

=over 4

=item $http = SuikaWiki::Input::HTTP->new

Constructs new instance of HTTP input implementation

=cut

sub new ($;%) {
  my $self = bless {
                    decoder => {
                                '#default' => sub {$_[1]},
                               },
                    option => {
                               param_input_encoding => 'ie',
                              },
                   }, shift;
  my %opt = @_;
  $self->{wiki} = $opt{wiki};
  $self;
}

=item $value = $http->meta_variable ($name)

Returns variable value.  $name should be a meta-variable name
defined by CGI specification, eg. CONTENT_TYPE, HTTP_USER_AGENT and so on.

=cut

sub meta_variable ($$) {
  $main::ENV{ $_[1] };
}

=item $value = $http->parameter ($name)

Returns parameter value if any.
Parameter value is set by query-string of Request-URI
and/or entity-body value.

When multiple values with same parameter name is specified,
the first one is returned in scalar context or
an array reference of all values is returned in array context.
(Note that query-string is "earlier" than entity-body.)

=cut

sub parameter ($$) {
  my ($self, $name) = @_;
  $self->{param} ||= $self->__get_parameter;
  wantarray ? ( $self->{param}->{$name}||[] ) :
              ${$self->{param}->{$name}||[]}[0];
}

sub __get_parameter ($) {
  my $self = shift;
  my @src;
  
  ## Query-string of Request-URI
  my $qs = $self->meta_variable ('QUERY_STRING');
  push @src, $qs if (index ($qs, '=') > -1)
                 || (index ($qs, ';') > -1)
                 || (index ($qs, '&') > -1);
  
  ## Entity-body
  if ($self->meta_variable ('REQUEST_METHOD') eq 'POST') {
    my $mt = $self->meta_variable ('CONTENT_TYPE');
    if ($mt =~ m<^application/(?:x-www|sgml)-form-urlencoded\b>) {
      push @src, $self->body_text;
    }
  }
  
  for my $src (@src) {
    for (split /[;&]/, $src) {
      my ($name, $val) = split '=', $_, 2;
      $name = &{$self->{decoder}->{'#name'}
              ||$self->{decoder}->{'#default'}} ($self, $name);
      $self->{param}->{$name} ||= [];
      push @{$self->{param}->{$name}}, 
           &{$self->{decoder}->{$name}
           ||$self->{decoder}->{'#default'}} ($self, $val);
    }
  }
}

=item $body = $http->body

Returns entity-body content if any.

It is expected that in future version of this module,
this method returns an object instantiated with body content
rather than body text itself.

=item $body = $http->body_text

Returnes entity-body context as a string.

=cut

sub body ($) {
  my $self = shift;
  $self->__get_entity_body unless defined $self->{body};
  $self->{body};
}

sub body_text ($) {
  $_[0]->body;
}
         
sub __get_entity_body ($) {
  my $self = shift;
  binmode STDIN;
  read STDIN, $self->{body}, $main::ENV{CONTENT_LENGTH};
}

sub request_uri ($) {
## TOTO: implement
}

=head1 TODO

=over 4

=item Use manakai

=item multipart/form-data support

=item HTTP (non-CGI) support

=cut

=head1 LICENSE

Copyright 2003 Wakaba <w@suika.fam.cx>

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1; # $Date: 2003/10/05 11:55:29 $
1
2	=head1 NAME
3
4	SuikaWiki::Input::HTTP --- SuikaWiki: HTTP or HTTP CGI input support
5
6	=head1 DESCRIPTION
7
8	This module provides HTTP or HTTP CGI input support,
9	although current version of this module supports HTTP CGI only.
10
11	This module is part of SuikaWiki.
12
13	=cut
14
15	package SuikaWiki::Input::HTTP;
16	use strict;
17	our $VERSION = do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
18
19	=head1 METHODS
20
21	=over 4
22
23	=item $http = SuikaWiki::Input::HTTP->new
24
25	Constructs new instance of HTTP input implementation
26
27	=cut
28
29	sub new ($;%) {
30	my $self = bless {
31	decoder => {
32	'#default' => sub {$_[1]},
33	},
34	option => {
35	param_input_encoding => 'ie',
36	},
37	}, shift;
38	my %opt = @_;
39	$self->{wiki} = $opt{wiki};
40	$self;
41	}
42
43	=item $value = $http->meta_variable ($name)
44
45	Returns variable value. $name should be a meta-variable name
46	defined by CGI specification, eg. CONTENT_TYPE, HTTP_USER_AGENT and so on.
47
48	=cut
49
50	sub meta_variable ($$) {
51	$main::ENV{ $_[1] };
52	}
53
54	=item $value = $http->parameter ($name)
55
56	Returns parameter value if any.
57	Parameter value is set by query-string of Request-URI
58	and/or entity-body value.
59
60	When multiple values with same parameter name is specified,
61	the first one is returned in scalar context or
62	an array reference of all values is returned in array context.
63	(Note that query-string is "earlier" than entity-body.)
64
65	=cut
66
67	sub parameter ($$) {
68	my ($self, $name) = @_;
69	$self->{param} \|\|= $self->__get_parameter;
70	wantarray ? ( $self->{param}->{$name}\|\|[] ) :
71	${$self->{param}->{$name}\|\|[]}[0];
72	}
73
74	sub __get_parameter ($) {
75	my $self = shift;
76	my @src;
77
78	## Query-string of Request-URI
79	my $qs = $self->meta_variable ('QUERY_STRING');
80	push @src, $qs if (index ($qs, '=') > -1)
81	\|\| (index ($qs, ';') > -1)
82	\|\| (index ($qs, '&') > -1);
83
84	## Entity-body
85	if ($self->meta_variable ('REQUEST_METHOD') eq 'POST') {
86	my $mt = $self->meta_variable ('CONTENT_TYPE');
87	if ($mt =~ m<^application/(?:x-www\|sgml)-form-urlencoded\b>) {
88	push @src, $self->body_text;
89	}
90	}
91
92	for my $src (@src) {
93	for (split /[;&]/, $src) {
94	my ($name, $val) = split '=', $_, 2;
95	$name = &{$self->{decoder}->{'#name'}
96	\|\|$self->{decoder}->{'#default'}} ($self, $name);
97	$self->{param}->{$name} \|\|= [];
98	push @{$self->{param}->{$name}},
99	&{$self->{decoder}->{$name}
100	\|\|$self->{decoder}->{'#default'}} ($self, $val);
101	}
102	}
103	}
104
105	=item $body = $http->body
106
107	Returns entity-body content if any.
108
109	It is expected that in future version of this module,
110	this method returns an object instantiated with body content
111	rather than body text itself.
112
113	=item $body = $http->body_text
114
115	Returnes entity-body context as a string.
116
117	=cut
118
119	sub body ($) {
120	my $self = shift;
121	$self->__get_entity_body unless defined $self->{body};
122	$self->{body};
123	}
124
125	sub body_text ($) {
126	$_[0]->body;
127	}
128
129	sub __get_entity_body ($) {
130	my $self = shift;
131	binmode STDIN;
132	read STDIN, $self->{body}, $main::ENV{CONTENT_LENGTH};
133	}
134
135	sub request_uri ($) {
136	## TOTO: implement
137	}
138
139	=head1 TODO
140
141	=over 4
142
143	=item Use manakai
144
145	=item multipart/form-data support
146
147	=item HTTP (non-CGI) support
148
149	=cut
150
151	=head1 LICENSE
152
153	Copyright 2003 Wakaba <w@suika.fam.cx>
154
155	This program is free software; you can redistribute it and/or
156	modify it under the same terms as Perl itself.
157
158	=cut
159
160	1; # $Date: 2003/10/05 11:55:29 $