home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / URI / URL / data.pm < prev    next >
Encoding:
Perl POD Document  |  1997-01-27  |  3.5 KB  |  161 lines  |  [TEXT/McPL]
  1. package URI::URL::data;
  2.  
  3. # Implements data:-URLs as specified in draft-masinter-url-data-02.txt
  4. #
  5. # Abstract
  6. #
  7. # A new URL scheme, "data", is defined. It allows inclusion of small
  8. # data items as "immediate" data, as if it had been included externally.
  9. #
  10. # Description
  11. #
  12. # Some applications that use URLs also have a need to embed (small)
  13. # media type data directly inline. This document defines a new URL
  14. # scheme that would work like 'immediate addressing'. The URLs are of
  15. # the form:
  16. #
  17. #        data:[<mediatype>][;base64],<data>
  18. #
  19.  
  20. require URI::URL;
  21. @ISA = qw(URI::URL);
  22.  
  23. use URI::Escape;
  24. use MIME::Base64 ();
  25.  
  26. # as defined in rfc1522.txt
  27. my $tspecial  = qq(()<>@,;:/[]?.=);
  28. my $tokenchar = qq([^\\s\000-\037\177-\377\Q$tspecial\E]);
  29.  
  30.  
  31. sub new {
  32.     my($class, $init, $base) = @_;
  33.  
  34.     my $self = bless { }, $class;
  35.  
  36.     $self->{'scheme'} = lc($1) if $init =~ s/^\s*([\w\+\.\-]+)://;
  37.     $self->{'frag'} = $1 if $init =~ s/\#(.*)$//;
  38.  
  39.     my $type = "";
  40.     if ($init =~ s/^($tokenchar+\/$tokenchar+)//o) {
  41.     $type = $1;
  42.     }
  43.     while ($init =~ s/^;($tokenchar+)=([^,;]*)//o) {
  44.     # XXX should we unescape the parst
  45.     $type .= ";$1=$2";
  46.     }
  47.  
  48.     $self->{'media_type'} = $type;
  49.  
  50.     my $base64;
  51.     if ($init =~ s/^;base64//i) {
  52.     $base64 = 1;
  53.     }
  54.     
  55.     $init =~ s/^,//;
  56.     if ($base64) {
  57.     $self->{'base64'} = uri_unescape($init);
  58.     } else {
  59.     $self->{'data'} = uri_unescape($init);
  60.     }
  61.     $self->base($base) if $base;
  62.     $self;
  63. }
  64.  
  65. sub media_type
  66. {
  67.     my $self = shift;
  68.     my $old = $self->{'media_type'};
  69.     if (@_) {
  70.     $self->{'media_type'} = shift || "";
  71.     delete $self->{'_str'};
  72.     }
  73.     my($type, $param) = split(/;/, $old, 2);
  74.     if ($type) {
  75.     $type = lc $type;
  76.     } else {
  77.     $type = "text/plain";
  78.     $param = "charset=US-ASCII" unless $param;
  79.     }
  80.     if (wantarray) {
  81.     return ($type, $param);
  82.     } else {
  83.     return $type;
  84.     }
  85. }
  86.  
  87. sub data
  88. {
  89.     my $self = shift;
  90.     my $old_data;
  91.     my $old_base64;
  92.     $old_data = $self->{'data'};
  93.     $old_base64 = $self->{'base64'};
  94.     if (@_) {
  95.     if ($_[1]) { # base64 flag
  96.         $self->{'base64'} = $_[0];
  97.         delete $self->{'data'};
  98.     } else {
  99.         $self->{'data'} = $_[0];
  100.         delete $self->{'base64'};
  101.     }
  102.     delete $self->{'_str'};
  103.     }
  104.     unless (defined $old_data) {
  105.     $old_data = MIME::Base64::decode($old_base64);
  106.     $self->{'data'} = $old_data unless @_;
  107.     }
  108.     $old_data;
  109. }
  110.  
  111.  
  112. sub crack
  113. {
  114.     my $self = shift;
  115.     ($self->{'scheme'}
  116.      || 'data',          # scheme
  117.      undef,              # user
  118.      undef,              # passwd
  119.      undef,              # host
  120.      undef,              # port
  121.      $self->data,        # path
  122.      $self->{'media_type'},  # params
  123.      undef,              # query
  124.      $self->{'frag'}     # fragment
  125.     )
  126. }
  127.  
  128. sub as_string {
  129.     my $self = shift;
  130.     return $self->{'_str'} if $self->{'_str'};
  131.     my $str = ($self->{'scheme'} || 'data') . ":";
  132.     $str .= $self->{'media_type'};
  133.     if (defined $self->{'base64'}) {
  134.     $str .= ";base64,$self->{'base64'}";
  135.     } else {
  136.     my $urlenc = uri_escape($self->{'data'});
  137.     my $base64 = MIME::Base64::encode($self->{'data'});
  138.     if (length($base64) + 7 < length($urlenc)) {
  139.         $str .= ";base64,$base64";
  140.         $self->{'base64'} = $base64;
  141.     } else {
  142.         $str .= ",$urlenc";
  143.     }
  144.     }
  145.     $self->{'_str'} = $str;
  146. }
  147.  
  148. sub eq {
  149.     my($self, $other) = @_;
  150.     return 0 if ref($self) ne ref($other);
  151.     return 0 if $self->scheme ne $other->scheme;
  152.  
  153.     my $mt1 = join(";", $self->media_type);
  154.     my $mt2 = join(";", $other->media_type);
  155.     return 0 if $mt1 ne $mt2;
  156.  
  157.     $self->data eq $other->data;
  158. }
  159.  
  160. 1;
  161.