美国CMU大学开发的操作系统健壮性评测软件

源代码在线查看: data.pm

软件大小: 1471 K
上传用户: zhangyan
关键词: CMU 美国 大学 操作系统
下载地址: 免注册下载 普通下载 VIP

相关代码

				package URI::URL::data;								# Implements data:-URLs as specified in draft-masinter-url-data-02.txt				#				# Abstract				#				# A new URL scheme, "data", is defined. It allows inclusion of small				# data items as "immediate" data, as if it had been included externally.				#				# Description				#				# Some applications that use URLs also have a need to embed (small)				# media type data directly inline. This document defines a new URL				# scheme that would work like 'immediate addressing'. The URLs are of				# the form:				#				#        data:[][;base64],				#								require URI::URL;				@ISA = qw(URI::URL);								use URI::Escape;				use MIME::Base64 ();								# as defined in rfc1522.txt				my $tspecial  = qq(()@,;:/[]?.=);				my $tokenchar = qq([^\\s\000-\037\177-\377\Q$tspecial\E]);												sub new {				    my($class, $init, $base) = @_;								    my $self = bless { }, $class;								    $self->{'scheme'} = lc($1) if $init =~ s/^\s*([\w\+\.\-]+)://;				    $self->{'frag'} = $1 if $init =~ s/\#(.*)$//;								    my $type = "";				    if ($init =~ s/^($tokenchar+\/$tokenchar+)//o) {					$type = $1;				    }				    while ($init =~ s/^;($tokenchar+)=([^,;]*)//o) {					# XXX should we unescape the parst					$type .= ";$1=$2";				    }								    $self->{'media_type'} = $type;								    my $base64;				    if ($init =~ s/^;base64//i) {					$base64 = 1;				    }				    				    $init =~ s/^,//;				    if ($base64) {					$self->{'base64'} = uri_unescape($init);				    } else {					$self->{'data'} = uri_unescape($init);				    }				    $self->base($base) if $base;				    $self;				}								sub media_type				{				    my $self = shift;				    my $old = $self->{'media_type'};				    if (@_) {					$self->{'media_type'} = shift || "";					delete $self->{'_str'};				    }				    my($type, $param) = split(/;/, $old, 2);				    if ($type) {					$type = lc $type;				    } else {					$type = "text/plain";					$param = "charset=US-ASCII" unless $param;				    }				    if (wantarray) {					return ($type, $param);				    } else {					return $type;				    }				}								sub data				{				    my $self = shift;				    my $old_data;				    my $old_base64;				    $old_data = $self->{'data'};				    $old_base64 = $self->{'base64'};				    if (@_) {					if ($_[1]) { # base64 flag					    $self->{'base64'} = $_[0];					    delete $self->{'data'};					} else {					    $self->{'data'} = $_[0];					    delete $self->{'base64'};					}					delete $self->{'_str'};				    }				    unless (defined $old_data) {					$old_data = MIME::Base64::decode($old_base64);					$self->{'data'} = $old_data unless @_;				    }				    $old_data;				}												sub crack				{				    my $self = shift;				    ($self->{'scheme'}				     || 'data',          # scheme				     undef,              # user				     undef,              # passwd				     undef,              # host				     undef,              # port				     $self->data,        # path				     $self->{'media_type'},  # params				     undef,              # query				     $self->{'frag'}     # fragment				    )				}								sub as_string {				    my $self = shift;				    return $self->{'_str'} if $self->{'_str'};				    my $str = ($self->{'scheme'} || 'data') . ":";				    $str .= $self->{'media_type'};				    if (defined $self->{'base64'}) {					$str .= ";base64,$self->{'base64'}";				    } else {					my $urlenc = uri_escape($self->{'data'});					my $base64 = MIME::Base64::encode($self->{'data'});					if (length($base64) + 7 < length($urlenc)) {					    $str .= ";base64,$base64";					    $self->{'base64'} = $base64;					} else {					    $str .= ",$urlenc";					}				    }				    $self->{'_str'} = $str;				}								sub eq {				    my($self, $other) = @_;				    return 0 if ref($self) ne ref($other);				    return 0 if $self->scheme ne $other->scheme;								    my $mt1 = join(";", $self->media_type);				    my $mt2 = join(";", $other->media_type);				    return 0 if $mt1 ne $mt2;								    $self->data eq $other->data;				}								1;							

相关资源