source: main/trunk/greenstone2/perllib/cpan/URI/mailto.pm@ 31689

Last change on this file since 31689 was 27174, checked in by davidb, 11 years ago

Perl modules from CPAN that are used in supporting activate.pl, but not part of the Perl core. Only PMs included.

File size: 1.2 KB
Line 
1package URI::mailto; # RFC 2368
2
3require URI;
4require URI::_query;
5@ISA=qw(URI URI::_query);
6
7use strict;
8
9sub to
10{
11 my $self = shift;
12 my @old = $self->headers;
13 if (@_) {
14 my @new = @old;
15 # get rid of any other to: fields
16 for (my $i = 0; $i < @new; $i += 2) {
17 if (lc($new[$i] || '') eq "to") {
18 splice(@new, $i, 2);
19 redo;
20 }
21 }
22
23 my $to = shift;
24 $to = "" unless defined $to;
25 unshift(@new, "to" => $to);
26 $self->headers(@new);
27 }
28 return unless defined wantarray;
29
30 my @to;
31 while (@old) {
32 my $h = shift @old;
33 my $v = shift @old;
34 push(@to, $v) if lc($h) eq "to";
35 }
36 join(",", @to);
37}
38
39
40sub headers
41{
42 my $self = shift;
43
44 # The trick is to just treat everything as the query string...
45 my $opaque = "to=" . $self->opaque;
46 $opaque =~ s/\?/&/;
47
48 if (@_) {
49 my @new = @_;
50
51 # strip out any "to" fields
52 my @to;
53 for (my $i=0; $i < @new; $i += 2) {
54 if (lc($new[$i] || '') eq "to") {
55 push(@to, (splice(@new, $i, 2))[1]); # remove header
56 redo;
57 }
58 }
59
60 my $new = join(",",@to);
61 $new =~ s/%/%25/g;
62 $new =~ s/\?/%3F/g;
63 $self->opaque($new);
64 $self->query_form(@new) if @new;
65 }
66 return unless defined wantarray;
67
68 # I am lazy today...
69 URI->new("mailto:?$opaque")->query_form;
70}
71
721;
Note: See TracBrowser for help on using the repository browser.