home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / URI / URL / data.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  3.0 KB  |  143 lines
  1. package URI::URL::data;
  2.  
  3.  
  4. require URI::URL;
  5. @ISA = qw(URI::URL);
  6.  
  7. use URI::Escape;
  8. use MIME::Base64 ();
  9.  
  10. my $tspecial  = qq(()<>@,;:/[]?.=);
  11. my $tokenchar = qq([^\\s\000-\037\177-\377\Q$tspecial\E]);
  12.  
  13.  
  14. sub new {
  15.     my($class, $init, $base) = @_;
  16.  
  17.     my $self = bless { }, $class;
  18.  
  19.     $self->{'scheme'} = lc($1) if $init =~ s/^\s*([\w\+\.\-]+)://;
  20.     $self->{'frag'} = $1 if $init =~ s/\#(.*)$//;
  21.  
  22.     my $type = "";
  23.     if ($init =~ s/^($tokenchar+\/$tokenchar+)//o) {
  24.     $type = $1;
  25.     }
  26.     while ($init =~ s/^;($tokenchar+)=([^,;]*)//o) {
  27.     $type .= ";$1=$2";
  28.     }
  29.  
  30.     $self->{'media_type'} = $type;
  31.  
  32.     my $base64;
  33.     if ($init =~ s/^;base64//i) {
  34.     $base64 = 1;
  35.     }
  36.     
  37.     $init =~ s/^,//;
  38.     if ($base64) {
  39.     $self->{'base64'} = uri_unescape($init);
  40.     } else {
  41.     $self->{'data'} = uri_unescape($init);
  42.     }
  43.     $self->base($base) if $base;
  44.     $self;
  45. }
  46.  
  47. sub media_type
  48. {
  49.     my $self = shift;
  50.     my $old = $self->{'media_type'};
  51.     if (@_) {
  52.     $self->{'media_type'} = shift || "";
  53.     delete $self->{'_str'};
  54.     }
  55.     my($type, $param) = split(/;/, $old, 2);
  56.     if ($type) {
  57.     $type = lc $type;
  58.     } else {
  59.     $type = "text/plain";
  60.     $param = "charset=US-ASCII" unless $param;
  61.     }
  62.     if (wantarray) {
  63.     return ($type, $param);
  64.     } else {
  65.     return $type;
  66.     }
  67. }
  68.  
  69. sub data
  70. {
  71.     my $self = shift;
  72.     my $old_data;
  73.     my $old_base64;
  74.     $old_data = $self->{'data'};
  75.     $old_base64 = $self->{'base64'};
  76.     if (@_) {
  77.     if ($_[1]) { # base64 flag
  78.         $self->{'base64'} = $_[0];
  79.         delete $self->{'data'};
  80.     } else {
  81.         $self->{'data'} = $_[0];
  82.         delete $self->{'base64'};
  83.     }
  84.     delete $self->{'_str'};
  85.     }
  86.     unless (defined $old_data) {
  87.     $old_data = MIME::Base64::decode($old_base64);
  88.     $self->{'data'} = $old_data unless @_;
  89.     }
  90.     $old_data;
  91. }
  92.  
  93.  
  94. sub crack
  95. {
  96.     my $self = shift;
  97.     ($self->{'scheme'}
  98.      || 'data',          # scheme
  99.      undef,              # user
  100.      undef,              # passwd
  101.      undef,              # host
  102.      undef,              # port
  103.      $self->data,        # path
  104.      $self->{'media_type'},  # params
  105.      undef,              # query
  106.      $self->{'frag'}     # fragment
  107.     )
  108. }
  109.  
  110. sub as_string {
  111.     my $self = shift;
  112.     return $self->{'_str'} if $self->{'_str'};
  113.     my $str = ($self->{'scheme'} || 'data') . ":";
  114.     $str .= $self->{'media_type'};
  115.     if (defined $self->{'base64'}) {
  116.     $str .= ";base64,$self->{'base64'}";
  117.     } else {
  118.     my $urlenc = uri_escape($self->{'data'});
  119.     my $base64 = MIME::Base64::encode($self->{'data'});
  120.     if (length($base64) + 7 < length($urlenc)) {
  121.         $str .= ";base64,$base64";
  122.         $self->{'base64'} = $base64;
  123.     } else {
  124.         $str .= ",$urlenc";
  125.     }
  126.     }
  127.     $self->{'_str'} = $str;
  128. }
  129.  
  130. sub eq {
  131.     my($self, $other) = @_;
  132.     return 0 if ref($self) ne ref($other);
  133.     return 0 if $self->scheme ne $other->scheme;
  134.  
  135.     my $mt1 = join(";", $self->media_type);
  136.     my $mt2 = join(";", $other->media_type);
  137.     return 0 if $mt1 ne $mt2;
  138.  
  139.     $self->data eq $other->data;
  140. }
  141.  
  142. 1;
  143.