X-Git-Url: http://git.maemo.org/git/?p=dh-make-perl;a=blobdiff_plain;f=dev%2Fi386%2Fliburi-perl%2Fliburi-perl-1.35.dfsg.1%2FURI%2Fmailto.pm;fp=dev%2Fi386%2Fliburi-perl%2Fliburi-perl-1.35.dfsg.1%2FURI%2Fmailto.pm;h=1408fc63a9309d6fd39ce74c78ba8e637f3d3af2;hp=0000000000000000000000000000000000000000;hb=8977e561d8a9eae6959218b0306c9df2056a38a9;hpb=df794b845212301ea0d267c919232538bfef356a

diff --git a/dev/i386/liburi-perl/liburi-perl-1.35.dfsg.1/URI/mailto.pm b/dev/i386/liburi-perl/liburi-perl-1.35.dfsg.1/URI/mailto.pm
new file mode 100644
index 0000000..1408fc6
--- /dev/null
+++ b/dev/i386/liburi-perl/liburi-perl-1.35.dfsg.1/URI/mailto.pm
@@ -0,0 +1,72 @@
+package URI::mailto;  # RFC 2368
+
+require URI;
+require URI::_query;
+@ISA=qw(URI URI::_query);
+
+use strict;
+
+sub to
+{
+    my $self = shift;
+    my @old = $self->headers;
+    if (@_) {
+	my @new = @old;
+	# get rid of any other to: fields
+	for (my $i = 0; $i < @new; $i += 2) {
+	    if (lc($new[$i]) eq "to") {
+		splice(@new, $i, 2);
+		redo;
+	    }
+	}
+
+	my $to = shift;
+	$to = "" unless defined $to;
+	unshift(@new, "to" => $to);
+	$self->headers(@new);
+    }
+    return unless defined wantarray;
+
+    my @to;
+    while (@old) {
+	my $h = shift @old;
+	my $v = shift @old;
+	push(@to, $v) if lc($h) eq "to";
+    }
+    join(",", @to);
+}
+
+
+sub headers
+{
+    my $self = shift;
+
+    # The trick is to just treat everything as the query string...
+    my $opaque = "to=" . $self->opaque;
+    $opaque =~ s/\?/&/;
+
+    if (@_) {
+	my @new = @_;
+
+	# strip out any "to" fields
+	my @to;
+	for (my $i=0; $i < @new; $i += 2) {
+	    if (lc($new[$i]) eq "to") {
+		push(@to, (splice(@new, $i, 2))[1]);  # remove header
+		redo;
+	    }
+	}
+
+	my $new = join(",",@to);
+	$new =~ s/%/%25/g;
+	$new =~ s/\?/%3F/g;
+	$self->opaque($new);
+	$self->query_form(@new) if @new;
+    }
+    return unless defined wantarray;
+
+    # I am lazy today...
+    URI->new("mailto:?$opaque")->query_form;
+}
+
+1;