1package URI::data;  # RFC 2397
2
3require URI;
4@ISA=qw(URI);
5
6use strict;
7
8use MIME::Base64 qw(encode_base64 decode_base64);
9use URI::Escape  qw(uri_unescape);
10
11sub media_type
12{
13    my $self = shift;
14    my $opaque = $self->opaque;
15    $opaque =~ /^([^,]*),?/ or die;
16    my $old = $1;
17    my $base64;
18    $base64 = $1 if $old =~ s/(;base64)$//i;
19    if (@_) {
20	my $new = shift;
21	$new = "" unless defined $new;
22	$new =~ s/%/%25/g;
23	$new =~ s/,/%2C/g;
24	$base64 = "" unless defined $base64;
25	$opaque =~ s/^[^,]*,?/$new$base64,/;
26	$self->opaque($opaque);
27    }
28    return uri_unescape($old) if $old;  # media_type can't really be "0"
29    "text/plain;charset=US-ASCII";      # default type
30}
31
32sub data
33{
34    my $self = shift;
35    my($enc, $data) = split(",", $self->opaque, 2);
36    unless (defined $data) {
37	$data = "";
38	$enc  = "" unless defined $enc;
39    }
40    my $base64 = ($enc =~ /;base64$/i);
41    if (@_) {
42	$enc =~ s/;base64$//i if $base64;
43	my $new = shift;
44	$new = "" unless defined $new;
45	my $uric_count = _uric_count($new);
46	my $urienc_len = $uric_count + (length($new) - $uric_count) * 3;
47	my $base64_len = int((length($new)+2) / 3) * 4;
48	$base64_len += 7;  # because of ";base64" marker
49	if ($base64_len < $urienc_len || $_[0]) {
50	    $enc .= ";base64";
51	    $new = encode_base64($new, "");
52	} else {
53	    $new =~ s/%/%25/g;
54	}
55	$self->opaque("$enc,$new");
56    }
57    return unless defined wantarray;
58    return $base64 ? decode_base64($data) : uri_unescape($data);
59}
60
61# I could not find a better way to interpolate the tr/// chars from
62# a variable.
63my $ENC = $URI::uric;
64$ENC =~ s/%//;
65
66eval <<EOT; die $@ if $@;
67sub _uric_count
68{
69    \$_[0] =~ tr/$ENC//;
70}
71EOT
72
731;
74
75__END__
76
77=head1 NAME
78
79URI::data - URI that contains immediate data
80
81=head1 SYNOPSIS
82
83 use URI;
84
85 $u = URI->new("data:");
86 $u->media_type("image/gif");
87 $u->data(scalar(`cat camel.gif`));
88 print "$u\n";
89 open(XV, "|xv -") and print XV $u->data;
90
91=head1 DESCRIPTION
92
93The C<URI::data> class supports C<URI> objects belonging to the I<data>
94URI scheme.  The I<data> URI scheme is specified in RFC 2397.  It
95allows inclusion of small data items as "immediate" data, as if it had
96been included externally.  Examples:
97
98  data:,Perl%20is%20good
99
100  data:image/gif;base64,R0lGODdhIAAgAIAAAAAAAPj8+CwAAAAAI
101    AAgAAAClYyPqcu9AJyCjtIKc5w5xP14xgeO2tlY3nWcajmZZdeJcG
102    Kxrmimms1KMTa1Wg8UROx4MNUq1HrycMjHT9b6xKxaFLM6VRKzI+p
103    KS9XtXpcbdun6uWVxJXA8pNPkdkkxhxc21LZHFOgD2KMoQXa2KMWI
104    JtnE2KizVUkYJVZZ1nczBxXlFopZBtoJ2diXGdNUymmJdFMAADs=
105
106
107
108C<URI> objects belonging to the data scheme support the common methods
109(described in L<URI>) and the following two scheme-specific methods:
110
111=over 4
112
113=item $uri->media_type( [$new_media_type] )
114
115Can be used to get or set the media type specified in the
116URI.  If no media type is specified, then the default
117C<"text/plain;charset=US-ASCII"> is returned.
118
119=item $uri->data( [$new_data] )
120
121Can be used to get or set the data contained in the URI.
122The data is passed unescaped (in binary form).  The decision about
123whether to base64 encode the data in the URI is taken automatically,
124based on the encoding that produces the shorter URI string.
125
126=back
127
128=head1 SEE ALSO
129
130L<URI>
131
132=head1 COPYRIGHT
133
134Copyright 1995-1998 Gisle Aas.
135
136This library is free software; you can redistribute it and/or
137modify it under the same terms as Perl itself.
138
139=cut
140