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; 73