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