Commit | Line | Data |
3fea05b9 |
1 | package URI::mailto; # RFC 2368 |
2 | |
3 | require URI; |
4 | require URI::_query; |
5 | @ISA=qw(URI URI::_query); |
6 | |
7 | use strict; |
8 | |
9 | sub 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 | |
40 | sub 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 | |
72 | 1; |