================ SmallProf version 1.15 ================ Profile of (eval 10)[/usr/lib64/perl5/5.8.5/x86_64-linux-thre Page 1 ================================================================= count wall tm cpu time line 1 0.000015 0.000000 1:1.09_00 0 0.000000 0.000000 2:; ================ SmallProf version 1.15 ================ Profile of (eval 11)[/usr/lib/perl5/5.8.5/IO/Socket/UNIX.pm:1 Page 2 ================================================================= count wall tm cpu time line 1 0.000015 0.000000 1:1.21 0 0.000000 0.000000 2:; ================ SmallProf version 1.15 ================ Profile of (eval 12)[/usr/lib/perl5/vendor_perl/5.8.5/HTTP/Me Page 3 ================================================================= count wall tm cpu time line 2917 0.017690 0.000000 1:sub { shift->{'_headers'}->push_header(@_) } 1 0.000021 0.000000 2:; ================ SmallProf version 1.15 ================ Profile of (eval 13)[/usr/lib/perl5/vendor_perl/5.8.5/HTTP/Me Page 4 ================================================================= count wall tm cpu time line 991 0.006337 0.020000 1:sub { shift->{'_headers'}->header(@_) } 1 0.000019 0.000000 2:; ================ SmallProf version 1.15 ================ Profile of (eval 14)[/usr/lib/perl5/vendor_perl/5.8.5/HTTP/Me Page 5 ================================================================= count wall tm cpu time line 380 0.002545 0.000000 1:sub { shift->{'_headers'}->remove_header(@_) 1 0.000018 0.000000 2:; ================ SmallProf version 1.15 ================ Profile of (eval 15)[/usr/lib/perl5/vendor_perl/5.8.5/HTTP/Me Page 6 ================================================================= count wall tm cpu time line 351 0.002487 0.010000 1:sub { shift->{'_headers'}->content_type(@_) } 1 0.000026 0.000000 2:; ================ SmallProf version 1.15 ================ Profile of (eval 5)[/usr/lib64/perl5/vendor_perl/5.8.5/x86_64 Page 7 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package # hide from PAUSE 0 0.000000 0.000000 2: DBI::_firesafe; # just in case 1 0.000006 0.000000 3: require DBD::mysql; # load the driver 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:; ================ SmallProf version 1.15 ================ Profile of (eval 6)[/usr/lib/perl5/vendor_perl/5.8.5/URI.pm:1 Page 8 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:require URI::http 0 0.000000 0.000000 2:; ================ SmallProf version 1.15 ================ Profile of (eval 7)[/usr/lib/perl5/vendor_perl/5.8.5/HTTP/Mes Page 9 ================================================================= count wall tm cpu time line 774 0.005002 0.000000 1:sub { shift->{'_headers'}->init_header(@_) } 1 0.000019 0.000000 2:; ================ SmallProf version 1.15 ================ Profile of (eval 8)[/usr/lib/perl5/vendor_perl/5.8.5/LWP/Prot Page 10 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:require LWP::Protocol::http 0 0.000000 0.000000 2:; ================ SmallProf version 1.15 ================ Profile of (eval 9)[/usr/lib64/perl5/5.8.5/x86_64-linux-threa Page 11 ================================================================= count wall tm cpu time line 1 0.000016 0.000000 1:1.24 0 0.000000 0.000000 2:; ================ SmallProf version 1.15 ================ Profile of /home/telalink/public_html/system/../config.cgi Page 12 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:#!/usr/bin/perl 0 0.000000 0.000000 2: 3 0.000013 0.000000 3:use DBI; 0 0.000000 0.000000 4: 1 0.000004 0.000000 5:$cstring="DBI:mysql:telalink_links:localhost" 1 0.000003 0.000000 6:$sqllogin='telalink_links'; 1 0.000003 0.000000 7:$sqlpassword='link0127u'; 0 0.000000 0.000000 8: 1 0.000002 0.000000 9:$ADMMAIL='rb@telait.com'; 0 0.000000 0.000000 10: 1 0.000004 0.000000 11:$MESSAGES{'FILL_ALL_FIELDS'}='Please fill in 1 0.000004 0.000000 12:$MESSAGES{'INVALID_EMAIL'}='Please enter a 1 0.000004 0.000000 13:$MESSAGES{'INVALID_CHARS_USERNAME'}='Invalid 1 0.000005 0.000000 14:$MESSAGES{'USER_EXISTS'}='This username is 1 0.000004 0.000000 15:$MESSAGES{'REGISTERED'}='Thank you for 1 0.000003 0.000000 16:$MESSAGES{'CHECK_PASSWORD'} = 'Password has 1 0.000003 0.000000 17:$MESSAGES{'LINK_DELETED'}='Link has been 1 0.000008 0.000000 18:$MESSAGES{'USER_DELETED'}='User has been 1 0.000004 0.000000 19:$MESSAGES{'SENT_MAIL'}='Mail sent!'; 1 0.000003 0.000000 20:$MESSAGES{'INCORRECT_URL'}='All URLs must 1 0.000004 0.000000 21:$MESSAGES{'URL_PRESENT'}='This URL with code 1 0.000004 0.000000 22:$MESSAGES{'DIFF_DOMAINS'}='Different 1 0.000003 0.000000 23:$MESSAGES{'NO_PAGE'}='The link page doesn\'t 1 0.000003 0.000000 24:$MESSAGES{'PASSWORD_SENT'}='The password has 1 0.000003 0.000000 25:$MESSAGES{'AGREE_TERMS'}='To register, you 1 0.000007 0.000000 26:$MESSAGES{'PASSWORD_NOT_FOUND'}='Sorry, we 1 0.000004 0.000000 27:$MESSAGES{'URLINT_INVALID'}='Your code URL is 1 0.000004 0.000000 28:$MESSAGE{'PROFILE_UPDATED'}='Profile has been 1 0.000005 0.000000 29:$MESSAGES{'INVALID_PASSWORD'}=' take care of the searching for 0 0.000000 0.000000 38: 4 0.000026 0.000000 39: my ($pkg,$func) = ($sub =~ 2 0.000015 0.000000 40: $pkg =~ s#::#/#g; 2 0.000013 0.000000 41: if (defined($filename = $INC{"$pkg.pm"})) { 2 0.000005 0.000000 42: if ($is_macos) { 0 0.000000 0.000000 43: $pkg =~ tr#/#:#; 0 0.000000 0.000000 44: $filename =~ 0 0.000000 0.000000 45: } else { 2 0.000093 0.000000 46: $filename =~ 0 0.000000 0.000000 47: } 0 0.000000 0.000000 48: 0 0.000000 0.000000 49: # if the file exists, then make sure 0 0.000000 0.000000 50: # a fully anchored path (i.e either 0 0.000000 0.000000 51: # or './lib/auto/foo/bar.al'. This 0 0.000000 0.000000 52: # (and failing) to find the 0 0.000000 0.000000 53: # looked for 'lib/lib/auto/foo/bar.al', 0 0.000000 0.000000 54: 2 0.000040 0.000000 55: if (-r $filename) { 0 0.000000 0.000000 56: unless ($filename =~ m|^/|s) { ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/AutoLoader.pm Page 14 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: if ($is_dosish) { 0 0.000000 0.000000 58: unless ($filename =~ m{^([a-z]:)?[\\/]}is) 0 0.000000 0.000000 59: if ($^O ne 'NetWare') { 0 0.000000 0.000000 60: $filename = "./$filename"; 0 0.000000 0.000000 61: } else { 0 0.000000 0.000000 62: $filename = "$filename"; 0 0.000000 0.000000 63: } 0 0.000000 0.000000 64: } 0 0.000000 0.000000 65: } 0 0.000000 0.000000 66: elsif ($is_epoc) { 0 0.000000 0.000000 67: unless ($filename =~ m{^([a- 0 0.000000 0.000000 68: $filename = "./$filename"; 0 0.000000 0.000000 69: } 0 0.000000 0.000000 70: } 0 0.000000 0.000000 71: elsif ($is_vms) { 0 0.000000 0.000000 72: # XXX todo by VMSmiths 0 0.000000 0.000000 73: $filename = "./$filename"; 0 0.000000 0.000000 74: } 0 0.000000 0.000000 75: elsif (!$is_macos) { 0 0.000000 0.000000 76: $filename = "./$filename"; 0 0.000000 0.000000 77: } 0 0.000000 0.000000 78: } 0 0.000000 0.000000 79: } 0 0.000000 0.000000 80: else { 2 0.000009 0.000000 81: $filename = undef; 0 0.000000 0.000000 82: } 0 0.000000 0.000000 83: } 2 0.000005 0.000000 84: unless (defined $filename) { 0 0.000000 0.000000 85: # let C do the searching 2 0.000009 0.000000 86: $filename = "auto/$sub.al"; 2 0.000017 0.000000 87: $filename =~ s#::#/#g; 0 0.000000 0.000000 88: } 0 0.000000 0.000000 89: } 2 0.000005 0.000000 90: my $save = $@; 2 0.000029 0.000000 91: local $!; # Do not munge the value. 6 0.000615 0.000000 92: eval { local $SIG{__DIE__}; require 2 0.000007 0.000000 93: if ($@) { 2 0.000008 0.000000 94: if (substr($sub,-9) eq '::DESTROY') { 0 0.000000 0.000000 95: no strict 'refs'; 635 0.008191 0.020000 96: *$sub = sub {}; 2 0.000005 0.000000 97: $@ = undef; 0 0.000000 0.000000 98: } elsif ($@ =~ /^Can't locate/) { 0 0.000000 0.000000 99: # The load might just have failed 0 0.000000 0.000000 100: # long for some old SVR3 systems which 0 0.000000 0.000000 101: # If we can successfully truncate a long 0 0.000000 0.000000 102: # There is a slight risk that we could 0 0.000000 0.000000 103: # but autosplit should have warned about 0 0.000000 0.000000 104: if ($filename =~ 0 0.000000 0.000000 105: eval { local $SIG{__DIE__}; require 0 0.000000 0.000000 106: } 0 0.000000 0.000000 107: } 2 0.000004 0.000000 108: if ($@){ 0 0.000000 0.000000 109: $@ =~ s/ at .*\n//; 0 0.000000 0.000000 110: my $error = $@; 0 0.000000 0.000000 111: require Carp; 0 0.000000 0.000000 112: Carp::croak($error); ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/AutoLoader.pm Page 15 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113: } 0 0.000000 0.000000 114: } 2 0.000004 0.000000 115: $@ = $save; 2 0.000022 0.000000 116: goto &$sub; 0 0.000000 0.000000 117:} 0 0.000000 0.000000 118: 0 0.000000 0.000000 119:sub import { 0 0.000000 0.000000 120: my $pkg = shift; 0 0.000000 0.000000 121: my $callpkg = caller; 0 0.000000 0.000000 122: 0 0.000000 0.000000 123: # 0 0.000000 0.000000 124: # Export symbols, but not by accident of 0 0.000000 0.000000 125: # 0 0.000000 0.000000 126: 0 0.000000 0.000000 127: if ($pkg eq 'AutoLoader') { 0 0.000000 0.000000 128: no strict 'refs'; 0 0.000000 0.000000 129: *{ $callpkg . '::AUTOLOAD' } = \&AUTOLOAD 0 0.000000 0.000000 130: if @_ and $_[0] =~ /^&?AUTOLOAD$/; 0 0.000000 0.000000 131: } 0 0.000000 0.000000 132: 0 0.000000 0.000000 133: # 0 0.000000 0.000000 134: # Try to find the autosplit index file. 0 0.000000 0.000000 135: # is POSIX, then $INC{POSIX.pm} is 0 0.000000 0.000000 136: # '/usr/local/lib/perl5/POSIX.pm', and 0 0.000000 0.000000 137: # 0 0.000000 0.000000 138: # 0 0.000000 0.000000 139: # However, if @INC is a relative path, 0 0.000000 0.000000 140: # for example, @INC = ('lib'), then 0 0.000000 0.000000 141: # $INC{POSIX.pm} is 'lib/POSIX.pm', and 0 0.000000 0.000000 142: # 'auto/POSIX/autosplit.ix' (without the 0 0.000000 0.000000 143: # 0 0.000000 0.000000 144: 0 0.000000 0.000000 145: (my $calldir = $callpkg) =~ s#::#/#g; 0 0.000000 0.000000 146: my $path = $INC{$calldir . '.pm'}; 0 0.000000 0.000000 147: if (defined($path)) { 0 0.000000 0.000000 148: # Try absolute path name. 0 0.000000 0.000000 149: if ($is_macos) { 0 0.000000 0.000000 150: (my $malldir = $calldir) =~ tr#/#:#; 0 0.000000 0.000000 151: $path =~ 0 0.000000 0.000000 152: } else { 0 0.000000 0.000000 153: $path =~ 0 0.000000 0.000000 154: } 0 0.000000 0.000000 155: 0 0.000000 0.000000 156: eval { require $path; }; 0 0.000000 0.000000 157: # If that failed, try relative path with 0 0.000000 0.000000 158: if ($@) { 0 0.000000 0.000000 159: $path ="auto/$calldir/autosplit.ix"; 0 0.000000 0.000000 160: eval { require $path; }; 0 0.000000 0.000000 161: } 0 0.000000 0.000000 162: if ($@) { 0 0.000000 0.000000 163: my $error = $@; 0 0.000000 0.000000 164: require Carp; 0 0.000000 0.000000 165: Carp::carp($error); 0 0.000000 0.000000 166: } 0 0.000000 0.000000 167: } 0 0.000000 0.000000 168:} ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/AutoLoader.pm Page 16 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169: 0 0.000000 0.000000 170:sub unimport { 0 0.000000 0.000000 171: my $callpkg = caller; 0 0.000000 0.000000 172: 0 0.000000 0.000000 173: no strict 'refs'; 0 0.000000 0.000000 174: my $symname = $callpkg . '::AUTOLOAD'; 0 0.000000 0.000000 175: undef *{ $symname } if \&{ $symname } == 0 0.000000 0.000000 176: *{ $symname } = \&{ $symname }; 0 0.000000 0.000000 177:} 0 0.000000 0.000000 178: 0 0.000000 0.000000 179:1; 0 0.000000 0.000000 180: 0 0.000000 0.000000 181:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/Exporter.pm Page 17 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package Exporter; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:require 5.006; 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:# Be lean. 0 0.000000 0.000000 6:#use strict; 0 0.000000 0.000000 7:#no strict 'refs'; 0 0.000000 0.000000 8: 0 0.000000 0.000000 9:our $Debug = 0; 0 0.000000 0.000000 10:our $ExportLevel = 0; 0 0.000000 0.000000 11:our $Verbose ||= 0; 0 0.000000 0.000000 12:our $VERSION = '5.58'; 0 0.000000 0.000000 13:our (%Cache); 0 0.000000 0.000000 14:$Carp::Internal{Exporter} = 1; 0 0.000000 0.000000 15: 5 0.000000 0.000000 16:sub as_heavy { 4 0.000015 0.000000 17: require Exporter::Heavy; 0 0.000000 0.000000 18: # Unfortunately, this does not work if the 0 0.000000 0.000000 19: # Thus the need to create a lot of 4 0.000037 0.000000 20: my $c = (caller(1))[3]; 4 0.000028 0.000000 21: $c =~ s/.*:://; 8 0.000065 0.000000 22: \&{"Exporter::Heavy::heavy_$c"}; 0 0.000000 0.000000 23:} 0 0.000000 0.000000 24: 4 0.000000 0.000000 25:sub export { 8 0.000026 0.000000 26: goto &{as_heavy()}; 0 0.000000 0.000000 27:} 0 0.000000 0.000000 28: 25 0.000000 0.000000 29:sub import { 23 0.000078 0.000000 30: my $pkg = shift; 23 0.000072 0.000000 31: my $callpkg = caller($ExportLevel); 0 0.000000 0.000000 32: 23 0.000067 0.000000 33: if ($pkg eq "Exporter" and @_ and $_[0] eq 0 0.000000 0.000000 34: *{$callpkg."::import"} = \&import; 0 0.000000 0.000000 35: return; 0 0.000000 0.000000 36: } 0 0.000000 0.000000 37: 0 0.000000 0.000000 38: # We *need* to treat 69 0.000303 0.000000 39: my($exports, $fail) = (\@{"$pkg\::EXPORT"}, 23 0.000080 0.000000 40: return export $pkg, $callpkg, @_ 0 0.000000 0.000000 41: if $Verbose or $Debug or @$fail > 1; 23 0.000094 0.000000 42: my $export_cache = ($Cache{$pkg} ||= {}); 23 0.000496 0.000000 43: my $args = @_ or @_ = @$exports; 0 0.000000 0.000000 44: 23 0.000060 0.000000 45: local $_; 23 0.000061 0.000000 46: if ($args and not %$export_cache) { 2 0.000136 0.000000 47: s/^&//, $export_cache->{$_} = 1 4 0.000009 0.000000 48: foreach (@$exports, 0 0.000000 0.000000 49: } 23 0.000049 0.000000 50: my $heavy; 0 0.000000 0.000000 51: # Try very hard not to use {} and hence 0 0.000000 0.000000 52: # We bomb out of the loop with last as soon 23 0.000064 0.000000 53: if ($args or $fail) { 0 0.000000 0.000000 54: ($heavy = (/\W/ or $args and not exists 0 0.000000 0.000000 55: or @$fail and $_ eq $fail- 46 0.000497 0.000000 56: foreach (@_); ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/Exporter.pm Page 18 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: } else { 0 0.000000 0.000000 58: ($heavy = /\W/) and last 0 0.000000 0.000000 59: foreach (@_); 0 0.000000 0.000000 60: } 23 0.000060 0.000000 61: return export $pkg, $callpkg, ($args ? @_ : 0 0.000000 0.000000 62: local $SIG{__WARN__} = 21 0.000213 0.000000 63: sub {require Carp; &Carp::carp}; 0 0.000000 0.000000 64: # shortcut for the common case of no type 1054 0.020226 0.030000 65: *{"$callpkg\::$_"} = \&{"$pkg\::$_"} 0 0.000000 0.000000 66:} 0 0.000000 0.000000 67: 0 0.000000 0.000000 68:# Default methods 0 0.000000 0.000000 69: 0 0.000000 0.000000 70:sub export_fail { 0 0.000000 0.000000 71: my $self = shift; 0 0.000000 0.000000 72: @_; 0 0.000000 0.000000 73:} 0 0.000000 0.000000 74: 0 0.000000 0.000000 75:# Unfortunately, caller(1)[3] "does not work" 0 0.000000 0.000000 76:# *name = \&foo. Thus the need to create a 0 0.000000 0.000000 77:# Otherwise we could have aliased them to 0 0.000000 0.000000 78: 0 0.000000 0.000000 79:sub export_to_level { 0 0.000000 0.000000 80: goto &{as_heavy()}; 0 0.000000 0.000000 81:} 0 0.000000 0.000000 82: 0 0.000000 0.000000 83:sub export_tags { 0 0.000000 0.000000 84: goto &{as_heavy()}; 0 0.000000 0.000000 85:} 0 0.000000 0.000000 86: 1 0.000000 0.000000 87:sub export_ok_tags { 0 0.000000 0.000000 88: goto &{as_heavy()}; 0 0.000000 0.000000 89:} 0 0.000000 0.000000 90: 0 0.000000 0.000000 91:sub require_version { 0 0.000000 0.000000 92: goto &{as_heavy()}; 0 0.000000 0.000000 93:} 0 0.000000 0.000000 94: 0 0.000000 0.000000 95:1; 0 0.000000 0.000000 96:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/Exporter/Heavy.pm Page 19 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package Exporter::Heavy; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:use strict; 0 0.000000 0.000000 4:no strict 'refs'; 0 0.000000 0.000000 5: 0 0.000000 0.000000 6:# On one line so MakeMaker will see it. 0 0.000000 0.000000 7:require Exporter; our $VERSION = 0 0.000000 0.000000 8:$Carp::Internal{"Exporter::Heavy"} = 1; 0 0.000000 0.000000 9: 0 0.000000 0.000000 10:=head1 NAME 0 0.000000 0.000000 11: 0 0.000000 0.000000 12: 0 0.000000 0.000000 13: 0 0.000000 0.000000 14: 0 0.000000 0.000000 15: 0 0.000000 0.000000 16: 0 0.000000 0.000000 17: 0 0.000000 0.000000 18: 0 0.000000 0.000000 19: 0 0.000000 0.000000 20: 0 0.000000 0.000000 21: 0 0.000000 0.000000 22: 0 0.000000 0.000000 23: 0 0.000000 0.000000 24:# 0 0.000000 0.000000 25:# We go to a lot of trouble not to 'require 0 0.000000 0.000000 26:# because Carp requires Exporter, and 0 0.000000 0.000000 27:# 0 0.000000 0.000000 28: 0 0.000000 0.000000 29:sub _rebuild_cache { 0 0.000000 0.000000 30: my ($pkg, $exports, $cache) = @_; 0 0.000000 0.000000 31: s/^&// foreach @$exports; 0 0.000000 0.000000 32: @{$cache}{@$exports} = (1) x @$exports; 0 0.000000 0.000000 33: my $ok = \@{"${pkg}::EXPORT_OK"}; 0 0.000000 0.000000 34: if (@$ok) { 0 0.000000 0.000000 35: s/^&// foreach @$ok; 0 0.000000 0.000000 36: @{$cache}{@$ok} = (1) x @$ok; 0 0.000000 0.000000 37: } 0 0.000000 0.000000 38:} 0 0.000000 0.000000 39: 0 0.000000 0.000000 40:sub heavy_export { 0 0.000000 0.000000 41: 0 0.000000 0.000000 42: # First make import warnings look like 0 0.000000 0.000000 43: local $SIG{__WARN__} = sub { 0 0.000000 0.000000 44: my $text = shift; 0 0.000000 0.000000 45: if ($text =~ s/ at \S*Exporter\S*.pm line 0 0.000000 0.000000 46: require Carp; 0 0.000000 0.000000 47: local $Carp::CarpLevel = 1; # ignore 0 0.000000 0.000000 48: Carp::carp($text); 0 0.000000 0.000000 49: } 0 0.000000 0.000000 50: else { 0 0.000000 0.000000 51: warn $text; 0 0.000000 0.000000 52: } 4 0.000043 0.000000 53: }; 0 0.000000 0.000000 54: local $SIG{__DIE__} = sub { 0 0.000000 0.000000 55: require Carp; 0 0.000000 0.000000 56: local $Carp::CarpLevel = 1; # ignore package ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/Exporter/Heavy.pm Page 20 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: Carp::croak("$_[0]Illegal null symbol in 0 0.000000 0.000000 58: if $_[0] =~ /^Unable to create sub named 4 0.000034 0.000000 59: }; 0 0.000000 0.000000 60: 4 0.000021 0.000000 61: my($pkg, $callpkg, @imports) = @_; 4 0.000013 0.000000 62: my($type, $sym, $cache_is_current, 8 0.000034 0.000000 63: my($exports, $export_cache) = 0 0.000000 0.000000 64: 0 0.000000 0.000000 65: 4 0.000011 0.000000 66: if (@imports) { 2 0.000018 0.000000 67: if (!%$export_cache) { 0 0.000000 0.000000 68: _rebuild_cache ($pkg, $exports, 0 0.000000 0.000000 69: $cache_is_current = 1; 0 0.000000 0.000000 70: } 0 0.000000 0.000000 71: 2 0.000012 0.000000 72: if (grep m{^[/!:]}, @imports) { 4 0.000015 0.000000 73: my $tagsref = \%{"${pkg}::EXPORT_TAGS"}; 2 0.000003 0.000000 74: my $tagdata; 2 0.000005 0.000000 75: my %imports; 2 0.000005 0.000000 76: my($remove, $spec, @names, @allexports); 0 0.000000 0.000000 77: # negated first item implies starting 2 0.000008 0.000000 78: unshift @imports, ':DEFAULT' if 2 0.000008 0.000000 79: foreach $spec (@imports){ 2 0.000008 0.000000 80: $remove = $spec =~ s/^!//; 0 0.000000 0.000000 81: 2 0.000009 0.000000 82: if ($spec =~ s/^://){ 2 0.000008 0.000000 83: if ($spec eq 'DEFAULT'){ 0 0.000000 0.000000 84: @names = @$exports; 0 0.000000 0.000000 85: } 0 0.000000 0.000000 86: elsif ($tagdata = $tagsref->{$spec}) { 2 0.000109 0.000000 87: @names = @$tagdata; 0 0.000000 0.000000 88: } 0 0.000000 0.000000 89: else { 0 0.000000 0.000000 90: warn qq["$spec" is not defined in 0 0.000000 0.000000 91: ++$oops; 0 0.000000 0.000000 92: next; 0 0.000000 0.000000 93: } 0 0.000000 0.000000 94: } 0 0.000000 0.000000 95: elsif ($spec =~ m:^/(.*)/$:){ 0 0.000000 0.000000 96: my $patn = $1; 0 0.000000 0.000000 97: @allexports = keys %$export_cache 0 0.000000 0.000000 98: @names = grep(/$patn/, @allexports); # 0 0.000000 0.000000 99: } 0 0.000000 0.000000 100: else { 0 0.000000 0.000000 101: @names = ($spec); # is a normal symbol 0 0.000000 0.000000 102: } 0 0.000000 0.000000 103: 2 0.000004 0.000000 104: warn "Import ".($remove ? "del":"add").": 0 0.000000 0.000000 105: if $Exporter::Verbose; 0 0.000000 0.000000 106: 2 0.000006 0.000000 107: if ($remove) { 0 0.000000 0.000000 108: foreach $sym (@names) { delete 0 0.000000 0.000000 109: } 0 0.000000 0.000000 110: else { 2 0.000112 0.000000 111: @imports{@names} = (1) x @names; 0 0.000000 0.000000 112: } ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/Exporter/Heavy.pm Page 21 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113: } 2 0.000147 0.000000 114: @imports = keys %imports; 0 0.000000 0.000000 115: } 0 0.000000 0.000000 116: 2 0.000004 0.000000 117: my @carp; 2 0.000006 0.000000 118: foreach $sym (@imports) { 114 0.000370 0.000000 119: if (!$export_cache->{$sym}) { 0 0.000000 0.000000 120: if ($sym =~ m/^\d/) { 0 0.000000 0.000000 121: $pkg->VERSION($sym); # inherit from 0 0.000000 0.000000 122: # If the version number was the only 0 0.000000 0.000000 123: # then we should act as if nothing was 0 0.000000 0.000000 124: if (@imports == 1) { 0 0.000000 0.000000 125: @imports = @$exports; 0 0.000000 0.000000 126: last; 0 0.000000 0.000000 127: } 0 0.000000 0.000000 128: # We need a way to emulate 'use Foo ()' 0 0.000000 0.000000 129: # allow an easy version check: "use Foo 0 0.000000 0.000000 130: if (@imports == 2 and !$imports[1]) { 0 0.000000 0.000000 131: @imports = (); 0 0.000000 0.000000 132: last; 0 0.000000 0.000000 133: } 0 0.000000 0.000000 134: } elsif ($sym !~ s/^&// || !$export_cache- 0 0.000000 0.000000 135: # Last chance - see if they've updated 0 0.000000 0.000000 136: # cached it. 0 0.000000 0.000000 137: 0 0.000000 0.000000 138: unless ($cache_is_current) { 0 0.000000 0.000000 139: %$export_cache = (); 0 0.000000 0.000000 140: _rebuild_cache ($pkg, $exports, 0 0.000000 0.000000 141: $cache_is_current = 1; 0 0.000000 0.000000 142: } 0 0.000000 0.000000 143: 0 0.000000 0.000000 144: if (!$export_cache->{$sym}) { 0 0.000000 0.000000 145: # accumulate the non-exports 0 0.000000 0.000000 146: push @carp, 0 0.000000 0.000000 147: qq["$sym" is not exported by the $pkg 0 0.000000 0.000000 148: $oops++; 0 0.000000 0.000000 149: } 0 0.000000 0.000000 150: } 0 0.000000 0.000000 151: } 0 0.000000 0.000000 152: } 2 0.000007 0.000000 153: if ($oops) { 0 0.000000 0.000000 154: require Carp; 0 0.000000 0.000000 155: Carp::croak("@{carp}Can't continue after 0 0.000000 0.000000 156: } 0 0.000000 0.000000 157: } 0 0.000000 0.000000 158: else { 2 0.000284 0.000000 159: @imports = @$exports; 0 0.000000 0.000000 160: } 0 0.000000 0.000000 161: 8 0.000045 0.000000 162: my($fail, $fail_cache) = 0 0.000000 0.000000 163: 0 0.000000 0.000000 164: 4 0.000011 0.000000 165: if (@$fail) { 0 0.000000 0.000000 166: if (!%$fail_cache) { 0 0.000000 0.000000 167: # Build cache of symbols. Optimise the 0 0.000000 0.000000 168: # barewords twice... both with and ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/Exporter/Heavy.pm Page 22 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169: # (Technique could be applied to 0 0.000000 0.000000 170: my @expanded = map { /^\w/ ? ($_, 0 0.000000 0.000000 171: warn "${pkg}::EXPORT_FAIL cached: 0 0.000000 0.000000 172: @{$fail_cache}{@expanded} = (1) x 0 0.000000 0.000000 173: } 0 0.000000 0.000000 174: my @failed; 0 0.000000 0.000000 175: foreach $sym (@imports) { push(@failed, 0 0.000000 0.000000 176: if (@failed) { 0 0.000000 0.000000 177: @failed = $pkg->export_fail(@failed); 0 0.000000 0.000000 178: foreach $sym (@failed) { 0 0.000000 0.000000 179: require Carp; 0 0.000000 0.000000 180: Carp::carp(qq["$sym" is not implemented by 0 0.000000 0.000000 181: "on this architecture"); 0 0.000000 0.000000 182: } 0 0.000000 0.000000 183: if (@failed) { 0 0.000000 0.000000 184: require Carp; 0 0.000000 0.000000 185: Carp::croak("Can't continue after import 0 0.000000 0.000000 186: } 0 0.000000 0.000000 187: } 0 0.000000 0.000000 188: } 0 0.000000 0.000000 189: 4 0.000008 0.000000 190: warn "Importing into $callpkg from $pkg: 0 0.000000 0.000000 191: join(", ",sort @imports) if 0 0.000000 0.000000 192: 4 0.000012 0.000000 193: foreach $sym (@imports) { 0 0.000000 0.000000 194: # shortcut for the common case of no type 1290 0.007489 0.010000 195: (*{"${callpkg}::$sym"} = \&{"${pkg}::$sym"}, 0 0.000000 0.000000 196: unless $sym =~ s/^(\W)//; 0 0.000000 0.000000 197: $type = $1; 0 0.000000 0.000000 198: *{"${callpkg}::$sym"} = 0 0.000000 0.000000 199: $type eq '&' ? \&{"${pkg}::$sym"} : 0 0.000000 0.000000 200: $type eq '$' ? \${"${pkg}::$sym"} : 0 0.000000 0.000000 201: $type eq '@' ? \@{"${pkg}::$sym"} : 0 0.000000 0.000000 202: $type eq '%' ? \%{"${pkg}::$sym"} : 0 0.000000 0.000000 203: $type eq '*' ? *{"${pkg}::$sym"} : 0 0.000000 0.000000 204: do { require Carp; Carp::croak("Can't 0 0.000000 0.000000 205: } 0 0.000000 0.000000 206:} 0 0.000000 0.000000 207: 0 0.000000 0.000000 208:sub heavy_export_to_level 0 0.000000 0.000000 209:{ 0 0.000000 0.000000 210: my $pkg = shift; 0 0.000000 0.000000 211: my $level = shift; 0 0.000000 0.000000 212: (undef) = shift; # XXX redundant arg 0 0.000000 0.000000 213: my $callpkg = caller($level); 0 0.000000 0.000000 214: $pkg->export($callpkg, @_); 0 0.000000 0.000000 215:} 0 0.000000 0.000000 216: 0 0.000000 0.000000 217:# Utility functions 0 0.000000 0.000000 218: 1 0.000000 0.000000 219:sub _push_tags { 0 0.000000 0.000000 220: my($pkg, $var, $syms) = @_; 0 0.000000 0.000000 221: my @nontag = (); 0 0.000000 0.000000 222: my $export_tags = 0 0.000000 0.000000 223: push(@{"${pkg}::$var"}, 0 0.000000 0.000000 224: map { $export_tags->{$_} ? @{$export_tags- ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/Exporter/Heavy.pm Page 23 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 225: : 0 0.000000 0.000000 226: (@$syms) ? @$syms : keys %$export_tags); 0 0.000000 0.000000 227: if (@nontag and $^W) { 0 0.000000 0.000000 228: # This may change to a die one day 0 0.000000 0.000000 229: require Carp; 0 0.000000 0.000000 230: Carp::carp(join(", ", @nontag)." are not 0 0.000000 0.000000 231: } 0 0.000000 0.000000 232:} 0 0.000000 0.000000 233: 0 0.000000 0.000000 234:sub heavy_require_version { 0 0.000000 0.000000 235: my($self, $wanted) = @_; 0 0.000000 0.000000 236: my $pkg = ref $self || $self; 0 0.000000 0.000000 237: return ${pkg}->VERSION($wanted); 0 0.000000 0.000000 238:} 0 0.000000 0.000000 239: 0 0.000000 0.000000 240:sub heavy_export_tags { 0 0.000000 0.000000 241: _push_tags((caller)[0], "EXPORT", \@_); 0 0.000000 0.000000 242:} 0 0.000000 0.000000 243: 0 0.000000 0.000000 244:sub heavy_export_ok_tags { 0 0.000000 0.000000 245: _push_tags((caller)[0], "EXPORT_OK", \@_); 0 0.000000 0.000000 246:} 0 0.000000 0.000000 247: 0 0.000000 0.000000 248:1; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/IO/Socket/INET.pm Page 24 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:# IO::Socket::INET.pm 0 0.000000 0.000000 2:# 0 0.000000 0.000000 3:# Copyright (c) 1997-8 Graham Barr 0 0.000000 0.000000 4:# This program is free software; you can 0 0.000000 0.000000 5:# modify it under the same terms as Perl 0 0.000000 0.000000 6: 0 0.000000 0.000000 7:package IO::Socket::INET; 0 0.000000 0.000000 8: 3 0.000010 0.000000 9:use strict; 1 0.000004 0.000000 10:our(@ISA, $VERSION); 3 0.000017 0.000000 11:use IO::Socket; 3 0.000011 0.000000 12:use Socket; 3 0.000010 0.000000 13:use Carp; 3 0.000010 0.000000 14:use Exporter; 3 0.000012 0.000000 15:use Errno; 0 0.000000 0.000000 16: 1 0.000007 0.000000 17:@ISA = qw(IO::Socket); 1 0.000004 0.000000 18:$VERSION = "1.27"; 0 0.000000 0.000000 19: 1 0.000003 0.000000 20:my $EINVAL = exists(&Errno::EINVAL) ? 0 0.000000 0.000000 21: 1 0.000006 0.000000 22:IO::Socket::INET->register_domain( AF_INET ); 0 0.000000 0.000000 23: 1 0.000004 0.000000 24:my %socket_type = ( tcp => SOCK_STREAM, 0 0.000000 0.000000 25: udp => SOCK_DGRAM, 0 0.000000 0.000000 26: icmp => SOCK_RAW 0 0.000000 0.000000 27: ); 0 0.000000 0.000000 28: 387 0.000000 0.000000 29:sub new { 387 0.001425 0.010000 30: my $class = shift; 387 0.001382 0.000000 31: unshift(@_, "PeerAddr") if @_ == 1; 387 0.002572 0.020000 32: return $class->SUPER::new(@_); 0 0.000000 0.000000 33:} 0 0.000000 0.000000 34: 774 0.000000 0.000000 35:sub _sock_info { 774 0.004246 0.000000 36: my($addr,$port,$proto) = @_; 774 0.002158 0.020000 37: my $origport = $port; 774 0.002036 0.010000 38: my @proto = (); 774 0.001850 0.010000 39: my @serv = (); 0 0.000000 0.000000 40: 774 0.002783 0.010000 41: $port = $1 0 0.000000 0.000000 42: if(defined $addr && $addr =~ 0 0.000000 0.000000 43: 774 0.003818 0.010000 44: if(defined $proto && $proto =~ /\D/) { 387 0.036668 0.050000 45: if(@proto = getprotobyname($proto)) { 387 0.002059 0.000000 46: $proto = $proto[2] || undef; 0 0.000000 0.000000 47: } 0 0.000000 0.000000 48: else { 0 0.000000 0.000000 49: $@ = "Bad protocol '$proto'"; 0 0.000000 0.000000 50: return; 0 0.000000 0.000000 51: } 0 0.000000 0.000000 52: } 0 0.000000 0.000000 53: 774 0.002278 0.000000 54: if(defined $port) { 387 0.001956 0.010000 55: my $defport = ($port =~ s,\((\d+)\)$,,) ? 387 0.003126 0.000000 56: my $pnum = ($port =~ m,^(\d+)$,)[0]; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/IO/Socket/INET.pm Page 25 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: 387 0.001492 0.000000 58: @serv = getservbyname($port, $proto[0] || 0 0.000000 0.000000 59: if ($port =~ m,\D,); 0 0.000000 0.000000 60: 387 0.001406 0.010000 61: $port = $serv[2] || $defport || $pnum; 387 0.001049 0.010000 62: unless (defined $port) { 0 0.000000 0.000000 63: $@ = "Bad service '$origport'"; 0 0.000000 0.000000 64: return; 0 0.000000 0.000000 65: } 0 0.000000 0.000000 66: 387 0.001346 0.000000 67: $proto = (getprotobyname($serv[3]))[2] || 0 0.000000 0.000000 68: if @serv && !$proto; 0 0.000000 0.000000 69: } 0 0.000000 0.000000 70: 774 0.008527 0.000000 71: return ($addr || undef, 0 0.000000 0.000000 72: $port || undef, 0 0.000000 0.000000 73: $proto || undef 0 0.000000 0.000000 74: ); 0 0.000000 0.000000 75:} 0 0.000000 0.000000 76: 32 0.000000 0.000000 77:sub _error { 32 0.000128 0.000000 78: my $sock = shift; 32 0.000122 0.000000 79: my $err = shift; 0 0.000000 0.000000 80: { 64 0.000313 0.000000 81: local($!); 32 0.000155 0.000000 82: my $title = ref($sock).": "; 32 0.000341 0.000000 83: $@ = join("", $_[0] =~ /^$title/ ? "" : 32 0.000268 0.010000 84: close($sock) 0 0.000000 0.000000 85: if(defined fileno($sock)); 0 0.000000 0.000000 86: } 32 0.000119 0.010000 87: $! = $err; 32 0.000222 0.000000 88: return undef; 0 0.000000 0.000000 89:} 0 0.000000 0.000000 90: 387 0.000000 0.000000 91:sub _get_addr { 387 0.002209 0.020000 92: my($sock,$addr_str, $multi) = @_; 387 0.001373 0.010000 93: my @addr; 387 0.001290 0.000000 94: if ($multi && $addr_str !~ 0 0.000000 0.000000 95: (undef, undef, undef, undef, @addr) = 0 0.000000 0.000000 96: } else { 387 ######## 0.110000 97: my $h = inet_aton($addr_str); 387 0.002319 0.000000 98: push(@addr, $h) if defined $h; 0 0.000000 0.000000 99: } 387 0.003435 0.010000 100: @addr; 0 0.000000 0.000000 101:} 0 0.000000 0.000000 102: 387 0.000000 0.000000 103:sub configure { 387 0.001488 0.000000 104: my($sock,$arg) = @_; 387 0.001337 0.000000 105: 0 0.000000 0.000000 106: 0 0.000000 0.000000 107: 387 0.001614 0.010000 108: $arg->{LocalAddr} = $arg->{LocalHost} 0 0.000000 0.000000 109: if exists $arg->{LocalHost} && !exists $arg- 0 0.000000 0.000000 110: 387 0.002598 0.000000 111: ($laddr,$lport,$proto) = _sock_info($arg- 0 0.000000 0.000000 112: $arg->{LocalPort}, ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/IO/Socket/INET.pm Page 26 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113: $arg->{Proto}) 0 0.000000 0.000000 114: or return _error($sock, $!, $@); 0 0.000000 0.000000 115: 387 0.001684 0.000000 116: $laddr = defined $laddr ? 0 0.000000 0.000000 117: : INADDR_ANY; 0 0.000000 0.000000 118: 387 0.001181 0.000000 119: return _error($sock, $EINVAL, "Bad 0 0.000000 0.000000 120: unless(defined $laddr); 0 0.000000 0.000000 121: 387 0.001612 0.000000 122: $arg->{PeerAddr} = $arg->{PeerHost} 0 0.000000 0.000000 123: if exists $arg->{PeerHost} && !exists $arg- 0 0.000000 0.000000 124: 387 0.001524 0.000000 125: unless(exists $arg->{Listen}) { 387 0.002414 0.020000 126: ($raddr,$rport,$proto) = _sock_info($arg- 0 0.000000 0.000000 127: $arg->{PeerPort}, 0 0.000000 0.000000 128: $proto) 0 0.000000 0.000000 129: or return _error($sock, $!, $@); 0 0.000000 0.000000 130: } 0 0.000000 0.000000 131: 387 0.001156 0.020000 132: $proto ||= (getprotobyname('tcp'))[2]; 0 0.000000 0.000000 133: 387 0.019382 0.000000 134: my $pname = 387 0.002110 0.000000 135: $type = $arg->{Type} || 0 0.000000 0.000000 136: 387 0.001104 0.000000 137: my @raddr = (); 0 0.000000 0.000000 138: 387 0.001163 0.000000 139: if(defined $raddr) { 387 0.002574 0.010000 140: @raddr = $sock->_get_addr($raddr, $arg- 387 0.001591 0.000000 141: return _error($sock, $EINVAL, "Bad hostname 0 0.000000 0.000000 142: unless @raddr; 0 0.000000 0.000000 143: } 0 0.000000 0.000000 144: 359 0.001109 0.000000 145: while(1) { 0 0.000000 0.000000 146: 359 0.001612 0.000000 147: $sock->socket(AF_INET, $type, $proto) or 0 0.000000 0.000000 148: return _error($sock, $!, "$!"); 0 0.000000 0.000000 149: 359 0.001549 0.000000 150: if (defined $arg->{Blocking}) { 0 0.000000 0.000000 151: defined $sock->blocking($arg- 0 0.000000 0.000000 152: or return _error($sock, $!, "$!"); 0 0.000000 0.000000 153: } 0 0.000000 0.000000 154: 359 0.001590 0.000000 155: if ($arg->{Reuse} || $arg->{ReuseAddr}) { 0 0.000000 0.000000 156: $sock->sockopt(SO_REUSEADDR,1) or 0 0.000000 0.000000 157: return _error($sock, $!, "$!"); 0 0.000000 0.000000 158: } 0 0.000000 0.000000 159: 359 0.001321 0.000000 160: if ($arg->{ReusePort}) { 0 0.000000 0.000000 161: $sock->sockopt(SO_REUSEPORT,1) or 0 0.000000 0.000000 162: return _error($sock, $!, "$!"); 0 0.000000 0.000000 163: } 0 0.000000 0.000000 164: 359 0.001377 0.000000 165: if ($arg->{Broadcast}) { 0 0.000000 0.000000 166: $sock->sockopt(SO_BROADCAST,1) or 0 0.000000 0.000000 167: return _error($sock, $!, "$!"); 0 0.000000 0.000000 168: } ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/IO/Socket/INET.pm Page 27 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169: 359 0.001234 0.000000 170: if($lport || ($laddr ne INADDR_ANY) || 0 0.000000 0.000000 171: $sock->bind($lport || 0, $laddr) or 0 0.000000 0.000000 172: return _error($sock, $!, "$!"); 0 0.000000 0.000000 173: } 0 0.000000 0.000000 174: 359 0.001269 0.000000 175: if(exists $arg->{Listen}) { 0 0.000000 0.000000 176: $sock->listen($arg->{Listen} || 5) or 0 0.000000 0.000000 177: return _error($sock, $!, "$!"); 0 0.000000 0.000000 178: last; 0 0.000000 0.000000 179: } 0 0.000000 0.000000 180: 0 0.000000 0.000000 181: # don't try to connect unless we're given a 359 0.001260 0.000000 182: last unless exists($arg->{PeerAddr}); 0 0.000000 0.000000 183: 359 0.001314 0.000000 184: $raddr = shift @raddr; 0 0.000000 0.000000 185: 359 0.001145 0.000000 186: return _error($sock, $EINVAL, 'Cannot 0 0.000000 0.000000 187: unless($rport || $type == SOCK_DGRAM || 0 0.000000 0.000000 188: 0 0.000000 0.000000 189: last 359 0.003014 0.000000 190: unless($type == SOCK_STREAM || defined 0 0.000000 0.000000 191: 359 0.001015 0.000000 192: return _error($sock, $EINVAL, "Bad hostname 0 0.000000 0.000000 193: unless defined $raddr; 0 0.000000 0.000000 194: 0 0.000000 0.000000 195:# my $timeout = 0 0.000000 0.000000 196:# my $before = time() if $timeout; 0 0.000000 0.000000 197: 359 0.001228 0.000000 198: undef $@; 359 0.002491 0.000000 199: if ($sock- 0 0.000000 0.000000 200:# ${*$sock}{'io_socket_timeout'} = 355 0.003979 0.010000 201: return $sock; 0 0.000000 0.000000 202: } 0 0.000000 0.000000 203: 4 0.000041 0.000000 204: return _error($sock, $!, $@ || "Timeout") 0 0.000000 0.000000 205: unless @raddr; 0 0.000000 0.000000 206: 0 0.000000 0.000000 207:# if ($timeout) { 0 0.000000 0.000000 208:# my $new_timeout = $timeout - (time() - 0 0.000000 0.000000 209:# return _error($sock, 0 0.000000 0.000000 210:# 0 0.000000 0.000000 211:# "Timeout") if 0 0.000000 0.000000 212:# ${*$sock}{'io_socket_timeout'} = 0 0.000000 0.000000 213:# } 0 0.000000 0.000000 214: 0 0.000000 0.000000 215: } 0 0.000000 0.000000 216: 0 0.000000 0.000000 217: $sock; 0 0.000000 0.000000 218:} 0 0.000000 0.000000 219: 359 0.000000 0.000000 220:sub connect { 359 0.001450 0.000000 221: @_ == 2 || @_ == 3 or 0 0.000000 0.000000 222: croak 'usage: $sock->connect(NAME) or 359 0.001195 0.010000 223: my $sock = shift; 359 0.002464 0.000000 224: return $sock->SUPER::connect(@_ == 1 ? ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/IO/Socket/INET.pm Page 28 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 225:} 0 0.000000 0.000000 226: 0 0.000000 0.000000 227:sub bind { 0 0.000000 0.000000 228: @_ == 2 || @_ == 3 or 0 0.000000 0.000000 229: croak 'usage: $sock->bind(NAME) or 0 0.000000 0.000000 230: my $sock = shift; 0 0.000000 0.000000 231: return $sock->SUPER::bind(@_ == 1 ? shift 0 0.000000 0.000000 232:} 0 0.000000 0.000000 233: 0 0.000000 0.000000 234:sub sockaddr { 0 0.000000 0.000000 235: @_ == 1 or croak 'usage: $sock- 0 0.000000 0.000000 236: my($sock) = @_; 0 0.000000 0.000000 237: my $name = $sock->sockname; 0 0.000000 0.000000 238: $name ? (sockaddr_in($name))[1] : undef; 0 0.000000 0.000000 239:} 0 0.000000 0.000000 240: 0 0.000000 0.000000 241:sub sockport { 0 0.000000 0.000000 242: @_ == 1 or croak 'usage: $sock- 0 0.000000 0.000000 243: my($sock) = @_; 0 0.000000 0.000000 244: my $name = $sock->sockname; 0 0.000000 0.000000 245: $name ? (sockaddr_in($name))[0] : undef; 0 0.000000 0.000000 246:} 0 0.000000 0.000000 247: 0 0.000000 0.000000 248:sub sockhost { 0 0.000000 0.000000 249: @_ == 1 or croak 'usage: $sock- 0 0.000000 0.000000 250: my($sock) = @_; 0 0.000000 0.000000 251: my $addr = $sock->sockaddr; 0 0.000000 0.000000 252: $addr ? inet_ntoa($addr) : undef; 0 0.000000 0.000000 253:} 0 0.000000 0.000000 254: 351 0.000000 0.000000 255:sub peeraddr { 351 0.001307 0.000000 256: @_ == 1 or croak 'usage: $sock- 351 0.001066 0.000000 257: my($sock) = @_; 351 0.002158 0.010000 258: my $name = $sock->peername; 351 0.002022 0.000000 259: $name ? (sockaddr_in($name))[1] : undef; 0 0.000000 0.000000 260:} 0 0.000000 0.000000 261: 706 0.000000 0.000000 262:sub peerport { 706 0.002495 0.000000 263: @_ == 1 or croak 'usage: $sock- 706 0.002232 0.000000 264: my($sock) = @_; 706 0.004139 0.020000 265: my $name = $sock->peername; 706 0.003960 0.010000 266: $name ? (sockaddr_in($name))[0] : undef; 0 0.000000 0.000000 267:} 0 0.000000 0.000000 268: 351 0.000000 0.000000 269:sub peerhost { 351 0.001343 0.010000 270: @_ == 1 or croak 'usage: $sock- 351 0.001119 0.000000 271: my($sock) = @_; 351 0.002310 0.000000 272: my $addr = $sock->peeraddr; 351 0.005725 0.000000 273: $addr ? inet_ntoa($addr) : undef; 0 0.000000 0.000000 274:} 0 0.000000 0.000000 275: 1 0.000024 0.000000 276:1; 0 0.000000 0.000000 277: 0 0.000000 0.000000 278:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/IO/Socket/UNIX.pm Page 29 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:# IO::Socket::UNIX.pm 0 0.000000 0.000000 2:# 0 0.000000 0.000000 3:# Copyright (c) 1997-8 Graham Barr 0 0.000000 0.000000 4:# This program is free software; you can 0 0.000000 0.000000 5:# modify it under the same terms as Perl 0 0.000000 0.000000 6: 0 0.000000 0.000000 7:package IO::Socket::UNIX; 0 0.000000 0.000000 8: 3 0.000011 0.000000 9:use strict; 1 0.000004 0.000000 10:our(@ISA, $VERSION); 3 0.000011 0.000000 11:use IO::Socket; 3 0.000010 0.000000 12:use Socket; 3 0.000009 0.000000 13:use Carp; 0 0.000000 0.000000 14: 1 0.000007 0.000000 15:@ISA = qw(IO::Socket); 1 0.000004 0.000000 16:$VERSION = "1.21"; 1 0.000044 0.000000 17:$VERSION = eval $VERSION; 0 0.000000 0.000000 18: 1 0.000007 0.000000 19:IO::Socket::UNIX->register_domain( AF_UNIX ); 0 0.000000 0.000000 20: 0 0.000000 0.000000 21:sub new { 0 0.000000 0.000000 22: my $class = shift; 0 0.000000 0.000000 23: unshift(@_, "Peer") if @_ == 1; 0 0.000000 0.000000 24: return $class->SUPER::new(@_); 0 0.000000 0.000000 25:} 0 0.000000 0.000000 26: 0 0.000000 0.000000 27:sub configure { 0 0.000000 0.000000 28: my($sock,$arg) = @_; 0 0.000000 0.000000 29: my($bport,$cport); 0 0.000000 0.000000 30: 0 0.000000 0.000000 31: my $type = $arg->{Type} || SOCK_STREAM; 0 0.000000 0.000000 32: 0 0.000000 0.000000 33: $sock->socket(AF_UNIX, $type, 0) or 0 0.000000 0.000000 34: return undef; 0 0.000000 0.000000 35: 0 0.000000 0.000000 36: if(exists $arg->{Local}) { 0 0.000000 0.000000 37: my $addr = sockaddr_un($arg->{Local}); 0 0.000000 0.000000 38: $sock->bind($addr) or 0 0.000000 0.000000 39: return undef; 0 0.000000 0.000000 40: } 0 0.000000 0.000000 41: if(exists $arg->{Listen} && $type != 0 0.000000 0.000000 42: $sock->listen($arg->{Listen} || 5) or 0 0.000000 0.000000 43: return undef; 0 0.000000 0.000000 44: } 0 0.000000 0.000000 45: elsif(exists $arg->{Peer}) { 0 0.000000 0.000000 46: my $addr = sockaddr_un($arg->{Peer}); 0 0.000000 0.000000 47: $sock->connect($addr) or 0 0.000000 0.000000 48: return undef; 0 0.000000 0.000000 49: } 0 0.000000 0.000000 50: 0 0.000000 0.000000 51: $sock; 0 0.000000 0.000000 52:} 0 0.000000 0.000000 53: 0 0.000000 0.000000 54:sub hostpath { 0 0.000000 0.000000 55: @_ == 1 or croak 'usage: $sock- 0 0.000000 0.000000 56: my $n = $_[0]->sockname || return undef; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/IO/Socket/UNIX.pm Page 30 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: (sockaddr_un($n))[0]; 0 0.000000 0.000000 58:} 0 0.000000 0.000000 59: 0 0.000000 0.000000 60:sub peerpath { 0 0.000000 0.000000 61: @_ == 1 or croak 'usage: $sock- 0 0.000000 0.000000 62: my $n = $_[0]->peername || return undef; 0 0.000000 0.000000 63: (sockaddr_un($n))[0]; 0 0.000000 0.000000 64:} 0 0.000000 0.000000 65: 1 0.000017 0.000000 66:1; # Keep require happy 0 0.000000 0.000000 67: 0 0.000000 0.000000 68:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/SelectSaver.pm Page 31 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package SelectSaver; 0 0.000000 0.000000 2: 1 0.000004 0.000000 3:our $VERSION = '1.00'; 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:=head1 NAME 0 0.000000 0.000000 6: 0 0.000000 0.000000 7: 0 0.000000 0.000000 8: 0 0.000000 0.000000 9: 0 0.000000 0.000000 10: 0 0.000000 0.000000 11: 0 0.000000 0.000000 12: 0 0.000000 0.000000 13: 0 0.000000 0.000000 14: 0 0.000000 0.000000 15: 0 0.000000 0.000000 16: 0 0.000000 0.000000 17: 0 0.000000 0.000000 18: 0 0.000000 0.000000 19: 0 0.000000 0.000000 20: 0 0.000000 0.000000 21: 0 0.000000 0.000000 22: 0 0.000000 0.000000 23: 0 0.000000 0.000000 24: 0 0.000000 0.000000 25: 0 0.000000 0.000000 26: 0 0.000000 0.000000 27: 0 0.000000 0.000000 28: 0 0.000000 0.000000 29: 0 0.000000 0.000000 30: 0 0.000000 0.000000 31: 0 0.000000 0.000000 32: 0 0.000000 0.000000 33: 0 0.000000 0.000000 34: 0 0.000000 0.000000 35: 0 0.000000 0.000000 36: 1 0.000002 0.000000 37:require 5.000; 3 0.000012 0.000000 38:use Carp; 3 0.000014 0.000000 39:use Symbol; 0 0.000000 0.000000 40: 387 0.000000 0.000000 41:sub new { 387 0.001862 0.000000 42: @_ >= 1 && @_ <= 2 or croak 'usage: new 387 0.002083 0.000000 43: my $fh = select; 387 0.002728 0.000000 44: my $self = bless [$fh], $_[0]; 387 0.001887 0.010000 45: select qualify($_[1], caller) if @_ > 1; 387 0.002276 0.000000 46: $self; 0 0.000000 0.000000 47:} 0 0.000000 0.000000 48: 387 0.000000 0.000000 49:sub DESTROY { 387 0.001210 0.020000 50: my $this = $_[0]; 387 0.003807 0.010000 51: select $$this[0]; 0 0.000000 0.000000 52:} 0 0.000000 0.000000 53: 1 0.000014 0.000000 54:1; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/Symbol.pm Page 32 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package Symbol; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:=head1 NAME 0 0.000000 0.000000 4: 0 0.000000 0.000000 5: 0 0.000000 0.000000 6: 0 0.000000 0.000000 7: 0 0.000000 0.000000 8: 0 0.000000 0.000000 9: 0 0.000000 0.000000 10: 0 0.000000 0.000000 11: 0 0.000000 0.000000 12: 0 0.000000 0.000000 13: 0 0.000000 0.000000 14: 0 0.000000 0.000000 15: 0 0.000000 0.000000 16: 0 0.000000 0.000000 17: 0 0.000000 0.000000 18: 0 0.000000 0.000000 19: 0 0.000000 0.000000 20: 0 0.000000 0.000000 21: 0 0.000000 0.000000 22: 0 0.000000 0.000000 23: 0 0.000000 0.000000 24: 0 0.000000 0.000000 25: 0 0.000000 0.000000 26: 0 0.000000 0.000000 27: 0 0.000000 0.000000 28: 0 0.000000 0.000000 29: 0 0.000000 0.000000 30: 0 0.000000 0.000000 31: 0 0.000000 0.000000 32: 0 0.000000 0.000000 33: 0 0.000000 0.000000 34: 0 0.000000 0.000000 35: 0 0.000000 0.000000 36: 0 0.000000 0.000000 37: 0 0.000000 0.000000 38: 0 0.000000 0.000000 39: 0 0.000000 0.000000 40: 0 0.000000 0.000000 41: 0 0.000000 0.000000 42: 0 0.000000 0.000000 43: 0 0.000000 0.000000 44: 0 0.000000 0.000000 45: 0 0.000000 0.000000 46: 0 0.000000 0.000000 47: 0 0.000000 0.000000 48: 0 0.000000 0.000000 49: 0 0.000000 0.000000 50: 0 0.000000 0.000000 51: 0 0.000000 0.000000 52: 0 0.000000 0.000000 53: 0 0.000000 0.000000 54: 0 0.000000 0.000000 55: 0 0.000000 0.000000 56: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/Symbol.pm Page 33 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: 0 0.000000 0.000000 58: 0 0.000000 0.000000 59: 0 0.000000 0.000000 60: 0 0.000000 0.000000 61: 0 0.000000 0.000000 62: 0 0.000000 0.000000 63: 0 0.000000 0.000000 64: 0 0.000000 0.000000 65: 0 0.000000 0.000000 66: 0 0.000000 0.000000 67: 0 0.000000 0.000000 68: 0 0.000000 0.000000 69: 0 0.000000 0.000000 70: 0 0.000000 0.000000 71: 0 0.000000 0.000000 72: 0 0.000000 0.000000 73: 0 0.000000 0.000000 74: 0 0.000000 0.000000 75: 0 0.000000 0.000000 76: 0 0.000000 0.000000 77: 0 0.000000 0.000000 78: 0 0.000000 0.000000 79: 0 0.000000 0.000000 80: 0 0.000000 0.000000 81: 1 0.001255 0.000000 82:BEGIN { require 5.005; } 0 0.000000 0.000000 83: 1 0.000005 0.000000 84:require Exporter; 1 0.000007 0.000000 85:@ISA = qw(Exporter); 1 0.000005 0.000000 86:@EXPORT = qw(gensym ungensym qualify 1 0.000004 0.000000 87:@EXPORT_OK = qw(delete_package geniosym); 0 0.000000 0.000000 88: 1 0.000003 0.000000 89:$VERSION = '1.05'; 0 0.000000 0.000000 90: 1 0.000003 0.000000 91:my $genpkg = "Symbol::"; 1 0.000002 0.000000 92:my $genseq = 0; 0 0.000000 0.000000 93: 9 0.000040 0.000000 94:my %global = map {$_ => 1} qw(ARGV ARGVOUT 0 0.000000 0.000000 95: 0 0.000000 0.000000 96:# 0 0.000000 0.000000 97:# Note that we never _copy_ the glob; we just 0 0.000000 0.000000 98:# If we did copy it, then SVf_FAKE would be 0 0.000000 0.000000 99:# glob-specific behaviors (e.g. C<*$ref = 0 0.000000 0.000000 100:# 387 0.000000 0.000000 101:sub gensym () { 387 0.002050 0.010000 102: my $name = "GEN" . $genseq++; 774 0.004732 0.000000 103: my $ref = \*{$genpkg . $name}; 387 0.002102 0.000000 104: delete $$genpkg{$name}; 387 0.001991 0.000000 105: $ref; 0 0.000000 0.000000 106:} 0 0.000000 0.000000 107: 0 0.000000 0.000000 108:sub geniosym () { 0 0.000000 0.000000 109: my $sym = gensym(); 0 0.000000 0.000000 110: # force the IO slot to be filled 0 0.000000 0.000000 111: select(select $sym); 0 0.000000 0.000000 112: *$sym{IO}; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/Symbol.pm Page 34 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113:} 0 0.000000 0.000000 114: 0 0.000000 0.000000 115:sub ungensym ($) {} 0 0.000000 0.000000 116: 774 0.000000 0.000000 117:sub qualify ($;$) { 774 0.002889 0.010000 118: my ($name) = @_; 774 0.002655 0.000000 119: if (!ref($name) && index($name, '::') == 0 0.000000 0.000000 120: my $pkg; 0 0.000000 0.000000 121: # Global names: special character, "^xyz", 0 0.000000 0.000000 122: if ($name =~ /^(([^a-z])|(\^[a-z_]+))\z/i || 0 0.000000 0.000000 123: # RGS 2001-11-05 : translate leading ^X 0 0.000000 0.000000 124: $name =~ s/^\^([a- 0 0.000000 0.000000 125: $pkg = "main"; 0 0.000000 0.000000 126: } 0 0.000000 0.000000 127: else { 0 0.000000 0.000000 128: $pkg = (@_ > 1) ? $_[1] : caller; 0 0.000000 0.000000 129: } 0 0.000000 0.000000 130: $name = $pkg . "::" . $name; 0 0.000000 0.000000 131: } 774 0.007856 0.000000 132: $name; 0 0.000000 0.000000 133:} 0 0.000000 0.000000 134: 0 0.000000 0.000000 135:sub qualify_to_ref ($;$) { 0 0.000000 0.000000 136: return \*{ qualify $_[0], @_ > 1 ? $_[1] 0 0.000000 0.000000 137:} 0 0.000000 0.000000 138: 0 0.000000 0.000000 139:# 0 0.000000 0.000000 140:# of Safe.pm lineage 0 0.000000 0.000000 141:# 0 0.000000 0.000000 142:sub delete_package ($) { 0 0.000000 0.000000 143: my $pkg = shift; 0 0.000000 0.000000 144: 0 0.000000 0.000000 145: # expand to full symbol table name if 0 0.000000 0.000000 146: 0 0.000000 0.000000 147: unless ($pkg =~ /^main::.*::$/) { 0 0.000000 0.000000 148: $pkg = "main$pkg" if $pkg =~ /^::/; 0 0.000000 0.000000 149: $pkg = "main::$pkg" unless $pkg =~ 0 0.000000 0.000000 150: $pkg .= '::' unless $pkg =~ /::$/; 0 0.000000 0.000000 151: } 0 0.000000 0.000000 152: 0 0.000000 0.000000 153: my($stem, $leaf) = $pkg =~ 0 0.000000 0.000000 154: my $stem_symtab = *{$stem}{HASH}; 0 0.000000 0.000000 155: return unless defined $stem_symtab and 0 0.000000 0.000000 156: 0 0.000000 0.000000 157: 0 0.000000 0.000000 158: # free all the symbols in the package 0 0.000000 0.000000 159: 0 0.000000 0.000000 160: my $leaf_symtab = *{$stem_symtab- 0 0.000000 0.000000 161: foreach my $name (keys %$leaf_symtab) { 0 0.000000 0.000000 162: undef *{$pkg . $name}; 0 0.000000 0.000000 163: } 0 0.000000 0.000000 164: 0 0.000000 0.000000 165: # delete the symbol table 0 0.000000 0.000000 166: 0 0.000000 0.000000 167: %$leaf_symtab = (); 0 0.000000 0.000000 168: delete $stem_symtab->{$leaf}; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/Symbol.pm Page 35 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169:} 0 0.000000 0.000000 170: 1 0.000022 0.000000 171:1; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/Time/Local.pm Page 36 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package Time::Local; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:require Exporter; 0 0.000000 0.000000 4:use Carp; 0 0.000000 0.000000 5:use Config; 0 0.000000 0.000000 6:use strict; 0 0.000000 0.000000 7:use integer; 0 0.000000 0.000000 8: 0 0.000000 0.000000 9:use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK 0 0.000000 0.000000 10:$VERSION = '1.10'; 0 0.000000 0.000000 11:$VERSION = eval $VERSION; 0 0.000000 0.000000 12:@ISA = qw( Exporter ); 0 0.000000 0.000000 13:@EXPORT = qw( timegm timelocal ); 0 0.000000 0.000000 14:@EXPORT_OK = qw( timegm_nocheck 0 0.000000 0.000000 15: 0 0.000000 0.000000 16:my @MonthDays = (31, 28, 31, 30, 31, 30, 31, 0 0.000000 0.000000 17: 0 0.000000 0.000000 18:# Determine breakpoint for rolling century 0 0.000000 0.000000 19:my $ThisYear = (localtime())[5]; 0 0.000000 0.000000 20:my $Breakpoint = ($ThisYear + 50) % 100; 0 0.000000 0.000000 21:my $NextCentury = $ThisYear - $ThisYear % 0 0.000000 0.000000 22: $NextCentury += 100 if $Breakpoint < 50; 0 0.000000 0.000000 23:my $Century = $NextCentury - 100; 0 0.000000 0.000000 24:my $SecOff = 0; 0 0.000000 0.000000 25: 0 0.000000 0.000000 26:my (%Options, %Cheat, %Min, %Max); 0 0.000000 0.000000 27:my ($MinInt, $MaxInt); 0 0.000000 0.000000 28: 0 0.000000 0.000000 29:if ($^O eq 'MacOS') { 0 0.000000 0.000000 30: # time_t is unsigned... 0 0.000000 0.000000 31: $MaxInt = (1 << (8 * $Config{intsize})) - 0 0.000000 0.000000 32: $MinInt = 0; 0 0.000000 0.000000 33:} else { 0 0.000000 0.000000 34: $MaxInt = ((1 << (8 * $Config{intsize} - 0 0.000000 0.000000 35: $MinInt = -$MaxInt - 1; 0 0.000000 0.000000 36:} 0 0.000000 0.000000 37: 0 0.000000 0.000000 38:$Max{Day} = ($MaxInt >> 1) / 43200; 0 0.000000 0.000000 39:$Min{Day} = ($MinInt)? -($Max{Day}+1) : 0; 0 0.000000 0.000000 40: 0 0.000000 0.000000 41:$Max{Sec} = $MaxInt - 86400 * $Max{Day}; 0 0.000000 0.000000 42:$Min{Sec} = $MinInt - 86400 * $Min{Day}; 0 0.000000 0.000000 43: 0 0.000000 0.000000 44:# Determine the EPOC day for this machine 0 0.000000 0.000000 45:my $Epoc = 0; 0 0.000000 0.000000 46:if ($^O eq 'vos') { 0 0.000000 0.000000 47:# work around posix-977 -- VOS doesn't handle 0 0.000000 0.000000 48:# the range 1970-1980. 0 0.000000 0.000000 49: $Epoc = _daygm((0, 0, 0, 1, 0, 70, 4, 0)); 0 0.000000 0.000000 50:} 0 0.000000 0.000000 51:elsif ($^O eq 'MacOS') { 0 0.000000 0.000000 52: no integer; 0 0.000000 0.000000 53: 0 0.000000 0.000000 54: # MacOS time() is seconds since 1 Jan 1904, 0 0.000000 0.000000 55: # so we need to calculate an offset to 0 0.000000 0.000000 56: $Epoc = 693901; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/Time/Local.pm Page 37 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: $SecOff = timelocal(localtime(0)) - 0 0.000000 0.000000 58: $Epoc += _daygm(gmtime(0)); 0 0.000000 0.000000 59:} 0 0.000000 0.000000 60:else { 0 0.000000 0.000000 61: $Epoc = _daygm(gmtime(0)); 0 0.000000 0.000000 62:} 0 0.000000 0.000000 63: 0 0.000000 0.000000 64:%Cheat=(); # clear the cache as epoc has 0 0.000000 0.000000 65: 1 0.000000 0.000000 66:sub _daygm { 0 0.000000 0.000000 67: $_[3] + ($Cheat{pack("ss",@_[4,5])} ||= 0 0.000000 0.000000 68: my $month = ($_[4] + 10) % 12; 0 0.000000 0.000000 69: my $year = $_[5] + 1900 - $month/10; 0 0.000000 0.000000 70: 365*$year + $year/4 - $year/100 + $year/400 0 0.000000 0.000000 71: }); 0 0.000000 0.000000 72:} 0 0.000000 0.000000 73: 0 0.000000 0.000000 74: 0 0.000000 0.000000 75:sub _timegm { 0 0.000000 0.000000 76: my $sec = $SecOff + $_[0] + 60 * $_[1] 0 0.000000 0.000000 77: 0 0.000000 0.000000 78: no integer; 0 0.000000 0.000000 79: 0 0.000000 0.000000 80: $sec + 86400 * &_daygm; 0 0.000000 0.000000 81:} 0 0.000000 0.000000 82: 0 0.000000 0.000000 83: 0 0.000000 0.000000 84:sub _zoneadjust { 0 0.000000 0.000000 85: my ($day, $sec, $time) = @_; 0 0.000000 0.000000 86: 0 0.000000 0.000000 87: $sec = $sec + _timegm(localtime($time)) - 0 0.000000 0.000000 88: if ($sec >= 86400) { $day++; $sec -= 0 0.000000 0.000000 89: if ($sec < 0) { $day--; $sec += 0 0.000000 0.000000 90: 0 0.000000 0.000000 91: ($day, $sec); 0 0.000000 0.000000 92:} 0 0.000000 0.000000 93: 0 0.000000 0.000000 94: 0 0.000000 0.000000 95:sub timegm { 0 0.000000 0.000000 96: my ($sec,$min,$hour,$mday,$month,$year) = 0 0.000000 0.000000 97: 0 0.000000 0.000000 98: if ($year >= 1000) { 0 0.000000 0.000000 99: $year -= 1900; 0 0.000000 0.000000 100: } 0 0.000000 0.000000 101: elsif ($year < 100 and $year >= 0) { 0 0.000000 0.000000 102: $year += ($year > $Breakpoint) ? $Century : 0 0.000000 0.000000 103: } 0 0.000000 0.000000 104: 0 0.000000 0.000000 105: unless ($Options{no_range_check}) { 0 0.000000 0.000000 106: if (abs($year) >= 0x7fff) { 0 0.000000 0.000000 107: $year += 1900; 0 0.000000 0.000000 108: croak "Cannot handle date ($sec, $min, 0 0.000000 0.000000 109: } 0 0.000000 0.000000 110: 0 0.000000 0.000000 111: croak "Month '$month' out of range 0..11" if 0 0.000000 0.000000 112: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/Time/Local.pm Page 38 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113: my $md = $MonthDays[$month]; 0 0.000000 0.000000 114: ++$md unless $month != 1 or $year % 4 or 0 0.000000 0.000000 115: 0 0.000000 0.000000 116: croak "Day '$mday' out of range 1..$md" if 0 0.000000 0.000000 117: croak "Hour '$hour' out of range 0..23" if 0 0.000000 0.000000 118: croak "Minute '$min' out of range 0..59" if 0 0.000000 0.000000 119: croak "Second '$sec' out of range 0..59" if 0 0.000000 0.000000 120: } 0 0.000000 0.000000 121: 0 0.000000 0.000000 122: my $days = _daygm(undef, undef, undef, 0 0.000000 0.000000 123: my $xsec = $sec + $SecOff + 60*$min + 0 0.000000 0.000000 124: 0 0.000000 0.000000 125: unless ($Options{no_range_check} 0 0.000000 0.000000 126: or ($days > $Min{Day} or $days == 0 0.000000 0.000000 127: and ($days < $Max{Day} or $days == 0 0.000000 0.000000 128: { 0 0.000000 0.000000 129: warn "Day too small - $days > 0 0.000000 0.000000 130: warn "Day too big - $days > 0 0.000000 0.000000 131: warn "Sec too small - $days < 0 0.000000 0.000000 132: warn "Sec too big - $days > 0 0.000000 0.000000 133: $year += 1900; 0 0.000000 0.000000 134: croak "Cannot handle date ($sec, $min, 0 0.000000 0.000000 135: } 0 0.000000 0.000000 136: 0 0.000000 0.000000 137: no integer; 0 0.000000 0.000000 138: 0 0.000000 0.000000 139: $xsec + 86400 * $days; 0 0.000000 0.000000 140:} 0 0.000000 0.000000 141: 0 0.000000 0.000000 142: 0 0.000000 0.000000 143:sub timegm_nocheck { 0 0.000000 0.000000 144: local $Options{no_range_check} = 1; 0 0.000000 0.000000 145: &timegm; 0 0.000000 0.000000 146:} 0 0.000000 0.000000 147: 0 0.000000 0.000000 148: 0 0.000000 0.000000 149:sub timelocal { 0 0.000000 0.000000 150: # Adjust Max/Min allowed times to fit 0 0.000000 0.000000 151: local ($Max{Day}, $Max{Sec}) = 0 0.000000 0.000000 152: local ($Min{Day}, $Min{Sec}) = 0 0.000000 0.000000 153: my $ref_t = &timegm; 0 0.000000 0.000000 154: 0 0.000000 0.000000 155: # Calculate first guess with a one-day 0 0.000000 0.000000 156: my $delta = ($_[5] < 100)? 86400 : - 0 0.000000 0.000000 157: my $loc_t = _timegm(localtime( $ref_t + 0 0.000000 0.000000 158: 0 0.000000 0.000000 159: # Is there a timezone offset from GMT or 0 0.000000 0.000000 160: my $zone_off = $ref_t - $loc_t 0 0.000000 0.000000 161: or return $loc_t; 0 0.000000 0.000000 162: 0 0.000000 0.000000 163: # This hack is needed to always pick the 0 0.000000 0.000000 164: # during a DST change when time would 0 0.000000 0.000000 165: $zone_off -= 3600 if ($delta > 0 && 0 0.000000 0.000000 166: 0 0.000000 0.000000 167: # Adjust for timezone 0 0.000000 0.000000 168: $loc_t = $ref_t + $zone_off; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/Time/Local.pm Page 39 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169: 0 0.000000 0.000000 170: # Are we close to a DST change or are we 0 0.000000 0.000000 171: my $dst_off = $ref_t - 0 0.000000 0.000000 172: or return $loc_t; 0 0.000000 0.000000 173: 0 0.000000 0.000000 174: # Adjust for DST change 0 0.000000 0.000000 175: $loc_t += $dst_off; 0 0.000000 0.000000 176: 0 0.000000 0.000000 177: return $loc_t if $dst_off >= 0; 0 0.000000 0.000000 178: 0 0.000000 0.000000 179: # for a negative offset from GMT, and if 0 0.000000 0.000000 180: # was a non-extent gap in a forward DST 0 0.000000 0.000000 181: # now have the wrong answer - undo the 0 0.000000 0.000000 182: 0 0.000000 0.000000 183: my ($s,$m,$h) = localtime($loc_t); 0 0.000000 0.000000 184: $loc_t -= $dst_off if $s != $_[0] || $m 0 0.000000 0.000000 185: 0 0.000000 0.000000 186: $loc_t; 0 0.000000 0.000000 187:} 0 0.000000 0.000000 188: 0 0.000000 0.000000 189: 0 0.000000 0.000000 190:sub timelocal_nocheck { 0 0.000000 0.000000 191: local $Options{no_range_check} = 1; 0 0.000000 0.000000 192: &timelocal; 0 0.000000 0.000000 193:} 0 0.000000 0.000000 194: 0 0.000000 0.000000 195:1; 0 0.000000 0.000000 196: 0 0.000000 0.000000 197:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/integer.pm Page 40 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package integer; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:our $VERSION = '1.00'; 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:=head1 NAME 0 0.000000 0.000000 6: 0 0.000000 0.000000 7: 0 0.000000 0.000000 8: 0 0.000000 0.000000 9: 0 0.000000 0.000000 10: 0 0.000000 0.000000 11: 0 0.000000 0.000000 12: 0 0.000000 0.000000 13: 0 0.000000 0.000000 14: 0 0.000000 0.000000 15: 0 0.000000 0.000000 16: 0 0.000000 0.000000 17: 0 0.000000 0.000000 18: 0 0.000000 0.000000 19: 0 0.000000 0.000000 20: 0 0.000000 0.000000 21: 0 0.000000 0.000000 22: 0 0.000000 0.000000 23: 0 0.000000 0.000000 24: 0 0.000000 0.000000 25: 0 0.000000 0.000000 26: 0 0.000000 0.000000 27: 0 0.000000 0.000000 28: 0 0.000000 0.000000 29: 0 0.000000 0.000000 30: 0 0.000000 0.000000 31: 0 0.000000 0.000000 32: 0 0.000000 0.000000 33: 0 0.000000 0.000000 34: 0 0.000000 0.000000 35: 0 0.000000 0.000000 36: 0 0.000000 0.000000 37: 0 0.000000 0.000000 38: 0 0.000000 0.000000 39: 0 0.000000 0.000000 40: 0 0.000000 0.000000 41: 0 0.000000 0.000000 42: 0 0.000000 0.000000 43: 0 0.000000 0.000000 44: 0 0.000000 0.000000 45: 0 0.000000 0.000000 46: 0 0.000000 0.000000 47: 0 0.000000 0.000000 48: 0 0.000000 0.000000 49: 0 0.000000 0.000000 50: 0 0.000000 0.000000 51: 0 0.000000 0.000000 52: 0 0.000000 0.000000 53: 0 0.000000 0.000000 54: 0 0.000000 0.000000 55: 0 0.000000 0.000000 56: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/integer.pm Page 41 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: 0 0.000000 0.000000 58: 0 0.000000 0.000000 59: 0 0.000000 0.000000 60: 0 0.000000 0.000000 61: 0 0.000000 0.000000 62: 0 0.000000 0.000000 63: 0 0.000000 0.000000 64: 0 0.000000 0.000000 65: 0 0.000000 0.000000 66: 0 0.000000 0.000000 67: 0 0.000000 0.000000 68: 0 0.000000 0.000000 69: 0 0.000000 0.000000 70: 0 0.000000 0.000000 71: 0 0.000000 0.000000 72: 0 0.000000 0.000000 73: 0 0.000000 0.000000 74: 0 0.000000 0.000000 75: 0 0.000000 0.000000 76: 0 0.000000 0.000000 77: 0 0.000000 0.000000 78: 0 0.000000 0.000000 79: 0 0.000000 0.000000 80: 0 0.000000 0.000000 81: 0 0.000000 0.000000 82: 0 0.000000 0.000000 83:$integer::hint_bits = 0x1; 0 0.000000 0.000000 84: 1 0.000000 0.000000 85:sub import { 0 0.000000 0.000000 86: $^H |= $integer::hint_bits; 0 0.000000 0.000000 87:} 0 0.000000 0.000000 88: 3 0.000000 0.000000 89:sub unimport { 0 0.000000 0.000000 90: $^H &= ~$integer::hint_bits; 0 0.000000 0.000000 91:} 0 0.000000 0.000000 92: 0 0.000000 0.000000 93:1; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/overload.pm Page 42 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package overload; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:our $VERSION = '1.01'; 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:$overload::hint_bits = 0x20000; # 0 0.000000 0.000000 6: 0 0.000000 0.000000 7:sub nil {} 0 0.000000 0.000000 8: 1 0.000000 0.000000 9:sub OVERLOAD { 0 0.000000 0.000000 10: $package = shift; 0 0.000000 0.000000 11: my %arg = @_; 0 0.000000 0.000000 12: my ($sub, $fb); 0 0.000000 0.000000 13: $ {$package . "::OVERLOAD"}{dummy}++; # 0 0.000000 0.000000 14: *{$package . "::()"} = \&nil; # Make it 0 0.000000 0.000000 15: for (keys %arg) { 0 0.000000 0.000000 16: if ($_ eq 'fallback') { 0 0.000000 0.000000 17: $fb = $arg{$_}; 0 0.000000 0.000000 18: } else { 0 0.000000 0.000000 19: $sub = $arg{$_}; 0 0.000000 0.000000 20: if (not ref $sub and $sub !~ /::/) { 0 0.000000 0.000000 21: $ {$package . "::(" . $_} = $sub; 0 0.000000 0.000000 22: $sub = \&nil; 0 0.000000 0.000000 23: } 0 0.000000 0.000000 24: #print STDERR "Setting `$ 0 0.000000 0.000000 25: *{$package . "::(" . $_} = \&{ $sub }; 0 0.000000 0.000000 26: } 0 0.000000 0.000000 27: } 0 0.000000 0.000000 28: ${$package . "::()"} = $fb; # Make it 0 0.000000 0.000000 29:} 0 0.000000 0.000000 30: 1 0.000000 0.000000 31:sub import { 0 0.000000 0.000000 32: $package = (caller())[0]; 0 0.000000 0.000000 33: # *{$package . "::OVERLOAD"} = \&OVERLOAD; 0 0.000000 0.000000 34: shift; 0 0.000000 0.000000 35: $package->overload::OVERLOAD(@_); 0 0.000000 0.000000 36:} 0 0.000000 0.000000 37: 0 0.000000 0.000000 38:sub unimport { 0 0.000000 0.000000 39: $package = (caller())[0]; 0 0.000000 0.000000 40: ${$package . "::OVERLOAD"}{dummy}++; # 0 0.000000 0.000000 41: shift; 0 0.000000 0.000000 42: for (@_) { 0 0.000000 0.000000 43: if ($_ eq 'fallback') { 0 0.000000 0.000000 44: undef $ {$package . "::()"}; 0 0.000000 0.000000 45: } else { 0 0.000000 0.000000 46: delete $ {$package . "::"}{"(" . $_}; 0 0.000000 0.000000 47: } 0 0.000000 0.000000 48: } 0 0.000000 0.000000 49:} 0 0.000000 0.000000 50: 0 0.000000 0.000000 51:sub Overloaded { 0 0.000000 0.000000 52: my $package = shift; 0 0.000000 0.000000 53: $package = ref $package if ref $package; 0 0.000000 0.000000 54: $package->can('()'); 0 0.000000 0.000000 55:} 0 0.000000 0.000000 56: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/overload.pm Page 43 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57:sub ov_method { 0 0.000000 0.000000 58: my $globref = shift; 0 0.000000 0.000000 59: return undef unless $globref; 0 0.000000 0.000000 60: my $sub = \&{*$globref}; 0 0.000000 0.000000 61: return $sub if $sub ne \&nil; 0 0.000000 0.000000 62: return shift->can($ {*$globref}); 0 0.000000 0.000000 63:} 0 0.000000 0.000000 64: 0 0.000000 0.000000 65:sub OverloadedStringify { 0 0.000000 0.000000 66: my $package = shift; 0 0.000000 0.000000 67: $package = ref $package if ref $package; 0 0.000000 0.000000 68: #$package->can('(""') 0 0.000000 0.000000 69: ov_method mycan($package, '(""'), $package 0 0.000000 0.000000 70: or ov_method mycan($package, '(0+'), 0 0.000000 0.000000 71: or ov_method mycan($package, '(bool'), 0 0.000000 0.000000 72: or ov_method mycan($package, 0 0.000000 0.000000 73:} 0 0.000000 0.000000 74: 0 0.000000 0.000000 75:sub Method { 0 0.000000 0.000000 76: my $package = shift; 0 0.000000 0.000000 77: $package = ref $package if ref $package; 0 0.000000 0.000000 78: #my $meth = $package->can('(' . shift); 0 0.000000 0.000000 79: ov_method mycan($package, '(' . shift), 0 0.000000 0.000000 80: #return $meth if $meth ne \&nil; 0 0.000000 0.000000 81: #return $ {*{$meth}}; 0 0.000000 0.000000 82:} 0 0.000000 0.000000 83: 0 0.000000 0.000000 84:sub AddrRef { 0 0.000000 0.000000 85: my $package = ref $_[0]; 0 0.000000 0.000000 86: return "$_[0]" unless $package; 0 0.000000 0.000000 87: 0 0.000000 0.000000 88: require Scalar::Util; 0 0.000000 0.000000 89: my $class = Scalar::Util::blessed($_[0]); 0 0.000000 0.000000 90: my $class_prefix = defined($class) ? 0 0.000000 0.000000 91: my $type = Scalar::Util::reftype($_[0]); 0 0.000000 0.000000 92: my $addr = Scalar::Util::refaddr($_[0]); 0 0.000000 0.000000 93: return sprintf("$class_prefix$type(0x%x)", 0 0.000000 0.000000 94:} 0 0.000000 0.000000 95: 0 0.000000 0.000000 96:sub StrVal { 0 0.000000 0.000000 97: (ref $_[0] && OverloadedStringify($_[0]) or 0 0.000000 0.000000 98: (AddrRef(shift)) : 0 0.000000 0.000000 99: "$_[0]"; 0 0.000000 0.000000 100:} 0 0.000000 0.000000 101: 0 0.000000 0.000000 102:sub mycan { # Real can would leave stubs. 0 0.000000 0.000000 103: my ($package, $meth) = @_; 0 0.000000 0.000000 104: return \*{$package . "::$meth"} if defined 0 0.000000 0.000000 105: my $p; 0 0.000000 0.000000 106: foreach $p (@{$package . "::ISA"}) { 0 0.000000 0.000000 107: my $out = mycan($p, $meth); 0 0.000000 0.000000 108: return $out if $out; 0 0.000000 0.000000 109: } 0 0.000000 0.000000 110: return undef; 0 0.000000 0.000000 111:} 0 0.000000 0.000000 112: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/overload.pm Page 44 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113:%constants = ( 0 0.000000 0.000000 114: 'integer' => 0x1000, # 0 0.000000 0.000000 115: 'float' => 0x2000, # HINT_NEW_FLOAT 0 0.000000 0.000000 116: 'binary' => 0x4000, # 0 0.000000 0.000000 117: 'q' => 0x8000, # HINT_NEW_STRING 0 0.000000 0.000000 118: 'qr' => 0x10000, # HINT_NEW_RE 0 0.000000 0.000000 119: ); 0 0.000000 0.000000 120: 0 0.000000 0.000000 121:%ops = ( with_assign => "+ - * / % ** << >> 0 0.000000 0.000000 122: assign => "+= -= *= /= %= **= <<= >>= x= 0 0.000000 0.000000 123: num_comparison => "< <= > >= == !=", 0 0.000000 0.000000 124: '3way_comparison'=> "<=> cmp", 0 0.000000 0.000000 125: str_comparison => "lt le gt ge eq ne", 0 0.000000 0.000000 126: binary => "& | ^", 0 0.000000 0.000000 127: unary => "neg ! ~", 0 0.000000 0.000000 128: mutators => '++ --', 0 0.000000 0.000000 129: func => "atan2 cos sin exp abs log sqrt 0 0.000000 0.000000 130: conversion => 'bool "" 0+', 0 0.000000 0.000000 131: iterators => '<>', 0 0.000000 0.000000 132: dereferencing => '${} @{} %{} &{} *{}', 0 0.000000 0.000000 133: special => 'nomethod fallback ='); 0 0.000000 0.000000 134: 0 0.000000 0.000000 135:use warnings::register; 0 0.000000 0.000000 136:sub constant { 0 0.000000 0.000000 137: # Arguments: what, sub 0 0.000000 0.000000 138: while (@_) { 0 0.000000 0.000000 139: if (@_ == 1) { 0 0.000000 0.000000 140: warnings::warnif ("Odd number of 0 0.000000 0.000000 141: last; 0 0.000000 0.000000 142: } 0 0.000000 0.000000 143: elsif (!exists $constants {$_ [0]}) { 0 0.000000 0.000000 144: warnings::warnif ("`$_[0]' is not an 0 0.000000 0.000000 145: } 0 0.000000 0.000000 146: elsif (!ref $_ [1] || "$_[1]" !~ 0 0.000000 0.000000 147: # Can't use C 0 0.000000 0.000000 148: # blessed, and C would return 0 0.000000 0.000000 149: if (warnings::enabled) { 0 0.000000 0.000000 150: $_ [1] = "undef" unless defined 0 0.000000 0.000000 151: warnings::warn ("`$_[1]' is not a 0 0.000000 0.000000 152: } 0 0.000000 0.000000 153: } 0 0.000000 0.000000 154: else { 0 0.000000 0.000000 155: $^H{$_[0]} = $_[1]; 0 0.000000 0.000000 156: $^H |= $constants{$_[0]} | 0 0.000000 0.000000 157: } 0 0.000000 0.000000 158: shift, shift; 0 0.000000 0.000000 159: } 0 0.000000 0.000000 160:} 0 0.000000 0.000000 161: 0 0.000000 0.000000 162:sub remove_constant { 0 0.000000 0.000000 163: # Arguments: what, sub 0 0.000000 0.000000 164: while (@_) { 0 0.000000 0.000000 165: delete $^H{$_[0]}; 0 0.000000 0.000000 166: $^H &= ~ $constants{$_[0]}; 0 0.000000 0.000000 167: shift, shift; 0 0.000000 0.000000 168: } ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/overload.pm Page 45 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169:} 0 0.000000 0.000000 170: 0 0.000000 0.000000 171:1; 0 0.000000 0.000000 172: 0 0.000000 0.000000 173:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/strict.pm Page 46 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1: 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:$strict::VERSION = "1.03"; 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:my %bitmask = ( 0 0.000000 0.000000 6:refs => 0x00000002, 0 0.000000 0.000000 7:subs => 0x00000200, 0 0.000000 0.000000 8:vars => 0x00000400 0 0.000000 0.000000 9:); 0 0.000000 0.000000 10: 14 0.000000 0.000000 11:sub bits { 3 0.000009 0.000000 12: my $bits = 0; 3 0.000005 0.000000 13: my @wrong; 3 0.000011 0.000000 14: foreach my $s (@_) { 3 0.000011 0.000000 15: push @wrong, $s unless exists $bitmask{$s}; 3 0.000019 0.000000 16: $bits |= $bitmask{$s} || 0; 0 0.000000 0.000000 17: } 3 0.000006 0.000000 18: if (@wrong) { 0 0.000000 0.000000 19: require Carp; 0 0.000000 0.000000 20: Carp::croak("Unknown 'strict' tag(s) 0 0.000000 0.000000 21: } 3 0.000925 0.000000 22: $bits; 0 0.000000 0.000000 23:} 0 0.000000 0.000000 24: 0 0.000000 0.000000 25:my $default_bits = bits(qw(refs subs vars)); 0 0.000000 0.000000 26: 37 0.000000 0.000000 27:sub import { 19 0.000057 0.000000 28: shift; 19 0.000142 0.000000 29: $^H |= @_ ? bits(@_) : $default_bits; 0 0.000000 0.000000 30:} 0 0.000000 0.000000 31: 14 0.000000 0.000000 32:sub unimport { 3 0.000011 0.000000 33: shift; 3 0.000014 0.000000 34: $^H &= ~ (@_ ? bits(@_) : $default_bits); 0 0.000000 0.000000 35:} 0 0.000000 0.000000 36: 0 0.000000 0.000000 37:1; 0 0.000000 0.000000 38:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/vars.pm Page 47 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package vars; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:use 5.006; 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:our $VERSION = '1.01'; 0 0.000000 0.000000 6: 0 0.000000 0.000000 7:use warnings::register; 0 0.000000 0.000000 8:use strict qw(vars subs); 0 0.000000 0.000000 9: 22 0.000000 0.000000 10:sub import { 8 0.000038 0.000000 11: my $callpack = caller; 8 0.000048 0.000000 12: my ($pack, @imports) = @_; 8 0.000025 0.000000 13: my ($sym, $ch); 8 0.000037 0.000000 14: foreach (@imports) { 16 0.000143 0.000000 15: if (($ch, $sym) = 16 0.000065 0.000000 16: if ($sym =~ /\W/) { 0 0.000000 0.000000 17: # time for a more-detailed check-up 0 0.000000 0.000000 18: if ($sym =~ /^\w+[[{].*[]}]$/) { 0 0.000000 0.000000 19: require Carp; 0 0.000000 0.000000 20: Carp::croak("Can't declare individual 0 0.000000 0.000000 21: } elsif (warnings::enabled() and 0 0.000000 0.000000 22: warnings::warn("No need to declare 0 0.000000 0.000000 23: } elsif (($^H &= strict::bits('vars'))) { 0 0.000000 0.000000 24: require Carp; 0 0.000000 0.000000 25: Carp::croak("'$_' is not a valid 0 0.000000 0.000000 26: } 0 0.000000 0.000000 27: } 16 0.000082 0.000000 28: $sym = "${callpack}::$sym" unless $sym 0 0.000000 0.000000 29: *$sym = 0 0.000000 0.000000 30: ( $ch eq "\$" ? \$$sym 0 0.000000 0.000000 31: : $ch eq "\@" ? \@$sym 0 0.000000 0.000000 32: : $ch eq "\%" ? \%$sym 0 0.000000 0.000000 33: : $ch eq "\*" ? \*$sym 0 0.000000 0.000000 34: : $ch eq "\&" ? \&$sym 16 0.006813 0.010000 35: : do { 0 0.000000 0.000000 36: require Carp; 0 0.000000 0.000000 37: Carp::croak("'$_' is not a valid 0 0.000000 0.000000 38: }); 0 0.000000 0.000000 39: } else { 0 0.000000 0.000000 40: require Carp; 0 0.000000 0.000000 41: Carp::croak("'$_' is not a valid 0 0.000000 0.000000 42: } 0 0.000000 0.000000 43: } 0 0.000000 0.000000 44:}; 0 0.000000 0.000000 45: 0 0.000000 0.000000 46:1; 0 0.000000 0.000000 47:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/warnings.pm Page 48 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1: 0 0.000000 0.000000 2:# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! 0 0.000000 0.000000 3:# This file was created by warnings.pl 0 0.000000 0.000000 4:# Any changes made here will be lost. 0 0.000000 0.000000 5:# 0 0.000000 0.000000 6: 0 0.000000 0.000000 7:package warnings; 0 0.000000 0.000000 8: 0 0.000000 0.000000 9:our $VERSION = '1.03'; 0 0.000000 0.000000 10: 0 0.000000 0.000000 11:=head1 NAME 0 0.000000 0.000000 12: 0 0.000000 0.000000 13: 0 0.000000 0.000000 14: 0 0.000000 0.000000 15: 0 0.000000 0.000000 16: 0 0.000000 0.000000 17: 0 0.000000 0.000000 18: 0 0.000000 0.000000 19: 0 0.000000 0.000000 20: 0 0.000000 0.000000 21: 0 0.000000 0.000000 22: 0 0.000000 0.000000 23: 0 0.000000 0.000000 24: 0 0.000000 0.000000 25: 0 0.000000 0.000000 26: 0 0.000000 0.000000 27: 0 0.000000 0.000000 28: 0 0.000000 0.000000 29: 0 0.000000 0.000000 30: 0 0.000000 0.000000 31: 0 0.000000 0.000000 32: 0 0.000000 0.000000 33: 0 0.000000 0.000000 34: 0 0.000000 0.000000 35: 0 0.000000 0.000000 36: 0 0.000000 0.000000 37: 0 0.000000 0.000000 38: 0 0.000000 0.000000 39: 0 0.000000 0.000000 40: 0 0.000000 0.000000 41: 0 0.000000 0.000000 42: 0 0.000000 0.000000 43: 0 0.000000 0.000000 44: 0 0.000000 0.000000 45: 0 0.000000 0.000000 46: 0 0.000000 0.000000 47: 0 0.000000 0.000000 48: 0 0.000000 0.000000 49: 0 0.000000 0.000000 50: 0 0.000000 0.000000 51: 0 0.000000 0.000000 52: 0 0.000000 0.000000 53: 0 0.000000 0.000000 54: 0 0.000000 0.000000 55: 0 0.000000 0.000000 56: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/warnings.pm Page 49 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: 0 0.000000 0.000000 58: 0 0.000000 0.000000 59: 0 0.000000 0.000000 60: 0 0.000000 0.000000 61: 0 0.000000 0.000000 62: 0 0.000000 0.000000 63: 0 0.000000 0.000000 64: 0 0.000000 0.000000 65: 0 0.000000 0.000000 66: 0 0.000000 0.000000 67: 0 0.000000 0.000000 68: 0 0.000000 0.000000 69: 0 0.000000 0.000000 70: 0 0.000000 0.000000 71: 0 0.000000 0.000000 72: 0 0.000000 0.000000 73: 0 0.000000 0.000000 74: 0 0.000000 0.000000 75: 0 0.000000 0.000000 76: 0 0.000000 0.000000 77: 0 0.000000 0.000000 78: 0 0.000000 0.000000 79: 0 0.000000 0.000000 80: 0 0.000000 0.000000 81: 0 0.000000 0.000000 82: 0 0.000000 0.000000 83: 0 0.000000 0.000000 84: 0 0.000000 0.000000 85: 0 0.000000 0.000000 86: 0 0.000000 0.000000 87: 0 0.000000 0.000000 88: 0 0.000000 0.000000 89: 0 0.000000 0.000000 90: 0 0.000000 0.000000 91: 0 0.000000 0.000000 92: 0 0.000000 0.000000 93: 0 0.000000 0.000000 94: 0 0.000000 0.000000 95: 0 0.000000 0.000000 96: 0 0.000000 0.000000 97: 0 0.000000 0.000000 98: 0 0.000000 0.000000 99: 0 0.000000 0.000000 100: 0 0.000000 0.000000 101: 0 0.000000 0.000000 102: 0 0.000000 0.000000 103: 0 0.000000 0.000000 104: 0 0.000000 0.000000 105: 0 0.000000 0.000000 106: 0 0.000000 0.000000 107: 0 0.000000 0.000000 108: 0 0.000000 0.000000 109: 0 0.000000 0.000000 110: 0 0.000000 0.000000 111: 0 0.000000 0.000000 112: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/warnings.pm Page 50 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113: 0 0.000000 0.000000 114: 0 0.000000 0.000000 115: 0 0.000000 0.000000 116: 0 0.000000 0.000000 117: 0 0.000000 0.000000 118: 0 0.000000 0.000000 119: 0 0.000000 0.000000 120: 0 0.000000 0.000000 121: 0 0.000000 0.000000 122: 0 0.000000 0.000000 123: 0 0.000000 0.000000 124: 0 0.000000 0.000000 125: 0 0.000000 0.000000 126: 0 0.000000 0.000000 127: 0 0.000000 0.000000 128: 0 0.000000 0.000000 129: 0 0.000000 0.000000 130: 0 0.000000 0.000000 131: 0 0.000000 0.000000 132: 0 0.000000 0.000000 133: 0 0.000000 0.000000 134:use Carp (); 0 0.000000 0.000000 135: 0 0.000000 0.000000 136:our %Offsets = ( 0 0.000000 0.000000 137: 0 0.000000 0.000000 138: # Warnings Categories added in Perl 5.008 0 0.000000 0.000000 139: 0 0.000000 0.000000 140: 'all' => 0, 0 0.000000 0.000000 141: 'closure' => 2, 0 0.000000 0.000000 142: 'deprecated' => 4, 0 0.000000 0.000000 143: 'exiting' => 6, 0 0.000000 0.000000 144: 'glob' => 8, 0 0.000000 0.000000 145: 'io' => 10, 0 0.000000 0.000000 146: 'closed' => 12, 0 0.000000 0.000000 147: 'exec' => 14, 0 0.000000 0.000000 148: 'layer' => 16, 0 0.000000 0.000000 149: 'newline' => 18, 0 0.000000 0.000000 150: 'pipe' => 20, 0 0.000000 0.000000 151: 'unopened' => 22, 0 0.000000 0.000000 152: 'misc' => 24, 0 0.000000 0.000000 153: 'numeric' => 26, 0 0.000000 0.000000 154: 'once' => 28, 0 0.000000 0.000000 155: 'overflow' => 30, 0 0.000000 0.000000 156: 'pack' => 32, 0 0.000000 0.000000 157: 'portable' => 34, 0 0.000000 0.000000 158: 'recursion' => 36, 0 0.000000 0.000000 159: 'redefine' => 38, 0 0.000000 0.000000 160: 'regexp' => 40, 0 0.000000 0.000000 161: 'severe' => 42, 0 0.000000 0.000000 162: 'debugging' => 44, 0 0.000000 0.000000 163: 'inplace' => 46, 0 0.000000 0.000000 164: 'internal' => 48, 0 0.000000 0.000000 165: 'malloc' => 50, 0 0.000000 0.000000 166: 'signal' => 52, 0 0.000000 0.000000 167: 'substr' => 54, 0 0.000000 0.000000 168: 'syntax' => 56, ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/warnings.pm Page 51 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169: 'ambiguous' => 58, 0 0.000000 0.000000 170: 'bareword' => 60, 0 0.000000 0.000000 171: 'digit' => 62, 0 0.000000 0.000000 172: 'parenthesis' => 64, 0 0.000000 0.000000 173: 'precedence' => 66, 0 0.000000 0.000000 174: 'printf' => 68, 0 0.000000 0.000000 175: 'prototype' => 70, 0 0.000000 0.000000 176: 'qw' => 72, 0 0.000000 0.000000 177: 'reserved' => 74, 0 0.000000 0.000000 178: 'semicolon' => 76, 0 0.000000 0.000000 179: 'taint' => 78, 0 0.000000 0.000000 180: 'threads' => 80, 0 0.000000 0.000000 181: 'uninitialized' => 82, 0 0.000000 0.000000 182: 'unpack' => 84, 0 0.000000 0.000000 183: 'untie' => 86, 0 0.000000 0.000000 184: 'utf8' => 88, 0 0.000000 0.000000 185: 'void' => 90, 0 0.000000 0.000000 186: 'y2k' => 92, 0 0.000000 0.000000 187: ); 0 0.000000 0.000000 188: 0 0.000000 0.000000 189:our %Bits = ( 0 0.000000 0.000000 190: 'all' => 0 0.000000 0.000000 191: 'ambiguous' => 0 0.000000 0.000000 192: 'bareword' => 0 0.000000 0.000000 193: 'closed' => 0 0.000000 0.000000 194: 'closure' => 0 0.000000 0.000000 195: 'debugging' => 0 0.000000 0.000000 196: 'deprecated' => 0 0.000000 0.000000 197: 'digit' => 0 0.000000 0.000000 198: 'exec' => 0 0.000000 0.000000 199: 'exiting' => 0 0.000000 0.000000 200: 'glob' => 0 0.000000 0.000000 201: 'inplace' => 0 0.000000 0.000000 202: 'internal' => 0 0.000000 0.000000 203: 'io' => 0 0.000000 0.000000 204: 'layer' => 0 0.000000 0.000000 205: 'malloc' => 0 0.000000 0.000000 206: 'misc' => 0 0.000000 0.000000 207: 'newline' => 0 0.000000 0.000000 208: 'numeric' => 0 0.000000 0.000000 209: 'once' => 0 0.000000 0.000000 210: 'overflow' => 0 0.000000 0.000000 211: 'pack' => 0 0.000000 0.000000 212: 'parenthesis' => 0 0.000000 0.000000 213: 'pipe' => 0 0.000000 0.000000 214: 'portable' => 0 0.000000 0.000000 215: 'precedence' => 0 0.000000 0.000000 216: 'printf' => 0 0.000000 0.000000 217: 'prototype' => 0 0.000000 0.000000 218: 'qw' => 0 0.000000 0.000000 219: 'recursion' => 0 0.000000 0.000000 220: 'redefine' => 0 0.000000 0.000000 221: 'regexp' => 0 0.000000 0.000000 222: 'reserved' => 0 0.000000 0.000000 223: 'semicolon' => 0 0.000000 0.000000 224: 'severe' => ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/warnings.pm Page 52 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 225: 'signal' => 0 0.000000 0.000000 226: 'substr' => 0 0.000000 0.000000 227: 'syntax' => 0 0.000000 0.000000 228: 'taint' => 0 0.000000 0.000000 229: 'threads' => 0 0.000000 0.000000 230: 'uninitialized' => 0 0.000000 0.000000 231: 'unopened' => 0 0.000000 0.000000 232: 'unpack' => 0 0.000000 0.000000 233: 'untie' => 0 0.000000 0.000000 234: 'utf8' => 0 0.000000 0.000000 235: 'void' => 0 0.000000 0.000000 236: 'y2k' => 0 0.000000 0.000000 237: ); 0 0.000000 0.000000 238: 0 0.000000 0.000000 239:our %DeadBits = ( 0 0.000000 0.000000 240: 'all' => 0 0.000000 0.000000 241: 'ambiguous' => 0 0.000000 0.000000 242: 'bareword' => 0 0.000000 0.000000 243: 'closed' => 0 0.000000 0.000000 244: 'closure' => 0 0.000000 0.000000 245: 'debugging' => 0 0.000000 0.000000 246: 'deprecated' => 0 0.000000 0.000000 247: 'digit' => 0 0.000000 0.000000 248: 'exec' => 0 0.000000 0.000000 249: 'exiting' => 0 0.000000 0.000000 250: 'glob' => 0 0.000000 0.000000 251: 'inplace' => 0 0.000000 0.000000 252: 'internal' => 0 0.000000 0.000000 253: 'io' => 0 0.000000 0.000000 254: 'layer' => 0 0.000000 0.000000 255: 'malloc' => 0 0.000000 0.000000 256: 'misc' => 0 0.000000 0.000000 257: 'newline' => 0 0.000000 0.000000 258: 'numeric' => 0 0.000000 0.000000 259: 'once' => 0 0.000000 0.000000 260: 'overflow' => 0 0.000000 0.000000 261: 'pack' => 0 0.000000 0.000000 262: 'parenthesis' => 0 0.000000 0.000000 263: 'pipe' => 0 0.000000 0.000000 264: 'portable' => 0 0.000000 0.000000 265: 'precedence' => 0 0.000000 0.000000 266: 'printf' => 0 0.000000 0.000000 267: 'prototype' => 0 0.000000 0.000000 268: 'qw' => 0 0.000000 0.000000 269: 'recursion' => 0 0.000000 0.000000 270: 'redefine' => 0 0.000000 0.000000 271: 'regexp' => 0 0.000000 0.000000 272: 'reserved' => 0 0.000000 0.000000 273: 'semicolon' => 0 0.000000 0.000000 274: 'severe' => 0 0.000000 0.000000 275: 'signal' => 0 0.000000 0.000000 276: 'substr' => 0 0.000000 0.000000 277: 'syntax' => 0 0.000000 0.000000 278: 'taint' => 0 0.000000 0.000000 279: 'threads' => 0 0.000000 0.000000 280: 'uninitialized' => ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/warnings.pm Page 53 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 281: 'unopened' => 0 0.000000 0.000000 282: 'unpack' => 0 0.000000 0.000000 283: 'untie' => 0 0.000000 0.000000 284: 'utf8' => 0 0.000000 0.000000 285: 'void' => 0 0.000000 0.000000 286: 'y2k' => 0 0.000000 0.000000 287: ); 0 0.000000 0.000000 288: 0 0.000000 0.000000 289:$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0"; 0 0.000000 0.000000 290:$LAST_BIT = 94 ; 0 0.000000 0.000000 291:$BYTES = 12 ; 0 0.000000 0.000000 292: 0 0.000000 0.000000 293:$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 0 0.000000 0.000000 294: 0 0.000000 0.000000 295:sub Croaker 0 0.000000 0.000000 296:{ 0 0.000000 0.000000 297: delete $Carp::CarpInternal{'warnings'}; 0 0.000000 0.000000 298: Carp::croak(@_); 0 0.000000 0.000000 299:} 0 0.000000 0.000000 300: 0 0.000000 0.000000 301:sub bits 0 0.000000 0.000000 302:{ 0 0.000000 0.000000 303: # called from B::Deparse.pm 0 0.000000 0.000000 304: 0 0.000000 0.000000 305: push @_, 'all' unless @_; 0 0.000000 0.000000 306: 0 0.000000 0.000000 307: my $mask; 0 0.000000 0.000000 308: my $catmask ; 0 0.000000 0.000000 309: my $fatal = 0 ; 0 0.000000 0.000000 310: my $no_fatal = 0 ; 0 0.000000 0.000000 311: 0 0.000000 0.000000 312: foreach my $word ( @_ ) { 0 0.000000 0.000000 313: if ($word eq 'FATAL') { 0 0.000000 0.000000 314: $fatal = 1; 0 0.000000 0.000000 315: $no_fatal = 0; 0 0.000000 0.000000 316: } 0 0.000000 0.000000 317: elsif ($word eq 'NONFATAL') { 0 0.000000 0.000000 318: $fatal = 0; 0 0.000000 0.000000 319: $no_fatal = 1; 0 0.000000 0.000000 320: } 0 0.000000 0.000000 321: elsif ($catmask = $Bits{$word}) { 0 0.000000 0.000000 322: $mask |= $catmask ; 0 0.000000 0.000000 323: $mask |= $DeadBits{$word} if $fatal ; 0 0.000000 0.000000 324: $mask &= ~($DeadBits{$word}|$All) if 0 0.000000 0.000000 325: } 0 0.000000 0.000000 326: else 0 0.000000 0.000000 327: { Croaker("Unknown warnings 0 0.000000 0.000000 328: } 0 0.000000 0.000000 329: 0 0.000000 0.000000 330: return $mask ; 0 0.000000 0.000000 331:} 0 0.000000 0.000000 332: 0 0.000000 0.000000 333:sub import 1 0.000000 0.000000 334:{ 1 0.000004 0.000000 335: shift; 0 0.000000 0.000000 336: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/warnings.pm Page 54 ================================================================= count wall tm cpu time line 1 0.000004 0.000000 337: my $catmask ; 1 0.000004 0.000000 338: my $fatal = 0 ; 1 0.000003 0.000000 339: my $no_fatal = 0 ; 0 0.000000 0.000000 340: 1 0.000005 0.000000 341: my $mask = ${^WARNING_BITS} ; 0 0.000000 0.000000 342: 1 0.000005 0.000000 343: if (vec($mask, $Offsets{'all'}, 1)) { 0 0.000000 0.000000 344: $mask |= $Bits{'all'} ; 0 0.000000 0.000000 345: $mask |= $DeadBits{'all'} if 0 0.000000 0.000000 346: } 0 0.000000 0.000000 347: 1 0.000005 0.000000 348: push @_, 'all' unless @_; 0 0.000000 0.000000 349: 1 0.000004 0.000000 350: foreach my $word ( @_ ) { 1 0.000007 0.000000 351: if ($word eq 'FATAL') { 0 0.000000 0.000000 352: $fatal = 1; 0 0.000000 0.000000 353: $no_fatal = 0; 0 0.000000 0.000000 354: } 0 0.000000 0.000000 355: elsif ($word eq 'NONFATAL') { 0 0.000000 0.000000 356: $fatal = 0; 0 0.000000 0.000000 357: $no_fatal = 1; 0 0.000000 0.000000 358: } 0 0.000000 0.000000 359: elsif ($catmask = $Bits{$word}) { 1 0.000013 0.000000 360: $mask |= $catmask ; 1 0.000003 0.000000 361: $mask |= $DeadBits{$word} if $fatal ; 1 0.000005 0.000000 362: $mask &= ~($DeadBits{$word}|$All) if 0 0.000000 0.000000 363: } 0 0.000000 0.000000 364: else 0 0.000000 0.000000 365: { Croaker("Unknown warnings 0 0.000000 0.000000 366: } 0 0.000000 0.000000 367: 1 0.000305 0.000000 368: ${^WARNING_BITS} = $mask ; 0 0.000000 0.000000 369:} 0 0.000000 0.000000 370: 0 0.000000 0.000000 371:sub unimport 0 0.000000 0.000000 372:{ 0 0.000000 0.000000 373: shift; 0 0.000000 0.000000 374: 0 0.000000 0.000000 375: my $catmask ; 0 0.000000 0.000000 376: my $mask = ${^WARNING_BITS} ; 0 0.000000 0.000000 377: 0 0.000000 0.000000 378: if (vec($mask, $Offsets{'all'}, 1)) { 0 0.000000 0.000000 379: $mask |= $Bits{'all'} ; 0 0.000000 0.000000 380: $mask |= $DeadBits{'all'} if 0 0.000000 0.000000 381: } 0 0.000000 0.000000 382: 0 0.000000 0.000000 383: push @_, 'all' unless @_; 0 0.000000 0.000000 384: 0 0.000000 0.000000 385: foreach my $word ( @_ ) { 0 0.000000 0.000000 386: if ($word eq 'FATAL') { 0 0.000000 0.000000 387: next; 0 0.000000 0.000000 388: } 0 0.000000 0.000000 389: elsif ($catmask = $Bits{$word}) { 0 0.000000 0.000000 390: $mask &= ~($catmask | $DeadBits{$word} | 0 0.000000 0.000000 391: } 0 0.000000 0.000000 392: else ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/warnings.pm Page 55 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 393: { Croaker("Unknown warnings 0 0.000000 0.000000 394: } 0 0.000000 0.000000 395: 0 0.000000 0.000000 396: ${^WARNING_BITS} = $mask ; 0 0.000000 0.000000 397:} 0 0.000000 0.000000 398: 0 0.000000 0.000000 399:sub __chk 0 0.000000 0.000000 400:{ 0 0.000000 0.000000 401: my $category ; 0 0.000000 0.000000 402: my $offset ; 0 0.000000 0.000000 403: my $isobj = 0 ; 0 0.000000 0.000000 404: 0 0.000000 0.000000 405: if (@_) { 0 0.000000 0.000000 406: # check the category supplied. 0 0.000000 0.000000 407: $category = shift ; 0 0.000000 0.000000 408: if (ref $category) { 0 0.000000 0.000000 409: Croaker ("not an object") 0 0.000000 0.000000 410: if $category !~ /^([^=]+)=/ ; 0 0.000000 0.000000 411: $category = $1 ; 0 0.000000 0.000000 412: $isobj = 1 ; 0 0.000000 0.000000 413: } 0 0.000000 0.000000 414: $offset = $Offsets{$category}; 0 0.000000 0.000000 415: Croaker("Unknown warnings category 0 0.000000 0.000000 416: unless defined $offset; 0 0.000000 0.000000 417: } 0 0.000000 0.000000 418: else { 0 0.000000 0.000000 419: $category = (caller(1))[0] ; 0 0.000000 0.000000 420: $offset = $Offsets{$category}; 0 0.000000 0.000000 421: Croaker("package '$category' not 0 0.000000 0.000000 422: unless defined $offset ; 0 0.000000 0.000000 423: } 0 0.000000 0.000000 424: 0 0.000000 0.000000 425: my $this_pkg = (caller(1))[0] ; 0 0.000000 0.000000 426: my $i = 2 ; 0 0.000000 0.000000 427: my $pkg ; 0 0.000000 0.000000 428: 0 0.000000 0.000000 429: if ($isobj) { 0 0.000000 0.000000 430: while (do { { package DB; $pkg = 0 0.000000 0.000000 431: last unless @DB::args && 0 0.000000 0.000000 432: } 0 0.000000 0.000000 433: $i -= 2 ; 0 0.000000 0.000000 434: } 0 0.000000 0.000000 435: else { 0 0.000000 0.000000 436: for ($i = 2 ; $pkg = (caller($i))[0] 0 0.000000 0.000000 437: last if $pkg ne $this_pkg ; 0 0.000000 0.000000 438: } 0 0.000000 0.000000 439: $i = 2 0 0.000000 0.000000 440: if !$pkg || $pkg eq $this_pkg ; 0 0.000000 0.000000 441: } 0 0.000000 0.000000 442: 0 0.000000 0.000000 443: my $callers_bitmask = (caller($i))[9] ; 0 0.000000 0.000000 444: return ($callers_bitmask, $offset, $i) ; 0 0.000000 0.000000 445:} 0 0.000000 0.000000 446: 0 0.000000 0.000000 447:sub enabled 0 0.000000 0.000000 448:{ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/warnings.pm Page 56 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 449: Croaker("Usage: 0 0.000000 0.000000 450: unless @_ == 1 || @_ == 0 ; 0 0.000000 0.000000 451: 0 0.000000 0.000000 452: my ($callers_bitmask, $offset, $i) = 0 0.000000 0.000000 453: 0 0.000000 0.000000 454: return 0 unless defined $callers_bitmask 0 0.000000 0.000000 455: return vec($callers_bitmask, $offset, 1) 0 0.000000 0.000000 456: vec($callers_bitmask, 0 0.000000 0.000000 457:} 0 0.000000 0.000000 458: 0 0.000000 0.000000 459: 0 0.000000 0.000000 460:sub warn 0 0.000000 0.000000 461:{ 0 0.000000 0.000000 462: Croaker("Usage: 0 0.000000 0.000000 463: unless @_ == 2 || @_ == 1 ; 0 0.000000 0.000000 464: 0 0.000000 0.000000 465: my $message = pop ; 0 0.000000 0.000000 466: my ($callers_bitmask, $offset, $i) = 0 0.000000 0.000000 467: Carp::croak($message) 0 0.000000 0.000000 468: if vec($callers_bitmask, $offset+1, 1) || 0 0.000000 0.000000 469: vec($callers_bitmask, $Offsets{'all'}+1, 0 0.000000 0.000000 470: Carp::carp($message) ; 0 0.000000 0.000000 471:} 0 0.000000 0.000000 472: 0 0.000000 0.000000 473:sub warnif 0 0.000000 0.000000 474:{ 0 0.000000 0.000000 475: Croaker("Usage: 0 0.000000 0.000000 476: unless @_ == 2 || @_ == 1 ; 0 0.000000 0.000000 477: 0 0.000000 0.000000 478: my $message = pop ; 0 0.000000 0.000000 479: my ($callers_bitmask, $offset, $i) = 0 0.000000 0.000000 480: 0 0.000000 0.000000 481: return 0 0.000000 0.000000 482: unless defined $callers_bitmask && 0 0.000000 0.000000 483: (vec($callers_bitmask, $offset, 0 0.000000 0.000000 484: vec($callers_bitmask, 0 0.000000 0.000000 485: 0 0.000000 0.000000 486: Carp::croak($message) 0 0.000000 0.000000 487: if vec($callers_bitmask, $offset+1, 1) || 0 0.000000 0.000000 488: vec($callers_bitmask, $Offsets{'all'}+1, 0 0.000000 0.000000 489: 0 0.000000 0.000000 490: Carp::carp($message) ; 0 0.000000 0.000000 491:} 0 0.000000 0.000000 492: 0 0.000000 0.000000 493:1; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/5.8.5/warnings/register.pm Page 57 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package warnings::register ; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:our $VERSION = '1.00'; 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:=pod 0 0.000000 0.000000 6: 0 0.000000 0.000000 7: 0 0.000000 0.000000 8: 0 0.000000 0.000000 9: 0 0.000000 0.000000 10: 0 0.000000 0.000000 11: 0 0.000000 0.000000 12: 0 0.000000 0.000000 13: 0 0.000000 0.000000 14: 0 0.000000 0.000000 15: 0 0.000000 0.000000 16: 0 0.000000 0.000000 17: 0 0.000000 0.000000 18: 0 0.000000 0.000000 19: 0 0.000000 0.000000 20: 0 0.000000 0.000000 21: 0 0.000000 0.000000 22: 0 0.000000 0.000000 23: 0 0.000000 0.000000 24:require warnings ; 0 0.000000 0.000000 25: 0 0.000000 0.000000 26:sub mkMask 6 0.000000 0.000000 27:{ 4 0.000011 0.000000 28: my ($bit) = @_ ; 4 0.000012 0.000000 29: my $mask = "" ; 0 0.000000 0.000000 30: 4 0.000022 0.000000 31: vec($mask, $bit, 1) = 1 ; 4 0.000027 0.000000 32: return $mask ; 0 0.000000 0.000000 33:} 0 0.000000 0.000000 34: 0 0.000000 0.000000 35:sub import 3 0.000000 0.000000 36:{ 2 0.000007 0.000000 37: shift ; 2 0.000018 0.000000 38: my $package = (caller(0))[0] ; 2 0.000008 0.000000 39: if (! defined $warnings::Bits{$package}) 2 0.000015 0.000000 40: $warnings::Bits{$package} = 2 0.000009 0.000000 41: vec($warnings::Bits{'all'}, 2 0.000009 0.000000 42: $warnings::Offsets{$package} = 2 0.000072 0.000000 43: foreach my $k (keys %warnings::Bits) { 101 0.000424 0.010000 44: vec($warnings::Bits{$k}, 0 0.000000 0.000000 45: } 2 0.000010 0.000000 46: $warnings::DeadBits{$package} = 2 0.000008 0.000000 47: vec($warnings::DeadBits{'all'}, 0 0.000000 0.000000 48: } 0 0.000000 0.000000 49:} 0 0.000000 0.000000 50: 0 0.000000 0.000000 51:1 ; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Date.pm Page 58 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package HTTP::Date; # $Date: 2003/10/23 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:$VERSION = sprintf("%d.%02d", q$Revision: 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:require 5.004; 0 0.000000 0.000000 6:require Exporter; 0 0.000000 0.000000 7:@ISA = qw(Exporter); 0 0.000000 0.000000 8:@EXPORT = qw(time2str str2time); 0 0.000000 0.000000 9:@EXPORT_OK = qw(parse_date time2iso 0 0.000000 0.000000 10: 0 0.000000 0.000000 11:use strict; 0 0.000000 0.000000 12:require Time::Local; 0 0.000000 0.000000 13: 0 0.000000 0.000000 14:use vars qw(@DoW @MoY %MoY); 0 0.000000 0.000000 15:@DoW = qw(Sun Mon Tue Wed Thu Fri Sat); 0 0.000000 0.000000 16:@MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep 0 0.000000 0.000000 17:@MoY{@MoY} = (1..12); 0 0.000000 0.000000 18: 0 0.000000 0.000000 19:my %GMT_ZONE = (GMT => 1, UTC => 1, UT => 1, 0 0.000000 0.000000 20: 0 0.000000 0.000000 21: 0 0.000000 0.000000 22:sub time2str (;$) 423 0.000000 0.000000 23:{ 423 0.001391 0.010000 24: my $time = shift; 423 0.001117 0.010000 25: $time = time unless defined $time; 423 0.003457 0.000000 26: my ($sec, $min, $hour, $mday, $mon, 423 0.001771 0.010000 27: sprintf("%s, %02d %s %04d %02d:%02d:%02d 0 0.000000 0.000000 28: $DoW[$wday], 0 0.000000 0.000000 29: $mday, $MoY[$mon], $year+1900, 0 0.000000 0.000000 30: $hour, $min, $sec); 0 0.000000 0.000000 31:} 0 0.000000 0.000000 32: 0 0.000000 0.000000 33: 0 0.000000 0.000000 34:sub str2time ($;$) 0 0.000000 0.000000 35:{ 0 0.000000 0.000000 36: my $str = shift; 0 0.000000 0.000000 37: return undef unless defined $str; 0 0.000000 0.000000 38: 0 0.000000 0.000000 39: # fast exit for strictly conforming 0 0.000000 0.000000 40: if ($str =~ /^[SMTWF][a-z][a-z], (\d\d) 0 0.000000 0.000000 41: return eval { 0 0.000000 0.000000 42: my $t = Time::Local::timegm($6, $5, $4, 0 0.000000 0.000000 43: $t < 0 ? undef : $t; 0 0.000000 0.000000 44: }; 0 0.000000 0.000000 45: } 0 0.000000 0.000000 46: 0 0.000000 0.000000 47: my @d = parse_date($str); 0 0.000000 0.000000 48: return undef unless @d; 0 0.000000 0.000000 49: $d[0] -= 1900; # year 0 0.000000 0.000000 50: $d[1]--; # month 0 0.000000 0.000000 51: 0 0.000000 0.000000 52: my $tz = pop(@d); 0 0.000000 0.000000 53: unless (defined $tz) { 0 0.000000 0.000000 54: unless (defined($tz = shift)) { 0 0.000000 0.000000 55: return eval { my $frac = $d[-1]; $frac - 0 0.000000 0.000000 56: my $t = Time::Local::timelocal(reverse ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Date.pm Page 59 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: $t < 0 ? undef : $t; 0 0.000000 0.000000 58: }; 0 0.000000 0.000000 59: } 0 0.000000 0.000000 60: } 0 0.000000 0.000000 61: 0 0.000000 0.000000 62: my $offset = 0; 0 0.000000 0.000000 63: if ($GMT_ZONE{uc $tz}) { 0 0.000000 0.000000 64: # offset already zero 0 0.000000 0.000000 65: } 0 0.000000 0.000000 66: elsif ($tz =~ /^([- 0 0.000000 0.000000 67: $offset = 3600 * $2; 0 0.000000 0.000000 68: $offset += 60 * $3 if $3; 0 0.000000 0.000000 69: $offset *= -1 if $1 && $1 eq '-'; 0 0.000000 0.000000 70: } 0 0.000000 0.000000 71: else { 0 0.000000 0.000000 72: eval { require Time::Zone } || return undef; 0 0.000000 0.000000 73: $offset = Time::Zone::tz_offset($tz); 0 0.000000 0.000000 74: return undef unless defined $offset; 0 0.000000 0.000000 75: } 0 0.000000 0.000000 76: 0 0.000000 0.000000 77: return eval { my $frac = $d[-1]; $frac -= 0 0.000000 0.000000 78: my $t = Time::Local::timegm(reverse @d) + 0 0.000000 0.000000 79: $t < 0 ? undef : $t - $offset; 0 0.000000 0.000000 80: }; 0 0.000000 0.000000 81:} 0 0.000000 0.000000 82: 0 0.000000 0.000000 83: 0 0.000000 0.000000 84:sub parse_date ($) 0 0.000000 0.000000 85:{ 0 0.000000 0.000000 86: local($_) = shift; 0 0.000000 0.000000 87: return unless defined; 0 0.000000 0.000000 88: 0 0.000000 0.000000 89: # More lax parsing below 0 0.000000 0.000000 90: s/^\s+//; # kill leading space 0 0.000000 0.000000 91: s/^(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat)[a- 0 0.000000 0.000000 92: 0 0.000000 0.000000 93: my($day, $mon, $yr, $hr, $min, $sec, $tz, 0 0.000000 0.000000 94: 0 0.000000 0.000000 95: # Then we are able to check for most of 0 0.000000 0.000000 96: (($day,$mon,$yr,$hr,$min,$sec,$tz) = 0 0.000000 0.000000 97: /^ 0 0.000000 0.000000 98: (\d\d?) # day 0 0.000000 0.000000 99: (?:\s+|[-\/]) 0 0.000000 0.000000 100: (\w+) # month 0 0.000000 0.000000 101: (?:\s+|[-\/]) 0 0.000000 0.000000 102: (\d+) # year 0 0.000000 0.000000 103: (?: 0 0.000000 0.000000 104: (?:\s+|:) # separator before 0 0.000000 0.000000 105: (\d\d?):(\d\d) # hour:min 0 0.000000 0.000000 106: (?::(\d\d))? # optional seconds 0 0.000000 0.000000 107: )? # optional clock 0 0.000000 0.000000 108: \s* 0 0.000000 0.000000 109: ([-+]?\d{2,4}|(?![APap][Mm]\b)[A-Za-z]+)? # 0 0.000000 0.000000 110: \s* 0 0.000000 0.000000 111: (?:\(\w+\))? # ASCII representation 0 0.000000 0.000000 112: \s*$ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Date.pm Page 60 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113: /x) 0 0.000000 0.000000 114: 0 0.000000 0.000000 115: || 0 0.000000 0.000000 116: 0 0.000000 0.000000 117: # Try the ctime and asctime format 0 0.000000 0.000000 118: (($mon, $day, $hr, $min, $sec, $tz, $yr) 0 0.000000 0.000000 119: /^ 0 0.000000 0.000000 120: (\w{1,3}) # month 0 0.000000 0.000000 121: \s+ 0 0.000000 0.000000 122: (\d\d?) # day 0 0.000000 0.000000 123: \s+ 0 0.000000 0.000000 124: (\d\d?):(\d\d) # hour:min 0 0.000000 0.000000 125: (?::(\d\d))? # optional seconds 0 0.000000 0.000000 126: \s+ 0 0.000000 0.000000 127: (?:([A-Za-z]+)\s+)? # optional timezone 0 0.000000 0.000000 128: (\d+) # year 0 0.000000 0.000000 129: \s*$ # allow trailing 0 0.000000 0.000000 130: /x) 0 0.000000 0.000000 131: 0 0.000000 0.000000 132: || 0 0.000000 0.000000 133: 0 0.000000 0.000000 134: # Then the Unix 'ls -l' date format 0 0.000000 0.000000 135: (($mon, $day, $yr, $hr, $min, $sec) = 0 0.000000 0.000000 136: /^ 0 0.000000 0.000000 137: (\w{3}) # month 0 0.000000 0.000000 138: \s+ 0 0.000000 0.000000 139: (\d\d?) # day 0 0.000000 0.000000 140: \s+ 0 0.000000 0.000000 141: (?: 0 0.000000 0.000000 142: (\d\d\d\d) | # year 0 0.000000 0.000000 143: (\d{1,2}):(\d{2}) # hour:min 0 0.000000 0.000000 144: (?::(\d\d))? # optional 0 0.000000 0.000000 145: ) 0 0.000000 0.000000 146: \s*$ 0 0.000000 0.000000 147: /x) 0 0.000000 0.000000 148: 0 0.000000 0.000000 149: || 0 0.000000 0.000000 150: 0 0.000000 0.000000 151: # ISO 8601 format '1996-02-29 12:00:00 - 0 0.000000 0.000000 152: (($yr, $mon, $day, $hr, $min, $sec, $tz) 0 0.000000 0.000000 153: /^ 0 0.000000 0.000000 154: (\d{4}) # year 0 0.000000 0.000000 155: [-\/]? 0 0.000000 0.000000 156: (\d\d?) # numerical month 0 0.000000 0.000000 157: [-\/]? 0 0.000000 0.000000 158: (\d\d?) # day 0 0.000000 0.000000 159: (?: 0 0.000000 0.000000 160: (?:\s+|[-:Tt]) # separator before 0 0.000000 0.000000 161: (\d\d?):?(\d\d) # hour:min 0 0.000000 0.000000 162: (?::?(\d\d(?:\.\d*)?))? # optional 0 0.000000 0.000000 163: )? # optional clock 0 0.000000 0.000000 164: \s* 0 0.000000 0.000000 165: ([-+]?\d\d?:?(:?\d\d)? 0 0.000000 0.000000 166: |Z|z)? # timezone (Z is 0 0.000000 0.000000 167: \s*$ 0 0.000000 0.000000 168: /x) ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Date.pm Page 61 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169: 0 0.000000 0.000000 170: || 0 0.000000 0.000000 171: 0 0.000000 0.000000 172: # Windows 'dir' 11-12-96 03:52PM 0 0.000000 0.000000 173: (($mon, $day, $yr, $hr, $min, $ampm) = 0 0.000000 0.000000 174: /^ 0 0.000000 0.000000 175: (\d{2}) # numerical 0 0.000000 0.000000 176: - 0 0.000000 0.000000 177: (\d{2}) # day 0 0.000000 0.000000 178: - 0 0.000000 0.000000 179: (\d{2}) # year 0 0.000000 0.000000 180: \s+ 0 0.000000 0.000000 181: (\d\d?):(\d\d)([APap][Mm]) # 0 0.000000 0.000000 182: \s*$ 0 0.000000 0.000000 183: /x) 0 0.000000 0.000000 184: 0 0.000000 0.000000 185: || 0 0.000000 0.000000 186: return; # unrecognized format 0 0.000000 0.000000 187: 0 0.000000 0.000000 188: # Translate month name to number 0 0.000000 0.000000 189: $mon = $MoY{$mon} || 0 0.000000 0.000000 190: $MoY{"\u\L$mon"} || 0 0.000000 0.000000 191: ($mon =~ /^\d\d?$/ && $mon >= 1 && $mon 0 0.000000 0.000000 192: return; 0 0.000000 0.000000 193: 0 0.000000 0.000000 194: # If the year is missing, we assume first 0 0.000000 0.000000 195: # because of the formats we support such 0 0.000000 0.000000 196: # on "ls -l" listings. 0 0.000000 0.000000 197: unless (defined $yr) { 0 0.000000 0.000000 198: my $cur_mon; 0 0.000000 0.000000 199: ($cur_mon, $yr) = (localtime)[4, 5]; 0 0.000000 0.000000 200: $yr += 1900; 0 0.000000 0.000000 201: $cur_mon++; 0 0.000000 0.000000 202: $yr-- if $mon > $cur_mon; 0 0.000000 0.000000 203: } 0 0.000000 0.000000 204: elsif (length($yr) < 3) { 0 0.000000 0.000000 205: # Find "obvious" year 0 0.000000 0.000000 206: my $cur_yr = (localtime)[5] + 1900; 0 0.000000 0.000000 207: my $m = $cur_yr % 100; 0 0.000000 0.000000 208: my $tmp = $yr; 0 0.000000 0.000000 209: $yr += $cur_yr - $m; 0 0.000000 0.000000 210: $m -= $tmp; 0 0.000000 0.000000 211: $yr += ($m > 0) ? 100 : -100 0 0.000000 0.000000 212: if abs($m) > 50; 0 0.000000 0.000000 213: } 0 0.000000 0.000000 214: 0 0.000000 0.000000 215: # Make sure clock elements are defined 0 0.000000 0.000000 216: $hr = 0 unless defined($hr); 0 0.000000 0.000000 217: $min = 0 unless defined($min); 0 0.000000 0.000000 218: $sec = 0 unless defined($sec); 0 0.000000 0.000000 219: 0 0.000000 0.000000 220: # Compensate for AM/PM 0 0.000000 0.000000 221: if ($ampm) { 0 0.000000 0.000000 222: $ampm = uc $ampm; 0 0.000000 0.000000 223: $hr = 0 if $hr == 12 && $ampm eq 'AM'; 0 0.000000 0.000000 224: $hr += 12 if $ampm eq 'PM' && $hr != 12; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Date.pm Page 62 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 225: } 0 0.000000 0.000000 226: 0 0.000000 0.000000 227: return($yr, $mon, $day, $hr, $min, $sec, 0 0.000000 0.000000 228: if wantarray; 0 0.000000 0.000000 229: 0 0.000000 0.000000 230: if (defined $tz) { 0 0.000000 0.000000 231: $tz = "Z" if $tz =~ /^(GMT|UTC?|[-+]?0+)$/; 0 0.000000 0.000000 232: } 0 0.000000 0.000000 233: else { 0 0.000000 0.000000 234: $tz = ""; 0 0.000000 0.000000 235: } 0 0.000000 0.000000 236: return sprintf("%04d-%02d-%02d 0 0.000000 0.000000 237: $yr, $mon, $day, $hr, $min, $sec, $tz); 0 0.000000 0.000000 238:} 0 0.000000 0.000000 239: 0 0.000000 0.000000 240: 0 0.000000 0.000000 241:sub time2iso (;$) 0 0.000000 0.000000 242:{ 0 0.000000 0.000000 243: my $time = shift; 0 0.000000 0.000000 244: $time = time unless defined $time; 0 0.000000 0.000000 245: my($sec,$min,$hour,$mday,$mon,$year) = 0 0.000000 0.000000 246: sprintf("%04d-%02d-%02d %02d:%02d:%02d", 0 0.000000 0.000000 247: $year+1900, $mon+1, $mday, $hour, $min, 0 0.000000 0.000000 248:} 0 0.000000 0.000000 249: 0 0.000000 0.000000 250: 0 0.000000 0.000000 251:sub time2isoz (;$) 0 0.000000 0.000000 252:{ 0 0.000000 0.000000 253: my $time = shift; 0 0.000000 0.000000 254: $time = time unless defined $time; 0 0.000000 0.000000 255: my($sec,$min,$hour,$mday,$mon,$year) = 0 0.000000 0.000000 256: sprintf("%04d-%02d-%02d %02d:%02d:%02dZ", 0 0.000000 0.000000 257: $year+1900, $mon+1, $mday, $hour, 0 0.000000 0.000000 258:} 0 0.000000 0.000000 259: 0 0.000000 0.000000 260:1; 0 0.000000 0.000000 261: 0 0.000000 0.000000 262: 0 0.000000 0.000000 263:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Headers.pm Page 63 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package HTTP::Headers; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:# $Id: Headers.pm,v 1.59 2004/04/10 21:55:14 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:use strict; 0 0.000000 0.000000 6:use Carp (); 0 0.000000 0.000000 7: 0 0.000000 0.000000 8:use vars qw($VERSION $TRANSLATE_UNDERSCORE); 0 0.000000 0.000000 9:$VERSION = sprintf("%d.%02d", q$Revision: 0 0.000000 0.000000 10: 0 0.000000 0.000000 11:# The $TRANSLATE_UNDERSCORE variable controls 0 0.000000 0.000000 12:# as a replacement for '-' in header field 0 0.000000 0.000000 13:$TRANSLATE_UNDERSCORE = 1 unless defined 0 0.000000 0.000000 14: 0 0.000000 0.000000 15:# "Good Practice" order of HTTP message 0 0.000000 0.000000 16:# - General-Headers 0 0.000000 0.000000 17:# - Request-Headers 0 0.000000 0.000000 18:# - Response-Headers 0 0.000000 0.000000 19:# - Entity-Headers 0 0.000000 0.000000 20: 0 0.000000 0.000000 21:my @general_headers = qw( 0 0.000000 0.000000 22: Cache-Control Connection Date Pragma 0 0.000000 0.000000 23: Via Warning 0 0.000000 0.000000 24:); 0 0.000000 0.000000 25: 0 0.000000 0.000000 26:my @request_headers = qw( 0 0.000000 0.000000 27: Accept Accept-Charset Accept-Encoding 0 0.000000 0.000000 28: Authorization Expect From Host 0 0.000000 0.000000 29: If-Match If-Modified-Since If-None-Match 0 0.000000 0.000000 30: Max-Forwards Proxy-Authorization Range 0 0.000000 0.000000 31:); 0 0.000000 0.000000 32: 0 0.000000 0.000000 33:my @response_headers = qw( 0 0.000000 0.000000 34: Accept-Ranges Age ETag Location Proxy- 0 0.000000 0.000000 35: Vary WWW-Authenticate 0 0.000000 0.000000 36:); 0 0.000000 0.000000 37: 0 0.000000 0.000000 38:my @entity_headers = qw( 0 0.000000 0.000000 39: Allow Content-Encoding Content-Language 0 0.000000 0.000000 40: Content-MD5 Content-Range Content-Type 0 0.000000 0.000000 41:); 0 0.000000 0.000000 42: 0 0.000000 0.000000 43:my %entity_header = map { lc($_) => 1 } 0 0.000000 0.000000 44: 0 0.000000 0.000000 45:my @header_order = ( 0 0.000000 0.000000 46: @general_headers, 0 0.000000 0.000000 47: @request_headers, 0 0.000000 0.000000 48: @response_headers, 0 0.000000 0.000000 49: @entity_headers, 0 0.000000 0.000000 50:); 0 0.000000 0.000000 51: 0 0.000000 0.000000 52:# Make alternative representations of 0 0.000000 0.000000 53:# for sorting and case matching. 0 0.000000 0.000000 54:my %header_order; 0 0.000000 0.000000 55:my %standard_case; 0 0.000000 0.000000 56: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Headers.pm Page 64 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57:{ 0 0.000000 0.000000 58: my $i = 0; 0 0.000000 0.000000 59: for (@header_order) { 0 0.000000 0.000000 60: my $lc = lc $_; 0 0.000000 0.000000 61: $header_order{$lc} = ++$i; 0 0.000000 0.000000 62: $standard_case{$lc} = $_; 0 0.000000 0.000000 63: } 0 0.000000 0.000000 64:} 0 0.000000 0.000000 65: 0 0.000000 0.000000 66: 0 0.000000 0.000000 67: 0 0.000000 0.000000 68:sub new 1129 0.000000 0.000000 69:{ 1129 0.004677 0.000000 70: my($class) = shift; 1129 0.006870 0.030000 71: my $self = bless {}, $class; 1129 0.003260 0.010000 72: $self->header(@_) if @_; # set up initial 1129 0.005905 0.030000 73: $self; 0 0.000000 0.000000 74:} 0 0.000000 0.000000 75: 0 0.000000 0.000000 76: 0 0.000000 0.000000 77:sub header 1601 0.000000 0.000000 78:{ 1601 0.005136 0.020000 79: my $self = shift; 1601 0.004424 0.010000 80: Carp::croak('Usage: $h->header($field, 1601 0.004163 0.020000 81: my(@old); 1601 0.007690 0.020000 82: while (my($field, $val) = splice(@_, 0, 1601 0.009743 0.020000 83: @old = $self->_header($field, $val); 0 0.000000 0.000000 84: } 1601 0.004509 0.010000 85: return @old if wantarray; 1601 0.011832 0.030000 86: return $old[0] if @old <= 1; 0 0.000000 0.000000 87: join(", ", @old); 0 0.000000 0.000000 88:} 0 0.000000 0.000000 89: 0 0.000000 0.000000 90:sub clear 0 0.000000 0.000000 91:{ 0 0.000000 0.000000 92: my $self = shift; 0 0.000000 0.000000 93: %$self = (); 0 0.000000 0.000000 94:} 0 0.000000 0.000000 95: 0 0.000000 0.000000 96: 0 0.000000 0.000000 97:sub push_header 4357 0.000000 0.000000 98:{ 4357 0.015697 0.060000 99: Carp::croak('Usage: $h- 4357 0.025668 0.050000 100: shift->_header(@_, 'PUSH'); 0 0.000000 0.000000 101:} 0 0.000000 0.000000 102: 0 0.000000 0.000000 103: 0 0.000000 0.000000 104:sub init_header 1129 0.000000 0.000000 105:{ 1129 0.004537 0.010000 106: Carp::croak('Usage: $h- 1129 0.006861 0.040000 107: shift->_header(@_, 'INIT'); 0 0.000000 0.000000 108:} 0 0.000000 0.000000 109: 0 0.000000 0.000000 110: 0 0.000000 0.000000 111:sub remove_header 380 0.000000 0.000000 112:{ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Headers.pm Page 65 ================================================================= count wall tm cpu time line 380 0.001930 0.000000 113: my($self, @fields) = @_; 380 0.001032 0.000000 114: my $field; 380 0.000930 0.000000 115: my @values; 380 0.001513 0.010000 116: foreach $field (@fields) { 409 0.001343 0.010000 117: $field =~ tr/_/-/ if $TRANSLATE_UNDERSCORE; 409 0.001965 0.010000 118: my $v = delete $self->{lc $field}; 409 0.002092 0.000000 119: push(@values, ref($v) eq 'ARRAY' ? @$v : $v) 0 0.000000 0.000000 120: } 380 0.003283 0.020000 121: return @values; 0 0.000000 0.000000 122:} 0 0.000000 0.000000 123: 0 0.000000 0.000000 124:sub remove_content_headers 0 0.000000 0.000000 125:{ 0 0.000000 0.000000 126: my $self = shift; 0 0.000000 0.000000 127: unless (defined(wantarray)) { 0 0.000000 0.000000 128: # fast branch that does not create return 0 0.000000 0.000000 129: delete @$self{grep $entity_header{$_} || 0 0.000000 0.000000 130: return; 0 0.000000 0.000000 131: } 0 0.000000 0.000000 132: 0 0.000000 0.000000 133: my $c = ref($self)->new; 0 0.000000 0.000000 134: for my $f (grep $entity_header{$_} || 0 0.000000 0.000000 135: $c->{$f} = delete $self->{$f}; 0 0.000000 0.000000 136: } 0 0.000000 0.000000 137: $c; 0 0.000000 0.000000 138:} 0 0.000000 0.000000 139: 0 0.000000 0.000000 140: 0 0.000000 0.000000 141:sub _header 7438 0.000000 0.000000 142:{ 7438 0.032917 0.050000 143: my($self, $field, $val, $op) = @_; 7438 0.025392 0.080000 144: $field =~ tr/_/-/ if 0 0.000000 0.000000 145: 0 0.000000 0.000000 146: # $push is only used interally sub 7438 0.019874 0.040000 147: Carp::croak('Need a field name') unless 0 0.000000 0.000000 148: 7438 0.022981 0.060000 149: my $lc_field = lc $field; 7438 0.025634 0.010000 150: unless(defined $standard_case{$lc_field}) 0 0.000000 0.000000 151: # generate a %standard_case entry for this 79 0.001290 0.000000 152: $field =~ s/\b(\w)/\u$1/g; 79 0.000469 0.000000 153: $standard_case{$lc_field} = $field; 0 0.000000 0.000000 154: } 0 0.000000 0.000000 155: 7438 0.024431 0.100000 156: my $h = $self->{$lc_field}; 7438 0.027420 0.040000 157: my @old = ref($h) eq 'ARRAY' ? @$h : 0 0.000000 0.000000 158: 7438 0.018813 0.060000 159: $op ||= ""; 7438 0.021001 0.030000 160: $val = undef if $op eq 'INIT' && @old; 7438 0.019310 0.090000 161: if (defined($val)) { 6527 0.022263 0.080000 162: my @new = ($op eq 'PUSH') ? @old : (); 6527 0.018500 0.010000 163: if (ref($val) ne 'ARRAY') { 6365 0.026901 0.060000 164: push(@new, $val); 0 0.000000 0.000000 165: } 0 0.000000 0.000000 166: else { 162 0.000759 0.000000 167: push(@new, @$val); 0 0.000000 0.000000 168: } ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Headers.pm Page 66 ================================================================= count wall tm cpu time line 6527 0.040761 0.090000 169: $self->{$lc_field} = @new > 1 ? \@new : 0 0.000000 0.000000 170: } 7438 0.060156 0.130000 171: @old; 0 0.000000 0.000000 172:} 0 0.000000 0.000000 173: 0 0.000000 0.000000 174: 0 0.000000 0.000000 175:# Compare function which makes it easy to 0 0.000000 0.000000 176:# recommended "Good Practice" order. 0 0.000000 0.000000 177:sub _header_cmp 0 0.000000 0.000000 178:{ 1094 0.006664 0.020000 179: ($header_order{$a} || 999) <=> 0 0.000000 0.000000 180:} 0 0.000000 0.000000 181: 0 0.000000 0.000000 182: 0 0.000000 0.000000 183:sub header_field_names { 0 0.000000 0.000000 184: my $self = shift; 0 0.000000 0.000000 185: return map $standard_case{$_}, sort 0 0.000000 0.000000 186: if wantarray; 0 0.000000 0.000000 187: return keys %$self; 0 0.000000 0.000000 188:} 0 0.000000 0.000000 189: 0 0.000000 0.000000 190: 0 0.000000 0.000000 191:sub scan 739 0.000000 0.000000 192:{ 739 0.002712 0.010000 193: my($self, $sub) = @_; 739 0.001741 0.000000 194: my $key; 739 0.012207 0.000000 195: foreach $key (sort _header_cmp keys 1833 0.006622 0.010000 196: next if $key =~ /^_/; 1833 0.006324 0.010000 197: my $vals = $self->{$key}; 1833 0.005490 0.010000 198: if (ref($vals) eq 'ARRAY') { 0 0.000000 0.000000 199: my $val; 0 0.000000 0.000000 200: for $val (@$vals) { 0 0.000000 0.000000 201: &$sub($standard_case{$key} || $key, $val); 0 0.000000 0.000000 202: } 0 0.000000 0.000000 203: } 0 0.000000 0.000000 204: else { 1833 0.006753 0.040000 205: &$sub($standard_case{$key} || $key, 0 0.000000 0.000000 206: } 0 0.000000 0.000000 207: } 0 0.000000 0.000000 208:} 0 0.000000 0.000000 209: 0 0.000000 0.000000 210: 0 0.000000 0.000000 211:sub as_string 0 0.000000 0.000000 212:{ 0 0.000000 0.000000 213: my($self, $endl) = @_; 0 0.000000 0.000000 214: $endl = "\n" unless defined $endl; 0 0.000000 0.000000 215: 0 0.000000 0.000000 216: my @result = (); 0 0.000000 0.000000 217: $self->scan(sub { 0 0.000000 0.000000 218: my($field, $val) = @_; 0 0.000000 0.000000 219: if ($val =~ /\n/) { 0 0.000000 0.000000 220: # must handle header values with 0 0.000000 0.000000 221: $val =~ s/\s+$//; # trailing 0 0.000000 0.000000 222: $val =~ s/\n\n+/\n/g; # no empty 0 0.000000 0.000000 223: $val =~ s/\n([^\040\t])/\n $1/g; # 0 0.000000 0.000000 224: $val =~ s/\n/$endl/g; # substitute ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Headers.pm Page 67 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 225: } 0 0.000000 0.000000 226: push(@result, "$field: $val"); 0 0.000000 0.000000 227: }); 0 0.000000 0.000000 228: 0 0.000000 0.000000 229: join($endl, @result, ''); 0 0.000000 0.000000 230:} 0 0.000000 0.000000 231: 0 0.000000 0.000000 232: 0 0.000000 0.000000 233:sub clone 384 0.000000 0.000000 234:{ 384 0.001437 0.000000 235: my $self = shift; 384 0.002494 0.000000 236: my $clone = new HTTP::Headers; 1152 0.007533 0.030000 237: $self->scan(sub { $clone- 384 0.002203 0.010000 238: $clone; 0 0.000000 0.000000 239:} 0 0.000000 0.000000 240: 0 0.000000 0.000000 241: 0 0.000000 0.000000 242:sub _date_header 0 0.000000 0.000000 243:{ 0 0.000000 0.000000 244: require HTTP::Date; 0 0.000000 0.000000 245: my($self, $header, $time) = @_; 0 0.000000 0.000000 246: my($old) = $self->_header($header); 0 0.000000 0.000000 247: if (defined $time) { 0 0.000000 0.000000 248: $self->_header($header, 0 0.000000 0.000000 249: } 0 0.000000 0.000000 250: HTTP::Date::str2time($old); 0 0.000000 0.000000 251:} 0 0.000000 0.000000 252: 0 0.000000 0.000000 253: 0 0.000000 0.000000 254:sub date { shift- 0 0.000000 0.000000 255:sub expires { shift- 0 0.000000 0.000000 256:sub if_modified_since { shift- 0 0.000000 0.000000 257:sub if_unmodified_since { shift- 0 0.000000 0.000000 258:sub last_modified { shift- 0 0.000000 0.000000 259: 0 0.000000 0.000000 260:# This is used as a private LWP extention. 0 0.000000 0.000000 261:# added as a timestamp to a response when it 0 0.000000 0.000000 262:sub client_date { shift- 0 0.000000 0.000000 263: 0 0.000000 0.000000 264:# The retry_after field is dual format (can 0 0.000000 0.000000 265:# number of seconds from now), so we don't 0 0.000000 0.000000 266:# access it until we have know how both these 0 0.000000 0.000000 267:# addressed. One possibility is to return a 0 0.000000 0.000000 268:# relative seconds and a positive value for 0 0.000000 0.000000 269:#sub retry_after { shift- 0 0.000000 0.000000 270: 351 0.000000 0.000000 271:sub content_type { 351 0.002034 0.000000 272: my $ct = (shift->_header('Content-Type', 351 0.001234 0.000000 273: return '' unless defined($ct) && 345 0.003475 0.010000 274: my @ct = split(/;\s*/, $ct, 2); 345 0.001295 0.000000 275: for ($ct[0]) { 345 0.001399 0.000000 276: s/\s+//g; 345 0.001740 0.010000 277: $_ = lc($_); 0 0.000000 0.000000 278: } 345 0.002762 0.010000 279: wantarray ? @ct : $ct[0]; 0 0.000000 0.000000 280:} ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Headers.pm Page 68 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 281: 0 0.000000 0.000000 282:sub referer { 0 0.000000 0.000000 283: my $self = shift; 0 0.000000 0.000000 284: if (@_ && $_[0] =~ /#/) { 0 0.000000 0.000000 285: # Strip fragment per RFC 2616, section 0 0.000000 0.000000 286: my $uri = shift; 0 0.000000 0.000000 287: if (ref($uri)) { 0 0.000000 0.000000 288: $uri = $uri->clone; 0 0.000000 0.000000 289: $uri->fragment(undef); 0 0.000000 0.000000 290: } 0 0.000000 0.000000 291: else { 0 0.000000 0.000000 292: $uri =~ s/\#.*//; 0 0.000000 0.000000 293: } 0 0.000000 0.000000 294: unshift @_, $uri; 0 0.000000 0.000000 295: } 0 0.000000 0.000000 296: ($self->_header('Referer', @_))[0]; 0 0.000000 0.000000 297:} 0 0.000000 0.000000 298:*referrer = \&referer; # on tchrist's 0 0.000000 0.000000 299: 0 0.000000 0.000000 300:sub title { (shift- 0 0.000000 0.000000 301:sub content_encoding { (shift- 0 0.000000 0.000000 302:sub content_language { (shift- 0 0.000000 0.000000 303:sub content_length { (shift- 0 0.000000 0.000000 304: 0 0.000000 0.000000 305:sub user_agent { (shift- 0 0.000000 0.000000 306:sub server { (shift- 0 0.000000 0.000000 307: 0 0.000000 0.000000 308:sub from { (shift- 0 0.000000 0.000000 309:sub warning { (shift- 0 0.000000 0.000000 310: 0 0.000000 0.000000 311:sub www_authenticate { (shift->_header('WWW- 0 0.000000 0.000000 312:sub authorization { (shift- 0 0.000000 0.000000 313: 0 0.000000 0.000000 314:sub proxy_authenticate { (shift- 0 0.000000 0.000000 315:sub proxy_authorization { (shift- 0 0.000000 0.000000 316: 0 0.000000 0.000000 317:sub authorization_basic { shift- 0 0.000000 0.000000 318:sub proxy_authorization_basic { shift- 0 0.000000 0.000000 319: 0 0.000000 0.000000 320:sub _basic_auth { 0 0.000000 0.000000 321: require MIME::Base64; 0 0.000000 0.000000 322: my($self, $h, $user, $passwd) = @_; 0 0.000000 0.000000 323: my($old) = $self->_header($h); 0 0.000000 0.000000 324: if (defined $user) { 0 0.000000 0.000000 325: Carp::croak("Basic authorization user name 0 0.000000 0.000000 326: if $user =~ /:/; 0 0.000000 0.000000 327: $passwd = '' unless defined $passwd; 0 0.000000 0.000000 328: $self->_header($h => 'Basic ' . 0 0.000000 0.000000 329: 0 0.000000 0.000000 330: } 0 0.000000 0.000000 331: if (defined $old && $old =~ 0 0.000000 0.000000 332: my $val = MIME::Base64::decode($old); 0 0.000000 0.000000 333: return $val unless wantarray; 0 0.000000 0.000000 334: return split(/:/, $val, 2); 0 0.000000 0.000000 335: } 0 0.000000 0.000000 336: return; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Headers.pm Page 69 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 337:} 0 0.000000 0.000000 338: 0 0.000000 0.000000 339: 0 0.000000 0.000000 340:1; 0 0.000000 0.000000 341: 0 0.000000 0.000000 342:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Message.pm Page 70 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package HTTP::Message; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:# $Id: Message.pm,v 1.42 2004/04/09 15:07:04 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:use strict; 0 0.000000 0.000000 6:use vars qw($VERSION $AUTOLOAD); 0 0.000000 0.000000 7:$VERSION = sprintf("%d.%02d", q$Revision: 0 0.000000 0.000000 8: 0 0.000000 0.000000 9:require HTTP::Headers; 0 0.000000 0.000000 10:require Carp; 0 0.000000 0.000000 11: 0 0.000000 0.000000 12:my $CRLF = "\015\012"; # "\r\n" is not 0 0.000000 0.000000 13:$HTTP::URI_CLASS ||= 0 0.000000 0.000000 14:eval "require $HTTP::URI_CLASS"; die $@ if 0 0.000000 0.000000 15: 0 0.000000 0.000000 16: 0 0.000000 0.000000 17: 0 0.000000 0.000000 18:sub new 774 0.000000 0.000000 19:{ 774 0.003276 0.000000 20: my($class, $header, $content) = @_; 774 0.002522 0.020000 21: if (defined $header) { 29 0.000096 0.000000 22: Carp::croak("Bad header argument") unless 29 0.000134 0.000000 23: if (ref($header) eq "ARRAY") { 0 0.000000 0.000000 24: $header = HTTP::Headers->new(@$header); 0 0.000000 0.000000 25: } 0 0.000000 0.000000 26: else { 29 0.000187 0.000000 27: $header = $header->clone; 0 0.000000 0.000000 28: } 0 0.000000 0.000000 29: } 0 0.000000 0.000000 30: else { 745 0.004922 0.000000 31: $header = HTTP::Headers->new; 0 0.000000 0.000000 32: } 774 0.002448 0.010000 33: $content = '' unless defined $content; 0 0.000000 0.000000 34: 774 0.008751 0.020000 35: bless { 0 0.000000 0.000000 36: '_headers' => $header, 0 0.000000 0.000000 37: '_content' => $content, 0 0.000000 0.000000 38: }, $class; 0 0.000000 0.000000 39:} 0 0.000000 0.000000 40: 0 0.000000 0.000000 41: 0 0.000000 0.000000 42:sub parse 0 0.000000 0.000000 43:{ 0 0.000000 0.000000 44: my($class, $str) = @_; 0 0.000000 0.000000 45: 0 0.000000 0.000000 46: my @hdr; 0 0.000000 0.000000 47: while (1) { 0 0.000000 0.000000 48: if ($str =~ s/^([^ \t:]+)[ \t]*: ?(.*)\n?//) 0 0.000000 0.000000 49: push(@hdr, $1, $2); 0 0.000000 0.000000 50: $hdr[-1] =~ s/\r\z//; 0 0.000000 0.000000 51: } 0 0.000000 0.000000 52: elsif (@hdr && $str =~ s/^([ \t].*)\n?//) { 0 0.000000 0.000000 53: $hdr[-1] .= "\n$1"; 0 0.000000 0.000000 54: $hdr[-1] =~ s/\r\z//; 0 0.000000 0.000000 55: } 0 0.000000 0.000000 56: else { ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Message.pm Page 71 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: $str =~ s/^\r?\n//; 0 0.000000 0.000000 58: last; 0 0.000000 0.000000 59: } 0 0.000000 0.000000 60: } 0 0.000000 0.000000 61: 0 0.000000 0.000000 62: new($class, \@hdr, $str); 0 0.000000 0.000000 63:} 0 0.000000 0.000000 64: 0 0.000000 0.000000 65: 0 0.000000 0.000000 66:sub clone 29 0.000000 0.000000 67:{ 29 0.000094 0.000000 68: my $self = shift; 29 0.000182 0.000000 69: my $clone = HTTP::Message->new($self- 0 0.000000 0.000000 70: $self->content); 29 0.000233 0.000000 71: $clone; 0 0.000000 0.000000 72:} 0 0.000000 0.000000 73: 0 0.000000 0.000000 74: 0 0.000000 0.000000 75:sub clear { 0 0.000000 0.000000 76: my $self = shift; 0 0.000000 0.000000 77: $self->{_headers}->clear; 0 0.000000 0.000000 78: $self->{_content} = ""; 0 0.000000 0.000000 79: delete $self->{_parts}; 0 0.000000 0.000000 80: return; 0 0.000000 0.000000 81:} 0 0.000000 0.000000 82: 0 0.000000 0.000000 83: 702 0.001963 0.000000 84:sub protocol { shift->_elem('_protocol', 0 0.000000 0.000000 85: 268 0.000000 0.000000 86:sub content { 268 0.000982 0.000000 87: my $self = shift; 268 0.001112 0.000000 88: if (defined(wantarray) && !exists $self- 0 0.000000 0.000000 89: $self->_content; 0 0.000000 0.000000 90: } 268 0.003869 0.000000 91: my $old = $self->{_content}; 268 0.000801 0.010000 92: if (@_) { 36 0.000206 0.000000 93: $self->{_content} = shift; 36 0.000119 0.000000 94: delete $self->{_parts}; 0 0.000000 0.000000 95: } 268 0.005559 0.000000 96: $old; 0 0.000000 0.000000 97:} 0 0.000000 0.000000 98: 0 0.000000 0.000000 99: 0 0.000000 0.000000 100:sub add_content 2737 0.000000 0.000000 101:{ 2737 0.009296 0.060000 102: my $self = shift; 2737 0.010917 0.010000 103: $self->_content unless exists $self- 2737 0.008124 0.020000 104: if (ref($_[0])) { 0 0.000000 0.000000 105: $self->{'_content'} .= ${$_[0]}; # for 0 0.000000 0.000000 106: } 0 0.000000 0.000000 107: else { 2737 0.021789 0.070000 108: $self->{'_content'} .= $_[0]; 0 0.000000 0.000000 109: } 2737 0.013818 0.010000 110: delete $self->{_parts}; 0 0.000000 0.000000 111:} 0 0.000000 0.000000 112: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Message.pm Page 72 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113: 0 0.000000 0.000000 114:sub content_ref 355 0.000000 0.000000 115:{ 355 0.001274 0.000000 116: my $self = shift; 355 0.001332 0.010000 117: $self->_content unless exists $self- 355 0.001231 0.000000 118: delete $self->{_parts}; 355 0.002821 0.010000 119: \$self->{'_content'}; 0 0.000000 0.000000 120:} 0 0.000000 0.000000 121: 0 0.000000 0.000000 122: 0 0.000000 0.000000 123:sub as_string 0 0.000000 0.000000 124:{ 0 0.000000 0.000000 125: my($self, $eol) = @_; 0 0.000000 0.000000 126: $eol = "\n" unless defined $eol; 0 0.000000 0.000000 127: 0 0.000000 0.000000 128: # The calculation of content might update 0 0.000000 0.000000 129: # so we need to do that first. 0 0.000000 0.000000 130: my $content = $self->content; 0 0.000000 0.000000 131: 0 0.000000 0.000000 132: return join("", $self->{'_headers'}- 0 0.000000 0.000000 133: $eol, 0 0.000000 0.000000 134: $content, 0 0.000000 0.000000 135: (@_ == 1 && length($content) && 0 0.000000 0.000000 136: $content !~ /\n\z/) ? "\n" : "", 0 0.000000 0.000000 137: ); 0 0.000000 0.000000 138:} 0 0.000000 0.000000 139: 0 0.000000 0.000000 140: 768 0.002788 0.010000 141:sub headers { shift->{'_headers'}; 0 0.000000 0.000000 142:sub headers_as_string { shift->{'_headers'}- 0 0.000000 0.000000 143: 0 0.000000 0.000000 144: 0 0.000000 0.000000 145:sub parts { 0 0.000000 0.000000 146: my $self = shift; 0 0.000000 0.000000 147: if (defined(wantarray) && !exists $self- 0 0.000000 0.000000 148: $self->_parts; 0 0.000000 0.000000 149: } 0 0.000000 0.000000 150: my $old = $self->{_parts}; 0 0.000000 0.000000 151: if (@_) { 0 0.000000 0.000000 152: my @parts = map { ref($_) eq 'ARRAY' ? @$_ : 0 0.000000 0.000000 153: my $ct = $self->content_type || ""; 0 0.000000 0.000000 154: if ($ct =~ m,^message/,) { 0 0.000000 0.000000 155: Carp::croak("Only one part allowed for 0 0.000000 0.000000 156: if @parts > 1; 0 0.000000 0.000000 157: } 0 0.000000 0.000000 158: elsif ($ct !~ m,^multipart/,) { 0 0.000000 0.000000 159: $self->remove_content_headers; 0 0.000000 0.000000 160: $self->content_type("multipart/mixed"); 0 0.000000 0.000000 161: } 0 0.000000 0.000000 162: $self->{_parts} = \@parts; 0 0.000000 0.000000 163: delete $self->{_content}; 0 0.000000 0.000000 164: } 0 0.000000 0.000000 165: return @$old if wantarray; 0 0.000000 0.000000 166: return $old->[0]; 0 0.000000 0.000000 167:} 0 0.000000 0.000000 168: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Message.pm Page 73 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169:sub add_part { 0 0.000000 0.000000 170: my $self = shift; 0 0.000000 0.000000 171: if (($self->content_type || "") !~ 0 0.000000 0.000000 172: my $p = HTTP::Message->new($self- 0 0.000000 0.000000 173: $self->content("")); 0 0.000000 0.000000 174: $self->content_type("multipart/mixed"); 0 0.000000 0.000000 175: $self->{_parts} = [$p]; 0 0.000000 0.000000 176: } 0 0.000000 0.000000 177: elsif (!exists $self->{_parts}) { 0 0.000000 0.000000 178: $self->_parts; 0 0.000000 0.000000 179: } 0 0.000000 0.000000 180: 0 0.000000 0.000000 181: push(@{$self->{_parts}}, @_); 0 0.000000 0.000000 182: delete $self->{_content}; 0 0.000000 0.000000 183: return; 0 0.000000 0.000000 184:} 0 0.000000 0.000000 185: 0 0.000000 0.000000 186: 0 0.000000 0.000000 187:# delegate all other method calls the the 0 0.000000 0.000000 188:sub AUTOLOAD 779 0.000000 0.000000 189:{ 779 0.003968 0.010000 190: my $method = substr($AUTOLOAD, 779 0.004833 0.020000 191: return if $method eq "DESTROY"; 0 0.000000 0.000000 192: 0 0.000000 0.000000 193: # We create the function here so that it 0 0.000000 0.000000 194: # autoloaded the next time. 0 0.000000 0.000000 195: no strict 'refs'; 5 0.000554 0.000000 196: *$method = eval "sub { shift- 5 0.000053 0.000000 197: goto &$method; 0 0.000000 0.000000 198:} 0 0.000000 0.000000 199: 0 0.000000 0.000000 200: 0 0.000000 0.000000 201:# Private method to access members in %$self 0 0.000000 0.000000 202:sub _elem 3643 0.000000 0.000000 203:{ 3643 0.012860 0.060000 204: my $self = shift; 3643 0.010272 0.040000 205: my $elem = shift; 3643 0.011693 0.050000 206: my $old = $self->{$elem}; 3643 0.014297 0.020000 207: $self->{$elem} = $_[0] if @_; 3643 0.022855 0.030000 208: return $old; 0 0.000000 0.000000 209:} 0 0.000000 0.000000 210: 0 0.000000 0.000000 211: 0 0.000000 0.000000 212:# Create private _parts attribute from 0 0.000000 0.000000 213:sub _parts { 0 0.000000 0.000000 214: my $self = shift; 0 0.000000 0.000000 215: my $ct = $self->content_type; 0 0.000000 0.000000 216: if ($ct =~ m,^multipart/,) { 0 0.000000 0.000000 217: require HTTP::Headers::Util; 0 0.000000 0.000000 218: my @h = 0 0.000000 0.000000 219: die "Assert" unless @h; 0 0.000000 0.000000 220: my %h = @{$h[0]}; 0 0.000000 0.000000 221: if (defined(my $b = $h{boundary})) { 0 0.000000 0.000000 222: my $str = $self->{_content}; 0 0.000000 0.000000 223: $str =~ s/\r?\n--\Q$b\E--\r?\n.*//s; 0 0.000000 0.000000 224: if ($str =~ s/(^|.*?\r?\n)-- ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Message.pm Page 74 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 225: $self->{_parts} = [map HTTP::Message- 0 0.000000 0.000000 226: split(/\r?\n--\Q$b\E\r?\n/, $str)] 0 0.000000 0.000000 227: } 0 0.000000 0.000000 228: } 0 0.000000 0.000000 229: } 0 0.000000 0.000000 230: elsif ($ct eq "message/http") { 0 0.000000 0.000000 231: require HTTP::Request; 0 0.000000 0.000000 232: require HTTP::Response; 0 0.000000 0.000000 233: my $class = ($self->{_content} =~ 0 0.000000 0.000000 234: "HTTP::Response" : "HTTP::Request"; 0 0.000000 0.000000 235: $self->{_parts} = [$class->parse($self- 0 0.000000 0.000000 236: } 0 0.000000 0.000000 237: elsif ($ct =~ m,^message/,) { 0 0.000000 0.000000 238: $self->{_parts} = [ HTTP::Message- 0 0.000000 0.000000 239: } 0 0.000000 0.000000 240: 0 0.000000 0.000000 241: $self->{_parts} ||= []; 0 0.000000 0.000000 242:} 0 0.000000 0.000000 243: 0 0.000000 0.000000 244: 0 0.000000 0.000000 245:# Create private _content attribute from 0 0.000000 0.000000 246:sub _content { 0 0.000000 0.000000 247: my $self = shift; 0 0.000000 0.000000 248: my $ct = $self->header("Content-Type") || 0 0.000000 0.000000 249: if ($ct =~ m,^\s*message/,i) { 0 0.000000 0.000000 250: $self->{_content} = $self->{_parts}[0]- 0 0.000000 0.000000 251: return; 0 0.000000 0.000000 252: } 0 0.000000 0.000000 253: 0 0.000000 0.000000 254: require HTTP::Headers::Util; 0 0.000000 0.000000 255: my @v = 0 0.000000 0.000000 256: Carp::carp("Multiple Content-Type 0 0.000000 0.000000 257: @v = @{$v[0]}; 0 0.000000 0.000000 258: 0 0.000000 0.000000 259: my $boundary; 0 0.000000 0.000000 260: my $boundary_index; 0 0.000000 0.000000 261: for (my @tmp = @v; @tmp;) { 0 0.000000 0.000000 262: my($k, $v) = splice(@tmp, 0, 2); 0 0.000000 0.000000 263: if (lc($k) eq "boundary") { 0 0.000000 0.000000 264: $boundary = $v; 0 0.000000 0.000000 265: $boundary_index = @v - @tmp - 1; 0 0.000000 0.000000 266: last; 0 0.000000 0.000000 267: } 0 0.000000 0.000000 268: } 0 0.000000 0.000000 269: 0 0.000000 0.000000 270: my @parts = map $_->as_string($CRLF), 0 0.000000 0.000000 271: 0 0.000000 0.000000 272: my $bno = 0; 0 0.000000 0.000000 273: $boundary = _boundary() unless defined 0 0.000000 0.000000 274: CHECK_BOUNDARY: 0 0.000000 0.000000 275: { 0 0.000000 0.000000 276: for (@parts) { 0 0.000000 0.000000 277: if (index($_, $boundary) >= 0) { 0 0.000000 0.000000 278: # must have a better boundary 0 0.000000 0.000000 279: $boundary = _boundary(++$bno); 0 0.000000 0.000000 280: redo CHECK_BOUNDARY; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Message.pm Page 75 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 281: } 0 0.000000 0.000000 282: } 0 0.000000 0.000000 283: } 0 0.000000 0.000000 284: 0 0.000000 0.000000 285: if ($boundary_index) { 0 0.000000 0.000000 286: $v[$boundary_index] = $boundary; 0 0.000000 0.000000 287: } 0 0.000000 0.000000 288: else { 0 0.000000 0.000000 289: push(@v, boundary => $boundary); 0 0.000000 0.000000 290: } 0 0.000000 0.000000 291: 0 0.000000 0.000000 292: $ct = 0 0.000000 0.000000 293: $self->header("Content-Type", $ct); 0 0.000000 0.000000 294: 0 0.000000 0.000000 295: $self->{_content} = "--$boundary$CRLF" . 0 0.000000 0.000000 296: join("$CRLF-- 0 0.000000 0.000000 297: "$CRLF--$boundary--$CRLF"; 0 0.000000 0.000000 298:} 0 0.000000 0.000000 299: 0 0.000000 0.000000 300: 0 0.000000 0.000000 301:sub _boundary 0 0.000000 0.000000 302:{ 0 0.000000 0.000000 303: my $size = shift || return "xYzZY"; 0 0.000000 0.000000 304: require MIME::Base64; 0 0.000000 0.000000 305: my $b = MIME::Base64::encode(join("", map 0 0.000000 0.000000 306: $b =~ s/[\W]/X/g; # ensure alnum only 0 0.000000 0.000000 307: $b; 0 0.000000 0.000000 308:} 0 0.000000 0.000000 309: 0 0.000000 0.000000 310: 0 0.000000 0.000000 311:1; 0 0.000000 0.000000 312: 0 0.000000 0.000000 313: 0 0.000000 0.000000 314:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Request.pm Page 76 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package HTTP::Request; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:# $Id: Request.pm,v 1.40 2004/04/07 10:44:47 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:require HTTP::Message; 0 0.000000 0.000000 6:@ISA = qw(HTTP::Message); 0 0.000000 0.000000 7:$VERSION = sprintf("%d.%02d", q$Revision: 0 0.000000 0.000000 8: 0 0.000000 0.000000 9:use strict; 0 0.000000 0.000000 10: 0 0.000000 0.000000 11: 0 0.000000 0.000000 12: 0 0.000000 0.000000 13:sub new 358 0.000000 0.000000 14:{ 358 0.002004 0.000000 15: my($class, $method, $uri, $header, 358 0.002361 0.000000 16: my $self = $class->SUPER::new($header, 358 0.002354 0.000000 17: $self->method($method); 358 0.002164 0.000000 18: $self->uri($uri); 358 0.001779 0.000000 19: $self; 0 0.000000 0.000000 20:} 0 0.000000 0.000000 21: 0 0.000000 0.000000 22: 0 0.000000 0.000000 23:sub parse 0 0.000000 0.000000 24:{ 0 0.000000 0.000000 25: my($class, $str) = @_; 0 0.000000 0.000000 26: my $request_line; 0 0.000000 0.000000 27: if ($str =~ s/^(.*)\n//) { 0 0.000000 0.000000 28: $request_line = $1; 0 0.000000 0.000000 29: } 0 0.000000 0.000000 30: else { 0 0.000000 0.000000 31: $request_line = $str; 0 0.000000 0.000000 32: $str = ""; 0 0.000000 0.000000 33: } 0 0.000000 0.000000 34: 0 0.000000 0.000000 35: my $self = $class->SUPER::parse($str); 0 0.000000 0.000000 36: my($method, $uri, $protocol) = split(' ', 0 0.000000 0.000000 37: $self->method($method) if 0 0.000000 0.000000 38: $self->uri($uri) if defined($uri); 0 0.000000 0.000000 39: $self->protocol($protocol) if $protocol; 0 0.000000 0.000000 40: $self; 0 0.000000 0.000000 41:} 0 0.000000 0.000000 42: 0 0.000000 0.000000 43: 0 0.000000 0.000000 44:sub clone 29 0.000000 0.000000 45:{ 29 0.000105 0.000000 46: my $self = shift; 29 0.000193 0.000000 47: my $clone = bless $self->SUPER::clone, 29 0.000183 0.000000 48: $clone->method($self->method); 29 0.000173 0.000000 49: $clone->uri($self->uri); 29 0.000160 0.000000 50: $clone; 0 0.000000 0.000000 51:} 0 0.000000 0.000000 52: 0 0.000000 0.000000 53: 0 0.000000 0.000000 54:sub method 1238 0.000000 0.000000 55:{ 1238 0.007146 0.010000 56: shift->_elem('_method', @_); ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Request.pm Page 77 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57:} 0 0.000000 0.000000 58: 0 0.000000 0.000000 59: 0 0.000000 0.000000 60:sub uri 1277 0.000000 0.000000 61:{ 1277 0.004913 0.030000 62: my $self = shift; 1277 0.004433 0.010000 63: my $old = $self->{'_uri'}; 1277 0.003853 0.020000 64: if (@_) { 416 0.001454 0.010000 65: my $uri = shift; 416 0.001592 0.000000 66: if (!defined $uri) { 0 0.000000 0.000000 67: # that's ok 0 0.000000 0.000000 68: } 0 0.000000 0.000000 69: elsif (ref $uri) { 58 0.000254 0.000000 70: Carp::croak("A URI can't be a " . 0 0.000000 0.000000 71: if ref($uri) eq 'HASH' or ref($uri) eq 58 0.000500 0.000000 72: Carp::croak("Can't use a " . ref($uri) . 0 0.000000 0.000000 73: unless $uri->can('scheme'); 58 0.000333 0.000000 74: $uri = $uri->clone; 58 0.000210 0.000000 75: unless ($HTTP::URI_CLASS eq "URI") { 0 0.000000 0.000000 76: # Argh!! Hate this... old LWP legacy! 0 0.000000 0.000000 77: eval { local $SIG{__DIE__}; $uri = $uri- 0 0.000000 0.000000 78: die $@ if $@ && $@ !~ /Missing base 0 0.000000 0.000000 79: } 0 0.000000 0.000000 80: } 0 0.000000 0.000000 81: else { 358 0.002332 0.000000 82: $uri = $HTTP::URI_CLASS->new($uri); 0 0.000000 0.000000 83: } 416 0.002105 0.000000 84: $self->{'_uri'} = $uri; 0 0.000000 0.000000 85: } 1277 0.006817 0.010000 86: $old; 0 0.000000 0.000000 87:} 0 0.000000 0.000000 88: 0 0.000000 0.000000 89:*url = \&uri; # legacy 0 0.000000 0.000000 90: 0 0.000000 0.000000 91: 0 0.000000 0.000000 92:sub as_string 0 0.000000 0.000000 93:{ 0 0.000000 0.000000 94: my $self = shift; 0 0.000000 0.000000 95: my($eol) = @_; 0 0.000000 0.000000 96: $eol = "\n" unless defined $eol; 0 0.000000 0.000000 97: 0 0.000000 0.000000 98: my $req_line = $self->method || "-"; 0 0.000000 0.000000 99: my $uri = $self->uri; 0 0.000000 0.000000 100: $uri = (defined $uri) ? $uri->as_string : 0 0.000000 0.000000 101: $req_line .= " $uri"; 0 0.000000 0.000000 102: my $proto = $self->protocol; 0 0.000000 0.000000 103: $req_line .= " $proto" if $proto; 0 0.000000 0.000000 104: 0 0.000000 0.000000 105: return join($eol, $req_line, $self- 0 0.000000 0.000000 106:} 0 0.000000 0.000000 107: 0 0.000000 0.000000 108: 0 0.000000 0.000000 109:1; 0 0.000000 0.000000 110: 0 0.000000 0.000000 111:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Response.pm Page 78 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package HTTP::Response; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:# $Id: Response.pm,v 1.49 2004/04/09 20:30:41 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:require HTTP::Message; 0 0.000000 0.000000 6:@ISA = qw(HTTP::Message); 0 0.000000 0.000000 7:$VERSION = sprintf("%d.%02d", q$Revision: 0 0.000000 0.000000 8: 0 0.000000 0.000000 9:use strict; 0 0.000000 0.000000 10:use HTTP::Status (); 0 0.000000 0.000000 11: 0 0.000000 0.000000 12: 0 0.000000 0.000000 13: 0 0.000000 0.000000 14:sub new 387 0.000000 0.000000 15:{ 387 0.002791 0.010000 16: my($class, $rc, $msg, $header, $content) 387 0.002722 0.000000 17: my $self = $class->SUPER::new($header, 387 0.002552 0.020000 18: $self->code($rc); 387 0.002708 0.000000 19: $self->message($msg); 387 0.002306 0.000000 20: $self; 0 0.000000 0.000000 21:} 0 0.000000 0.000000 22: 0 0.000000 0.000000 23: 0 0.000000 0.000000 24:sub parse 0 0.000000 0.000000 25:{ 0 0.000000 0.000000 26: my($class, $str) = @_; 0 0.000000 0.000000 27: my $status_line; 0 0.000000 0.000000 28: if ($str =~ s/^(.*)\n//) { 0 0.000000 0.000000 29: $status_line = $1; 0 0.000000 0.000000 30: } 0 0.000000 0.000000 31: else { 0 0.000000 0.000000 32: $status_line = $str; 0 0.000000 0.000000 33: $str = ""; 0 0.000000 0.000000 34: } 0 0.000000 0.000000 35: 0 0.000000 0.000000 36: my $self = $class->SUPER::parse($str); 0 0.000000 0.000000 37: my($protocol, $code, $message) = split(' 0 0.000000 0.000000 38: $self->protocol($protocol) if $protocol; 0 0.000000 0.000000 39: $self->code($code) if defined($code); 0 0.000000 0.000000 40: $self->message($message) if 0 0.000000 0.000000 41: $self; 0 0.000000 0.000000 42:} 0 0.000000 0.000000 43: 0 0.000000 0.000000 44: 0 0.000000 0.000000 45:sub clone 0 0.000000 0.000000 46:{ 0 0.000000 0.000000 47: my $self = shift; 0 0.000000 0.000000 48: my $clone = bless $self->SUPER::clone, 0 0.000000 0.000000 49: $clone->code($self->code); 0 0.000000 0.000000 50: $clone->message($self->message); 0 0.000000 0.000000 51: $clone->request($self->request->clone) if 0 0.000000 0.000000 52: # we don't clone previous 0 0.000000 0.000000 53: $clone; 0 0.000000 0.000000 54:} 0 0.000000 0.000000 55: 0 0.000000 0.000000 56: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Response.pm Page 79 ================================================================= count wall tm cpu time line 1548 0.004940 0.010000 57:sub code { shift->_elem('_rc', @_); 774 0.002193 0.000000 58:sub message { shift->_elem('_msg', @_); 122 0.000370 0.000000 59:sub previous { shift->_elem('_previous',@_); 1664 0.004933 0.000000 60:sub request { shift->_elem('_request', @_); 0 0.000000 0.000000 61: 0 0.000000 0.000000 62: 0 0.000000 0.000000 63:sub status_line 0 0.000000 0.000000 64:{ 0 0.000000 0.000000 65: my $self = shift; 0 0.000000 0.000000 66: my $code = $self->{'_rc'} || "000"; 0 0.000000 0.000000 67: my $mess = $self->{'_msg'} || 0 0.000000 0.000000 68: return "$code $mess"; 0 0.000000 0.000000 69:} 0 0.000000 0.000000 70: 0 0.000000 0.000000 71: 0 0.000000 0.000000 72:sub base 29 0.000000 0.000000 73:{ 29 0.000107 0.000000 74: my $self = shift; 29 0.000098 0.000000 75: my $base = $self->header('Content-Base') 0 0.000000 0.000000 76: $self->header('Content- 0 0.000000 0.000000 77: $self->header('Base'); 29 0.000166 0.000000 78: return $HTTP::URI_CLASS->new_abs($base, 0 0.000000 0.000000 79: # So yes, if $base is undef, the return 0 0.000000 0.000000 80: # just a copy of $self->request->uri. 0 0.000000 0.000000 81:} 0 0.000000 0.000000 82: 0 0.000000 0.000000 83: 0 0.000000 0.000000 84:sub as_string 0 0.000000 0.000000 85:{ 0 0.000000 0.000000 86: require HTTP::Status; 0 0.000000 0.000000 87: my $self = shift; 0 0.000000 0.000000 88: my($eol) = @_; 0 0.000000 0.000000 89: $eol = "\n" unless defined $eol; 0 0.000000 0.000000 90: 0 0.000000 0.000000 91: my $code = $self->code; 0 0.000000 0.000000 92: my $status_message = 0 0.000000 0.000000 93: my $message = $self->message || ""; 0 0.000000 0.000000 94: 0 0.000000 0.000000 95: my $status_line = "$code"; 0 0.000000 0.000000 96: my $proto = $self->protocol; 0 0.000000 0.000000 97: $status_line = "$proto $status_line" if 0 0.000000 0.000000 98: $status_line .= " ($status_message)" if 0 0.000000 0.000000 99: $status_line .= " $message"; 0 0.000000 0.000000 100: 0 0.000000 0.000000 101: return join($eol, $status_line, $self- 0 0.000000 0.000000 102:} 0 0.000000 0.000000 103: 0 0.000000 0.000000 104: 0 0.000000 0.000000 105:sub is_info { HTTP::Status::is_info 716 0.002384 0.010000 106:sub is_success { HTTP::Status::is_success 0 0.000000 0.000000 107:sub is_redirect { HTTP::Status::is_redirect 0 0.000000 0.000000 108:sub is_error { HTTP::Status::is_error 0 0.000000 0.000000 109: 0 0.000000 0.000000 110: 0 0.000000 0.000000 111:sub error_as_HTML 0 0.000000 0.000000 112:{ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Response.pm Page 80 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113: my $self = shift; 0 0.000000 0.000000 114: my $title = 'An Error Occurred'; 0 0.000000 0.000000 115: my $body = $self->status_line; 0 0.000000 0.000000 116: return < 0 0.000000 0.000000 118:$title 0 0.000000 0.000000 119: 0 0.000000 0.000000 120:

$title

0 0.000000 0.000000 121:$body 0 0.000000 0.000000 122: 0 0.000000 0.000000 123: 0 0.000000 0.000000 124:EOM 0 0.000000 0.000000 125:} 0 0.000000 0.000000 126: 0 0.000000 0.000000 127: 0 0.000000 0.000000 128:sub current_age 0 0.000000 0.000000 129:{ 0 0.000000 0.000000 130: my $self = shift; 0 0.000000 0.000000 131: # Implementation of RFC 2616 section 0 0.000000 0.000000 132: # (age calculations) 0 0.000000 0.000000 133: my $response_time = $self->client_date; 0 0.000000 0.000000 134: my $date = $self->date; 0 0.000000 0.000000 135: 0 0.000000 0.000000 136: my $age = 0; 0 0.000000 0.000000 137: if ($response_time && $date) { 0 0.000000 0.000000 138: $age = $response_time - $date; # 0 0.000000 0.000000 139: $age = 0 if $age < 0; 0 0.000000 0.000000 140: } 0 0.000000 0.000000 141: 0 0.000000 0.000000 142: my $age_v = $self->header('Age'); 0 0.000000 0.000000 143: if ($age_v && $age_v > $age) { 0 0.000000 0.000000 144: $age = $age_v; # corrected_received_age 0 0.000000 0.000000 145: } 0 0.000000 0.000000 146: 0 0.000000 0.000000 147: my $request = $self->request; 0 0.000000 0.000000 148: if ($request) { 0 0.000000 0.000000 149: my $request_time = $request->date; 0 0.000000 0.000000 150: if ($request_time) { 0 0.000000 0.000000 151: # Add response_delay to age to get 0 0.000000 0.000000 152: $age += $response_time - $request_time; 0 0.000000 0.000000 153: } 0 0.000000 0.000000 154: } 0 0.000000 0.000000 155: if ($response_time) { 0 0.000000 0.000000 156: $age += time - $response_time; 0 0.000000 0.000000 157: } 0 0.000000 0.000000 158: return $age; 0 0.000000 0.000000 159:} 0 0.000000 0.000000 160: 0 0.000000 0.000000 161: 0 0.000000 0.000000 162:sub freshness_lifetime 0 0.000000 0.000000 163:{ 0 0.000000 0.000000 164: my $self = shift; 0 0.000000 0.000000 165: 0 0.000000 0.000000 166: # First look for the Cache-Control: max- 0 0.000000 0.000000 167: my @cc = $self->header('Cache-Control'); 0 0.000000 0.000000 168: if (@cc) { ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Response.pm Page 81 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169: my $cc; 0 0.000000 0.000000 170: for $cc (@cc) { 0 0.000000 0.000000 171: my $cc_dir; 0 0.000000 0.000000 172: for $cc_dir (split(/\s*,\s*/, $cc)) { 0 0.000000 0.000000 173: if ($cc_dir =~ /max-age\s*=\s*(\d+)/i) { 0 0.000000 0.000000 174: return $1; 0 0.000000 0.000000 175: } 0 0.000000 0.000000 176: } 0 0.000000 0.000000 177: } 0 0.000000 0.000000 178: } 0 0.000000 0.000000 179: 0 0.000000 0.000000 180: # Next possibility is to look at the 0 0.000000 0.000000 181: my $date = $self->date || $self- 0 0.000000 0.000000 182: my $expires = $self->expires; 0 0.000000 0.000000 183: unless ($expires) { 0 0.000000 0.000000 184: # Must apply heuristic expiration 0 0.000000 0.000000 185: my $last_modified = $self->last_modified; 0 0.000000 0.000000 186: if ($last_modified) { 0 0.000000 0.000000 187: my $h_exp = ($date - $last_modified) * 0 0.000000 0.000000 188: if ($h_exp < 60) { 0 0.000000 0.000000 189: return 60; # minimum 0 0.000000 0.000000 190: } 0 0.000000 0.000000 191: elsif ($h_exp > 24 * 3600) { 0 0.000000 0.000000 192: # Should give a warning if more than 24 0 0.000000 0.000000 193: # RFC 2616 section 13.2.4, but I don't know 0 0.000000 0.000000 194: # from this function interface, so I just 0 0.000000 0.000000 195: # maximum value. 0 0.000000 0.000000 196: return 24 * 3600; 0 0.000000 0.000000 197: } 0 0.000000 0.000000 198: return $h_exp; 0 0.000000 0.000000 199: } 0 0.000000 0.000000 200: else { 0 0.000000 0.000000 201: return 3600; # 1 hour is fallback when 0 0.000000 0.000000 202: } 0 0.000000 0.000000 203: } 0 0.000000 0.000000 204: return $expires - $date; 0 0.000000 0.000000 205:} 0 0.000000 0.000000 206: 0 0.000000 0.000000 207: 0 0.000000 0.000000 208:sub is_fresh 0 0.000000 0.000000 209:{ 0 0.000000 0.000000 210: my $self = shift; 0 0.000000 0.000000 211: $self->freshness_lifetime > $self- 0 0.000000 0.000000 212:} 0 0.000000 0.000000 213: 0 0.000000 0.000000 214: 0 0.000000 0.000000 215:sub fresh_until 0 0.000000 0.000000 216:{ 0 0.000000 0.000000 217: my $self = shift; 0 0.000000 0.000000 218: return $self->freshness_lifetime - $self- 0 0.000000 0.000000 219:} 0 0.000000 0.000000 220: 0 0.000000 0.000000 221:1; 0 0.000000 0.000000 222: 0 0.000000 0.000000 223: 0 0.000000 0.000000 224:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Status.pm Page 82 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package HTTP::Status; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:# $Id: Status.pm,v 1.28 2003/10/23 18:56:01 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:use strict; 0 0.000000 0.000000 6:require 5.002; # becase we use prototypes 0 0.000000 0.000000 7: 0 0.000000 0.000000 8:use vars qw(@ISA @EXPORT @EXPORT_OK 0 0.000000 0.000000 9: 0 0.000000 0.000000 10:require Exporter; 0 0.000000 0.000000 11:@ISA = qw(Exporter); 0 0.000000 0.000000 12:@EXPORT = qw(is_info is_success is_redirect 0 0.000000 0.000000 13:@EXPORT_OK = qw(is_client_error 0 0.000000 0.000000 14:$VERSION = sprintf("%d.%02d", q$Revision: 0 0.000000 0.000000 15: 0 0.000000 0.000000 16:# Note also addition of mnemonics to @EXPORT 0 0.000000 0.000000 17: 0 0.000000 0.000000 18:my %StatusCode = ( 0 0.000000 0.000000 19: 100 => 'Continue', 0 0.000000 0.000000 20: 101 => 'Switching Protocols', 0 0.000000 0.000000 21: 102 => 'Processing', 0 0.000000 0.000000 22: 200 => 'OK', 0 0.000000 0.000000 23: 201 => 'Created', 0 0.000000 0.000000 24: 202 => 'Accepted', 0 0.000000 0.000000 25: 203 => 'Non-Authoritative Information', 0 0.000000 0.000000 26: 204 => 'No Content', 0 0.000000 0.000000 27: 205 => 'Reset Content', 0 0.000000 0.000000 28: 206 => 'Partial Content', 0 0.000000 0.000000 29: 207 => 'Multi-Status', 0 0.000000 0.000000 30: 300 => 'Multiple Choices', 0 0.000000 0.000000 31: 301 => 'Moved Permanently', 0 0.000000 0.000000 32: 302 => 'Found', 0 0.000000 0.000000 33: 303 => 'See Other', 0 0.000000 0.000000 34: 304 => 'Not Modified', 0 0.000000 0.000000 35: 305 => 'Use Proxy', 0 0.000000 0.000000 36: 307 => 'Temporary Redirect', 0 0.000000 0.000000 37: 400 => 'Bad Request', 0 0.000000 0.000000 38: 401 => 'Unauthorized', 0 0.000000 0.000000 39: 402 => 'Payment Required', 0 0.000000 0.000000 40: 403 => 'Forbidden', 0 0.000000 0.000000 41: 404 => 'Not Found', 0 0.000000 0.000000 42: 405 => 'Method Not Allowed', 0 0.000000 0.000000 43: 406 => 'Not Acceptable', 0 0.000000 0.000000 44: 407 => 'Proxy Authentication Required', 0 0.000000 0.000000 45: 408 => 'Request Timeout', 0 0.000000 0.000000 46: 409 => 'Conflict', 0 0.000000 0.000000 47: 410 => 'Gone', 0 0.000000 0.000000 48: 411 => 'Length Required', 0 0.000000 0.000000 49: 412 => 'Precondition Failed', 0 0.000000 0.000000 50: 413 => 'Request Entity Too Large', 0 0.000000 0.000000 51: 414 => 'Request-URI Too Large', 0 0.000000 0.000000 52: 415 => 'Unsupported Media Type', 0 0.000000 0.000000 53: 416 => 'Request Range Not Satisfiable', 0 0.000000 0.000000 54: 417 => 'Expectation Failed', 0 0.000000 0.000000 55: 422 => 'Unprocessable Entity', 0 0.000000 0.000000 56: 423 => 'Locked', ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/HTTP/Status.pm Page 83 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: 424 => 'Failed Dependency', 0 0.000000 0.000000 58: 500 => 'Internal Server Error', 0 0.000000 0.000000 59: 501 => 'Not Implemented', 0 0.000000 0.000000 60: 502 => 'Bad Gateway', 0 0.000000 0.000000 61: 503 => 'Service Unavailable', 0 0.000000 0.000000 62: 504 => 'Gateway Timeout', 0 0.000000 0.000000 63: 505 => 'HTTP Version Not Supported', 0 0.000000 0.000000 64: 507 => 'Insufficient Storage', 0 0.000000 0.000000 65:); 0 0.000000 0.000000 66: 0 0.000000 0.000000 67:my $mnemonicCode = ''; 0 0.000000 0.000000 68:my ($code, $message); 0 0.000000 0.000000 69:while (($code, $message) = each %StatusCode) 0 0.000000 0.000000 70: # create mnemonic subroutines 0 0.000000 0.000000 71: $message =~ tr/a-z \-/A-Z__/; 0 0.000000 0.000000 72: $mnemonicCode .= "sub RC_$message () { 0 0.000000 0.000000 73: # make them exportable 0 0.000000 0.000000 74: $mnemonicCode .= "push(\@EXPORT, 0 0.000000 0.000000 75:} 0 0.000000 0.000000 76:# warn $mnemonicCode; # for development 0 0.000000 0.000000 77:eval $mnemonicCode; # only one eval for speed 0 0.000000 0.000000 78:die if $@; 0 0.000000 0.000000 79: 0 0.000000 0.000000 80:# backwards compatibility 0 0.000000 0.000000 81:*RC_MOVED_TEMPORARILY = \&RC_FOUND; # 302 0 0.000000 0.000000 82:push(@EXPORT, "RC_MOVED_TEMPORARILY"); 0 0.000000 0.000000 83: 0 0.000000 0.000000 84: 774 0.002326 0.010000 85:sub status_message ($) { $StatusCode{$_[0]}; 0 0.000000 0.000000 86: 0 0.000000 0.000000 87:sub is_info ($) { $_[0] >= 100 && 716 0.002858 0.000000 88:sub is_success ($) { $_[0] >= 200 && 0 0.000000 0.000000 89:sub is_redirect ($) { $_[0] >= 300 && 0 0.000000 0.000000 90:sub is_error ($) { $_[0] >= 400 && 0 0.000000 0.000000 91:sub is_client_error ($) { $_[0] >= 400 && 0 0.000000 0.000000 92:sub is_server_error ($) { $_[0] >= 500 && 0 0.000000 0.000000 93: 0 0.000000 0.000000 94:1; 0 0.000000 0.000000 95: 0 0.000000 0.000000 96: 0 0.000000 0.000000 97:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/Debug.pm Page 84 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package LWP::Debug; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:# $Id: Debug.pm,v 1.15 2004/04/09 15:07:04 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:require Exporter; 0 0.000000 0.000000 6:@ISA = qw(Exporter); 0 0.000000 0.000000 7:@EXPORT_OK = qw(level trace debug conns); 0 0.000000 0.000000 8: 0 0.000000 0.000000 9:use Carp (); 0 0.000000 0.000000 10: 0 0.000000 0.000000 11:my @levels = qw(trace debug conns); 0 0.000000 0.000000 12:%current_level = (); 0 0.000000 0.000000 13: 0 0.000000 0.000000 14: 0 0.000000 0.000000 15:sub import 0 0.000000 0.000000 16:{ 0 0.000000 0.000000 17: my $pack = shift; 0 0.000000 0.000000 18: my $callpkg = caller(0); 0 0.000000 0.000000 19: my @symbols = (); 0 0.000000 0.000000 20: my @levels = (); 0 0.000000 0.000000 21: for (@_) { 0 0.000000 0.000000 22: if (/^[-+]/) { 0 0.000000 0.000000 23: push(@levels, $_); 0 0.000000 0.000000 24: } 0 0.000000 0.000000 25: else { 0 0.000000 0.000000 26: push(@symbols, $_); 0 0.000000 0.000000 27: } 0 0.000000 0.000000 28: } 0 0.000000 0.000000 29: Exporter::export($pack, $callpkg, 0 0.000000 0.000000 30: level(@levels); 0 0.000000 0.000000 31:} 0 0.000000 0.000000 32: 0 0.000000 0.000000 33: 0 0.000000 0.000000 34:sub level 0 0.000000 0.000000 35:{ 0 0.000000 0.000000 36: for (@_) { 0 0.000000 0.000000 37: if ($_ eq '+') { # all on 0 0.000000 0.000000 38: # switch on all levels 0 0.000000 0.000000 39: %current_level = map { $_ => 1 } 0 0.000000 0.000000 40: } 0 0.000000 0.000000 41: elsif ($_ eq '-') { # all off 0 0.000000 0.000000 42: %current_level = (); 0 0.000000 0.000000 43: } 0 0.000000 0.000000 44: elsif (/^([-+])(\w+)$/) { 0 0.000000 0.000000 45: $current_level{$2} = $1 eq '+'; 0 0.000000 0.000000 46: } 0 0.000000 0.000000 47: else { 0 0.000000 0.000000 48: Carp::croak("Illegal level format $_"); 0 0.000000 0.000000 49: } 0 0.000000 0.000000 50: } 0 0.000000 0.000000 51:} 0 0.000000 0.000000 52: 0 0.000000 0.000000 53: 2902 0.007580 0.010000 54:sub trace { _log(@_) if 7022 0.018226 0.010000 55:sub debug { _log(@_) if 0 0.000000 0.000000 56:sub conns { _log(@_) if ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/Debug.pm Page 85 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: 0 0.000000 0.000000 58: 0 0.000000 0.000000 59:sub _log 0 0.000000 0.000000 60:{ 0 0.000000 0.000000 61: my $msg = shift; 0 0.000000 0.000000 62: $msg .= "\n" unless $msg =~ /\n$/; # 0 0.000000 0.000000 63: 0 0.000000 0.000000 64: my($package,$filename,$line,$sub) = 0 0.000000 0.000000 65: print STDERR "$sub: $msg"; 0 0.000000 0.000000 66:} 0 0.000000 0.000000 67: 0 0.000000 0.000000 68:1; 0 0.000000 0.000000 69: 0 0.000000 0.000000 70: 0 0.000000 0.000000 71:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/MemberMixin.p Page 86 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package LWP::MemberMixin; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:# $Id: MemberMixin.pm,v 1.8 2004/04/09 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:sub _elem 1383 0.000000 0.000000 6:{ 1383 0.004546 0.000000 7: my $self = shift; 1383 0.004025 0.020000 8: my $elem = shift; 1383 0.004744 0.020000 9: my $old = $self->{$elem}; 1383 0.004545 0.010000 10: $self->{$elem} = shift if @_; 1383 0.009009 0.030000 11: return $old; 0 0.000000 0.000000 12:} 0 0.000000 0.000000 13: 0 0.000000 0.000000 14:1; 0 0.000000 0.000000 15: 0 0.000000 0.000000 16:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/Protocol.pm Page 87 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package LWP::Protocol; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:# $Id: Protocol.pm,v 1.42 2004/04/09 15:07:04 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:require LWP::MemberMixin; 0 0.000000 0.000000 6:@ISA = qw(LWP::MemberMixin); 0 0.000000 0.000000 7:$VERSION = sprintf("%d.%02d", q$Revision: 0 0.000000 0.000000 8: 0 0.000000 0.000000 9:use strict; 0 0.000000 0.000000 10:use Carp (); 0 0.000000 0.000000 11:use HTTP::Status (); 0 0.000000 0.000000 12:use HTTP::Response; 0 0.000000 0.000000 13: 0 0.000000 0.000000 14:my %ImplementedBy = (); # scheme => classname 0 0.000000 0.000000 15: 0 0.000000 0.000000 16: 0 0.000000 0.000000 17: 0 0.000000 0.000000 18:sub new 387 0.000000 0.000000 19:{ 387 0.001675 0.000000 20: my($class, $scheme, $ua) = @_; 0 0.000000 0.000000 21: 387 0.004821 0.040000 22: my $self = bless { 0 0.000000 0.000000 23: scheme => $scheme, 0 0.000000 0.000000 24: ua => $ua, 0 0.000000 0.000000 25: 0 0.000000 0.000000 26: # historical/redundant 0 0.000000 0.000000 27: parse_head => $ua->{parse_head}, 0 0.000000 0.000000 28: max_size => $ua->{max_size}, 0 0.000000 0.000000 29: }, $class; 0 0.000000 0.000000 30: 387 0.001948 0.000000 31: $self; 0 0.000000 0.000000 32:} 0 0.000000 0.000000 33: 0 0.000000 0.000000 34: 0 0.000000 0.000000 35:sub create 387 0.000000 0.000000 36:{ 387 0.001567 0.000000 37: my($scheme, $ua) = @_; 387 0.002473 0.000000 38: my $impclass = 0 0.000000 0.000000 39: Carp::croak("Protocol scheme '$scheme' is 0 0.000000 0.000000 40: 0 0.000000 0.000000 41: # hand-off to scheme specific 387 0.002469 0.010000 42: my $protocol = $impclass->new($scheme, 0 0.000000 0.000000 43: 387 0.002381 0.010000 44: return $protocol; 0 0.000000 0.000000 45:} 0 0.000000 0.000000 46: 0 0.000000 0.000000 47: 0 0.000000 0.000000 48:sub implementor 387 0.000000 0.000000 49:{ 387 0.001425 0.000000 50: my($scheme, $impclass) = @_; 0 0.000000 0.000000 51: 387 0.001141 0.020000 52: if ($impclass) { 0 0.000000 0.000000 53: $ImplementedBy{$scheme} = $impclass; 0 0.000000 0.000000 54: } 387 0.001373 0.010000 55: my $ic = $ImplementedBy{$scheme}; 387 0.002274 0.000000 56: return $ic if $ic; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/Protocol.pm Page 88 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: 1 0.000007 0.000000 58: return '' unless $scheme =~ /^([.+\- 1 0.000004 0.000000 59: $scheme = $1; # untaint 1 0.000005 0.000000 60: $scheme =~ s/[.+\-]/_/g; # make it a 0 0.000000 0.000000 61: 0 0.000000 0.000000 62: # scheme not yet known, look for a 'use'd 1 0.000005 0.000000 63: $ic = "LWP::Protocol::$scheme"; # 1 0.000006 0.000000 64: $ic = "LWP::Protocol::nntp" if $scheme eq 0 0.000000 0.000000 65: no strict 'refs'; 0 0.000000 0.000000 66: # check we actually have one for the 2 0.000015 0.000000 67: unless (@{"${ic}::ISA"}) { 0 0.000000 0.000000 68: # try to autoload it 1 0.000054 0.000000 69: eval "require $ic"; 1 0.000004 0.000000 70: if ($@) { 0 0.000000 0.000000 71: if ($@ =~ /Can't locate/) { #' #emacs 0 0.000000 0.000000 72: $ic = ''; 0 0.000000 0.000000 73: } 0 0.000000 0.000000 74: else { 0 0.000000 0.000000 75: die "$@\n"; 0 0.000000 0.000000 76: } 0 0.000000 0.000000 77: } 0 0.000000 0.000000 78: } 1 0.000005 0.000000 79: $ImplementedBy{$scheme} = $ic if $ic; 1 0.000008 0.000000 80: $ic; 0 0.000000 0.000000 81:} 0 0.000000 0.000000 82: 0 0.000000 0.000000 83: 0 0.000000 0.000000 84:sub request 0 0.000000 0.000000 85:{ 0 0.000000 0.000000 86: my($self, $request, $proxy, $arg, $size, 0 0.000000 0.000000 87: Carp::croak('LWP::Protocol::request() 0 0.000000 0.000000 88:} 0 0.000000 0.000000 89: 0 0.000000 0.000000 90: 0 0.000000 0.000000 91:# legacy 0 0.000000 0.000000 92:sub timeout { shift->_elem('timeout', 0 0.000000 0.000000 93:sub parse_head { shift->_elem('parse_head', 0 0.000000 0.000000 94:sub max_size { shift->_elem('max_size', 0 0.000000 0.000000 95: 0 0.000000 0.000000 96: 0 0.000000 0.000000 97:sub collect 351 0.000000 0.000000 98:{ 351 0.001483 0.000000 99: my ($self, $arg, $response, $collector) = 351 0.000994 0.000000 100: my $content; 702 0.003020 0.020000 101: my($parse_head, $max_size) = 0 0.000000 0.000000 102: 351 0.000866 0.000000 103: my $parser; 351 0.001499 0.000000 104: if ($parse_head && $response- 343 0.001350 0.010000 105: require HTML::HeadParser; 343 0.002370 0.000000 106: $parser = HTML::HeadParser->new($response- 0 0.000000 0.000000 107: } 351 0.000970 0.010000 108: my $content_size = 0; 0 0.000000 0.000000 109: 351 0.001220 0.010000 110: if (!defined($arg) || !$response- 0 0.000000 0.000000 111: # scalar 351 0.001241 0.000000 112: while ($content = &$collector, length ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/Protocol.pm Page 89 ================================================================= count wall tm cpu time line 2737 0.008027 0.040000 113: if ($parser) { 680 0.010479 0.010000 114: $parser->parse($$content) or 0 0.000000 0.000000 115: } 2737 0.017061 0.040000 116: LWP::Debug::debug("read " . 2737 0.017377 0.090000 117: $response->add_content($$content); 2737 0.009254 0.020000 118: $content_size += length($$content); 2737 0.010418 0.020000 119: if (defined($max_size) && $content_size 0 0.000000 0.000000 120: LWP::Debug::debug("Aborting because size 0 0.000000 0.000000 121: $response->push_header("Client-Aborted", 0 0.000000 0.000000 122: #my $tot = $response->header("Content- 0 0.000000 0.000000 123: #$response->header("X-Content-Range", 0 0.000000 0.000000 124: last; 0 0.000000 0.000000 125: } 0 0.000000 0.000000 126: } 0 0.000000 0.000000 127: } 0 0.000000 0.000000 128: elsif (!ref($arg)) { 0 0.000000 0.000000 129: # filename 0 0.000000 0.000000 130: open(OUT, ">$arg") or 0 0.000000 0.000000 131: return HTTP::Response- 0 0.000000 0.000000 132: "Cannot write to '$arg': $!"); 0 0.000000 0.000000 133: binmode(OUT); 0 0.000000 0.000000 134: local($\) = ""; # ensure standard 0 0.000000 0.000000 135: while ($content = &$collector, length 0 0.000000 0.000000 136: if ($parser) { 0 0.000000 0.000000 137: $parser->parse($$content) or 0 0.000000 0.000000 138: } 0 0.000000 0.000000 139: LWP::Debug::debug("read " . 0 0.000000 0.000000 140: print OUT $$content; 0 0.000000 0.000000 141: $content_size += length($$content); 0 0.000000 0.000000 142: if (defined($max_size) && $content_size 0 0.000000 0.000000 143: LWP::Debug::debug("Aborting because size 0 0.000000 0.000000 144: $response->push_header("Client-Aborted", 0 0.000000 0.000000 145: #my $tot = $response->header("Content- 0 0.000000 0.000000 146: #$response->header("X-Content-Range", 0 0.000000 0.000000 147: last; 0 0.000000 0.000000 148: } 0 0.000000 0.000000 149: } 0 0.000000 0.000000 150: close(OUT); 0 0.000000 0.000000 151: } 0 0.000000 0.000000 152: elsif (ref($arg) eq 'CODE') { 0 0.000000 0.000000 153: # read into callback 0 0.000000 0.000000 154: while ($content = &$collector, length 0 0.000000 0.000000 155: if ($parser) { 0 0.000000 0.000000 156: $parser->parse($$content) or 0 0.000000 0.000000 157: } 0 0.000000 0.000000 158: LWP::Debug::debug("read " . 0 0.000000 0.000000 159: eval { 0 0.000000 0.000000 160: &$arg($$content, $response, $self); 0 0.000000 0.000000 161: }; 0 0.000000 0.000000 162: if ($@) { 0 0.000000 0.000000 163: chomp($@); 0 0.000000 0.000000 164: $response->push_header('X-Died' => $@); 0 0.000000 0.000000 165: $response->push_header("Client-Aborted", 0 0.000000 0.000000 166: last; 0 0.000000 0.000000 167: } 0 0.000000 0.000000 168: } ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/Protocol.pm Page 90 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169: } 0 0.000000 0.000000 170: else { 0 0.000000 0.000000 171: return HTTP::Response- 0 0.000000 0.000000 172: "Unexpected collect argument '$arg'"); 0 0.000000 0.000000 173: } 351 0.004084 0.000000 174: $response; 0 0.000000 0.000000 175:} 0 0.000000 0.000000 176: 0 0.000000 0.000000 177: 0 0.000000 0.000000 178:sub collect_once 0 0.000000 0.000000 179:{ 0 0.000000 0.000000 180: my($self, $arg, $response) = @_; 0 0.000000 0.000000 181: my $content = \ $_[3]; 0 0.000000 0.000000 182: my $first = 1; 0 0.000000 0.000000 183: $self->collect($arg, $response, sub { 0 0.000000 0.000000 184: return $content if $first--; 0 0.000000 0.000000 185: return \ ""; 0 0.000000 0.000000 186: }); 0 0.000000 0.000000 187:} 0 0.000000 0.000000 188: 0 0.000000 0.000000 189:1; 0 0.000000 0.000000 190: 0 0.000000 0.000000 191: 0 0.000000 0.000000 192:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/Protocol/http Page 91 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:# $Id: http.pm,v 1.67 2004/03/10 20:10:18 0 0.000000 0.000000 2:# 0 0.000000 0.000000 3: 0 0.000000 0.000000 4:package LWP::Protocol::http; 0 0.000000 0.000000 5: 3 0.000012 0.000000 6:use strict; 0 0.000000 0.000000 7: 1 0.000004 0.000000 8:require LWP::Debug; 1 0.000003 0.000000 9:require HTTP::Response; 1 0.000003 0.000000 10:require HTTP::Status; 1 0.000005 0.000000 11:require Net::HTTP; 0 0.000000 0.000000 12: 3 0.000010 0.000000 13:use vars qw(@ISA @EXTRA_SOCK_OPTS); 0 0.000000 0.000000 14: 1 0.000004 0.000000 15:require LWP::Protocol; 1 0.000009 0.000000 16:@ISA = qw(LWP::Protocol); 0 0.000000 0.000000 17: 1 0.000004 0.000000 18:my $CRLF = "\015\012"; 0 0.000000 0.000000 19: 0 0.000000 0.000000 20:sub _new_socket 387 0.000000 0.000000 21:{ 387 0.001829 0.020000 22: my($self, $host, $port, $timeout) = @_; 387 0.001740 0.000000 23: my $conn_cache = $self->{ua}{conn_cache}; 387 0.001175 0.000000 24: if ($conn_cache) { 0 0.000000 0.000000 25: if (my $sock = $conn_cache->withdraw("http", 0 0.000000 0.000000 26: return $sock if $sock && !$sock- 0 0.000000 0.000000 27: # if the socket is readable, then either 0 0.000000 0.000000 28: # connection or there are some garbage 0 0.000000 0.000000 29: # case we abandon it. 0 0.000000 0.000000 30: $sock->close; 0 0.000000 0.000000 31: } 0 0.000000 0.000000 32: } 0 0.000000 0.000000 33: 387 0.002829 0.000000 34: local($^W) = 0; # IO::Socket::INET can 387 0.002571 0.000000 35: my $sock = $self->socket_class- 0 0.000000 0.000000 36: PeerPort => $port, 0 0.000000 0.000000 37: Proto => 'tcp', 0 0.000000 0.000000 38: Timeout => $timeout, 0 0.000000 0.000000 39: KeepAlive => !!$conn_cache, 0 0.000000 0.000000 40: SendTE => 1, 0 0.000000 0.000000 41: $self->_extra_sock_opts($host, $port), 0 0.000000 0.000000 42: ); 0 0.000000 0.000000 43: 387 0.001196 0.000000 44: unless ($sock) { 0 0.000000 0.000000 45: # IO::Socket::INET leaves additional error 32 0.000420 0.000000 46: $@ =~ s/^.*?: //; 32 0.001004 0.010000 47: die "Can't connect to $host:$port ($@)"; 0 0.000000 0.000000 48: } 0 0.000000 0.000000 49: 0 0.000000 0.000000 50: # perl 5.005's IO::Socket does not have 710 0.004658 0.000000 51: eval { $sock->blocking(0); }; 0 0.000000 0.000000 52: 355 0.003025 0.020000 53: $sock; 0 0.000000 0.000000 54:} 0 0.000000 0.000000 55: 0 0.000000 0.000000 56:sub socket_class ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/Protocol/http Page 92 ================================================================= count wall tm cpu time line 387 0.000000 0.000000 57:{ 387 0.001356 0.000000 58: my $self = shift; 387 0.002783 0.000000 59: (ref($self) || $self) . "::Socket"; 0 0.000000 0.000000 60:} 0 0.000000 0.000000 61: 0 0.000000 0.000000 62:sub _extra_sock_opts # to be overridden by 387 0.000000 0.000000 63:{ 387 0.003278 0.010000 64: return @EXTRA_SOCK_OPTS; 0 0.000000 0.000000 65:} 0 0.000000 0.000000 66: 0 0.000000 0.000000 67:sub _check_sock 710 0.001445 0.000000 68:{ 0 0.000000 0.000000 69: #my($self, $req, $sock) = @_; 0 0.000000 0.000000 70:} 0 0.000000 0.000000 71: 0 0.000000 0.000000 72:sub _get_sock_info 351 0.000000 0.000000 73:{ 351 0.001390 0.000000 74: my($self, $res, $sock) = @_; 351 0.002665 0.000000 75: if (defined(my $peerhost = $sock- 351 0.002114 0.000000 76: $res->header("Client-Peer" => 0 0.000000 0.000000 77: } 0 0.000000 0.000000 78:} 0 0.000000 0.000000 79: 0 0.000000 0.000000 80:sub _fixup_header 355 0.000000 0.000000 81:{ 355 0.001682 0.020000 82: my($self, $h, $url, $proxy) = @_; 0 0.000000 0.000000 83: 0 0.000000 0.000000 84: # Extract 'Host' header 355 0.002639 0.000000 85: my $hhost = $url->authority; 355 0.001917 0.000000 86: if ($hhost =~ s/^([^\@]*)\@//) { # get 0 0.000000 0.000000 87: # add authorization header if we need them. 0 0.000000 0.000000 88: # not really support specification of user 0 0.000000 0.000000 89: # we allow it. 0 0.000000 0.000000 90: if (defined($1) && not $h- 0 0.000000 0.000000 91: require URI::Escape; 0 0.000000 0.000000 92: $h->authorization_basic(map 0 0.000000 0.000000 93: split(":", $1, 2)); 0 0.000000 0.000000 94: } 0 0.000000 0.000000 95: } 355 0.002284 0.010000 96: $h->init_header('Host' => $hhost); 0 0.000000 0.000000 97: 355 0.001828 0.000000 98: if ($proxy) { 0 0.000000 0.000000 99: # Check the proxy URI's userinfo() for proxy 0 0.000000 0.000000 100: # export 0 0.000000 0.000000 101: my $p_auth = $proxy->userinfo(); 0 0.000000 0.000000 102: if(defined $p_auth) { 0 0.000000 0.000000 103: require URI::Escape; 0 0.000000 0.000000 104: $h->proxy_authorization_basic(map 0 0.000000 0.000000 105: split(":", $p_auth, 2)) 0 0.000000 0.000000 106: } 0 0.000000 0.000000 107: } 0 0.000000 0.000000 108:} 0 0.000000 0.000000 109: 0 0.000000 0.000000 110:sub hlist_remove { 0 0.000000 0.000000 111: my($hlist, $k) = @_; 0 0.000000 0.000000 112: $k = lc $k; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/Protocol/http Page 93 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113: for (my $i = @$hlist - 2; $i >= 0; $i -= 0 0.000000 0.000000 114: next unless lc($hlist->[$i]) eq $k; 0 0.000000 0.000000 115: splice(@$hlist, $i, 2); 0 0.000000 0.000000 116: } 0 0.000000 0.000000 117:} 0 0.000000 0.000000 118: 0 0.000000 0.000000 119:sub request 387 0.000000 0.000000 120:{ 387 0.002750 0.000000 121: my($self, $request, $proxy, $arg, $size, 387 0.002112 0.000000 122: LWP::Debug::trace('()'); 0 0.000000 0.000000 123: 387 0.001351 0.010000 124: $size ||= 4096; 0 0.000000 0.000000 125: 0 0.000000 0.000000 126: # check method 387 0.002166 0.000000 127: my $method = $request->method; 387 0.002275 0.000000 128: unless ($method =~ /^[A-Za-z0- 0 0.000000 0.000000 129: return new HTTP::Response 0 0.000000 0.000000 130: 'Library does not allow method ' . 0 0.000000 0.000000 131: "$method for 'http:' URLs"; 0 0.000000 0.000000 132: } 0 0.000000 0.000000 133: 387 0.002331 0.010000 134: my $url = $request->url; 387 0.001204 0.000000 135: my($host, $port, $fullpath); 0 0.000000 0.000000 136: 0 0.000000 0.000000 137: # Check if we're proxy'ing 387 0.001289 0.000000 138: if (defined $proxy) { 0 0.000000 0.000000 139: # $proxy is an URL to an HTTP server which 0 0.000000 0.000000 140: $host = $proxy->host; 0 0.000000 0.000000 141: $port = $proxy->port; 0 0.000000 0.000000 142: $fullpath = $method eq "CONNECT" ? 0 0.000000 0.000000 143: ($url->host . ":" . 0 0.000000 0.000000 144: $url->as_string; 0 0.000000 0.000000 145: } 0 0.000000 0.000000 146: else { 387 0.002736 0.000000 147: $host = $url->host; 387 0.002632 0.020000 148: $port = $url->port; 387 0.002512 0.010000 149: $fullpath = $url->path_query; 387 0.002193 0.000000 150: $fullpath = "/$fullpath" unless $fullpath =~ 0 0.000000 0.000000 151: } 0 0.000000 0.000000 152: 0 0.000000 0.000000 153: # connect to remote site 387 0.002727 0.000000 154: my $socket = $self->_new_socket($host, 355 0.003005 0.000000 155: $self->_check_sock($request, $socket); 0 0.000000 0.000000 156: 355 0.001018 0.000000 157: my @h; 355 0.002571 0.000000 158: my $request_headers = $request->headers- 355 0.002664 0.010000 159: $self->_fixup_header($request_headers, 0 0.000000 0.000000 160: 0 0.000000 0.000000 161: $request_headers->scan(sub { 1065 0.004641 0.000000 162: my($k, $v) = @_; 1065 0.003747 0.000000 163: $v =~ s/\n/ /g; 1065 0.010155 0.010000 164: push(@h, $k, $v); 355 0.002142 0.000000 165: }); 0 0.000000 0.000000 166: 355 0.002462 0.000000 167: my $content_ref = $request->content_ref; 355 0.001070 0.000000 168: $content_ref = $$content_ref if ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/Protocol/http Page 94 ================================================================= count wall tm cpu time line 355 0.000826 0.000000 169: my $chunked; 355 0.000905 0.000000 170: my $has_content; 0 0.000000 0.000000 171: 355 0.001535 0.000000 172: if (ref($content_ref) eq 'CODE') { 0 0.000000 0.000000 173: my $clen = $request_headers- 0 0.000000 0.000000 174: $has_content++ if $clen; 0 0.000000 0.000000 175: unless (defined $clen) { 0 0.000000 0.000000 176: push(@h, "Transfer-Encoding" => 0 0.000000 0.000000 177: $has_content++; 0 0.000000 0.000000 178: $chunked++; 0 0.000000 0.000000 179: } 0 0.000000 0.000000 180: } 0 0.000000 0.000000 181: else { 0 0.000000 0.000000 182: # Set (or override) Content-Length header 355 0.002176 0.000000 183: my $clen = $request_headers- 355 0.001715 0.000000 184: if (defined($$content_ref) && 0 0.000000 0.000000 185: $has_content++; 0 0.000000 0.000000 186: if (!defined($clen) || $clen ne 0 0.000000 0.000000 187: if (defined $clen) { 0 0.000000 0.000000 188: warn "Content-Length header value was 0 0.000000 0.000000 189: hlist_remove(\@h, 'Content-Length'); 0 0.000000 0.000000 190: } 0 0.000000 0.000000 191: push(@h, 'Content-Length' => 0 0.000000 0.000000 192: } 0 0.000000 0.000000 193: } 0 0.000000 0.000000 194: elsif ($clen) { 0 0.000000 0.000000 195: warn "Content-Length set when there is 0 0.000000 0.000000 196: hlist_remove(\@h, 'Content-Length'); 0 0.000000 0.000000 197: } 0 0.000000 0.000000 198: } 0 0.000000 0.000000 199: 355 0.002518 0.000000 200: my $req_buf = $socket- 0 0.000000 0.000000 201: #print "------\n$req_buf\n------\n"; 0 0.000000 0.000000 202: 0 0.000000 0.000000 203: # XXX need to watch out for write 0 0.000000 0.000000 204: { 710 0.003501 0.010000 205: my $n = $socket->syswrite($req_buf, 355 0.001261 0.000000 206: die $! unless defined($n); 355 0.001440 0.000000 207: die "short write" unless $n == 0 0.000000 0.000000 208: #LWP::Debug::conns($req_buf); 0 0.000000 0.000000 209: } 0 0.000000 0.000000 210: 355 0.001166 0.000000 211: my($code, $mess, @junk); 355 0.000943 0.000000 212: my $drop_connection; 0 0.000000 0.000000 213: 355 0.000950 0.000000 214: if ($has_content) { 0 0.000000 0.000000 215: my $write_wait = 0; 0 0.000000 0.000000 216: $write_wait = 2 0 0.000000 0.000000 217: if ($request_headers->header("Expect") 0 0.000000 0.000000 218: 0 0.000000 0.000000 219: my $eof; 0 0.000000 0.000000 220: my $wbuf; 0 0.000000 0.000000 221: my $woffset = 0; 0 0.000000 0.000000 222: if (ref($content_ref) eq 'CODE') { 0 0.000000 0.000000 223: my $buf = &$content_ref(); 0 0.000000 0.000000 224: $buf = "" unless defined($buf); ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/Protocol/http Page 95 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 225: $buf = sprintf "%x%s%s%s", length($buf), 0 0.000000 0.000000 226: if $chunked; 0 0.000000 0.000000 227: $wbuf = \$buf; 0 0.000000 0.000000 228: } 0 0.000000 0.000000 229: else { 0 0.000000 0.000000 230: $wbuf = $content_ref; 0 0.000000 0.000000 231: $eof = 1; 0 0.000000 0.000000 232: } 0 0.000000 0.000000 233: 0 0.000000 0.000000 234: my $fbits = ''; 0 0.000000 0.000000 235: vec($fbits, fileno($socket), 1) = 1; 0 0.000000 0.000000 236: 0 0.000000 0.000000 237: while ($woffset < length($$wbuf)) { 0 0.000000 0.000000 238: 0 0.000000 0.000000 239: my $time_before; 0 0.000000 0.000000 240: my $sel_timeout = $timeout; 0 0.000000 0.000000 241: if ($write_wait) { 0 0.000000 0.000000 242: $time_before = time; 0 0.000000 0.000000 243: $sel_timeout = $write_wait if $write_wait < 0 0.000000 0.000000 244: } 0 0.000000 0.000000 245: 0 0.000000 0.000000 246: my $rbits = $fbits; 0 0.000000 0.000000 247: my $wbits = $write_wait ? undef : 0 0.000000 0.000000 248: my $nfound = select($rbits, $wbits, 0 0.000000 0.000000 249: unless (defined $nfound) { 0 0.000000 0.000000 250: die "select failed: $!"; 0 0.000000 0.000000 251: } 0 0.000000 0.000000 252: 0 0.000000 0.000000 253: if ($write_wait) { 0 0.000000 0.000000 254: $write_wait -= time - $time_before; 0 0.000000 0.000000 255: $write_wait = 0 if $write_wait < 0; 0 0.000000 0.000000 256: } 0 0.000000 0.000000 257: 0 0.000000 0.000000 258: if (defined($rbits) && $rbits =~ 0 0.000000 0.000000 259: # readable 0 0.000000 0.000000 260: my $buf = $socket->_rbuf; 0 0.000000 0.000000 261: my $n = $socket->sysread($buf, 1024, 0 0.000000 0.000000 262: unless ($n) { 0 0.000000 0.000000 263: die "EOF"; 0 0.000000 0.000000 264: } 0 0.000000 0.000000 265: $socket->_rbuf($buf); 0 0.000000 0.000000 266: if ($buf =~ /\015?\012\015?\012/) { 0 0.000000 0.000000 267: # a whole response present 0 0.000000 0.000000 268: ($code, $mess, @h) = $socket- 0 0.000000 0.000000 269: junk_out => \@junk, 0 0.000000 0.000000 270: ); 0 0.000000 0.000000 271: if ($code eq "100") { 0 0.000000 0.000000 272: $write_wait = 0; 0 0.000000 0.000000 273: undef($code); 0 0.000000 0.000000 274: } 0 0.000000 0.000000 275: else { 0 0.000000 0.000000 276: $drop_connection++; 0 0.000000 0.000000 277: last; 0 0.000000 0.000000 278: # XXX should perhaps try to abort write in 0 0.000000 0.000000 279: } 0 0.000000 0.000000 280: } ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/Protocol/http Page 96 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 281: } 0 0.000000 0.000000 282: if (defined($wbits) && $wbits =~ 0 0.000000 0.000000 283: my $n = $socket->syswrite($$wbuf, 0 0.000000 0.000000 284: unless ($n) { 0 0.000000 0.000000 285: die "syswrite: $!" unless defined $n; 0 0.000000 0.000000 286: die "syswrite: no bytes written"; 0 0.000000 0.000000 287: } 0 0.000000 0.000000 288: $woffset += $n; 0 0.000000 0.000000 289: 0 0.000000 0.000000 290: if (!$eof && $woffset >= length($$wbuf)) { 0 0.000000 0.000000 291: # need to refill buffer from 0 0.000000 0.000000 292: my $buf = &$content_ref(); 0 0.000000 0.000000 293: $buf = "" unless defined($buf); 0 0.000000 0.000000 294: $eof++ unless length($buf); 0 0.000000 0.000000 295: $buf = sprintf "%x%s%s%s", 0 0.000000 0.000000 296: if $chunked; 0 0.000000 0.000000 297: $wbuf = \$buf; 0 0.000000 0.000000 298: $woffset = 0; 0 0.000000 0.000000 299: } 0 0.000000 0.000000 300: } 0 0.000000 0.000000 301: } 0 0.000000 0.000000 302: } 0 0.000000 0.000000 303: 355 0.002636 0.000000 304: ($code, $mess, @h) = $socket- 0 0.000000 0.000000 305: unless $code; 351 0.001319 0.000000 306: ($code, $mess, @h) = $socket- 0 0.000000 0.000000 307: if $code eq "100"; 0 0.000000 0.000000 308: 351 0.002672 0.000000 309: my $response = HTTP::Response->new($code, 351 0.001430 0.000000 310: my $peer_http_version = $socket- 351 0.002281 0.010000 311: $response- 351 0.001341 0.000000 312: while (@h) { 2404 0.010628 0.040000 313: my($k, $v) = splice(@h, 0, 2); 2404 0.009817 0.010000 314: $response->push_header($k, $v); 0 0.000000 0.000000 315: } 351 0.001103 0.010000 316: $response->push_header("Client-Junk" => 0 0.000000 0.000000 317: 351 0.002377 0.000000 318: $response->request($request); 351 0.002854 0.000000 319: $self->_get_sock_info($response, 0 0.000000 0.000000 320: 351 0.001276 0.000000 321: if ($method eq "CONNECT") { 0 0.000000 0.000000 322: $response->{client_socket} = $socket; # so 0 0.000000 0.000000 323: return $response; 0 0.000000 0.000000 324: } 0 0.000000 0.000000 325: 351 0.001611 0.000000 326: if (my @te = $response- 161 0.000598 0.000000 327: $response->push_header('Client-Transfer- 0 0.000000 0.000000 328: } 351 0.002967 0.000000 329: $response->push_header('Client-Response- 0 0.000000 0.000000 330: 351 0.001079 0.010000 331: my $complete; 0 0.000000 0.000000 332: $response = $self->collect($arg, 3088 0.010287 0.010000 333: my $buf = ""; #prevent use of uninitialized 3088 0.008080 0.070000 334: my $n; 3088 0.020271 0.030000 335: READ: 0 0.000000 0.000000 336: { ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/Protocol/http Page 97 ================================================================= count wall tm cpu time line 3088 0.007965 0.010000 337: $n = $socket->read_entity_body($buf, 3088 0.008735 0.050000 338: die "Can't read entity body: $!" unless 3088 0.010008 0.040000 339: redo READ if $n == -1; 0 0.000000 0.000000 340: } 3088 0.009211 0.040000 341: $complete++ if !$n; 3088 0.020113 0.020000 342: return \$buf; 351 0.002492 0.010000 343: } ); 351 0.001080 0.000000 344: $drop_connection++ unless $complete; 0 0.000000 0.000000 345: 351 0.002443 0.030000 346: @h = $socket->get_trailers; 351 0.001392 0.000000 347: while (@h) { 0 0.000000 0.000000 348: my($k, $v) = splice(@h, 0, 2); 0 0.000000 0.000000 349: $response->push_header($k, $v); 0 0.000000 0.000000 350: } 0 0.000000 0.000000 351: 0 0.000000 0.000000 352: # keep-alive support 351 0.001090 0.000000 353: unless ($drop_connection) { 351 0.001816 0.010000 354: if (my $conn_cache = $self- 0 0.000000 0.000000 355: my %connection = map { (lc($_) => 1) } 0 0.000000 0.000000 356: split(/\s*,\s*/, ($response- 0 0.000000 0.000000 357: if (($peer_http_version eq "1.1" && 0 0.000000 0.000000 358: $connection{"keep-alive"}) 0 0.000000 0.000000 359: { 0 0.000000 0.000000 360: LWP::Debug::debug("Keep the http connection 0 0.000000 0.000000 361: $conn_cache->deposit("http", "$host:$port", 0 0.000000 0.000000 362: } 0 0.000000 0.000000 363: } 0 0.000000 0.000000 364: } 0 0.000000 0.000000 365: 351 0.002507 0.000000 366: $response; 0 0.000000 0.000000 367:} 0 0.000000 0.000000 368: 0 0.000000 0.000000 369: 0 0.000000 0.000000 370:#-------------------------------------------- 0 0.000000 0.000000 371:package LWP::Protocol::http::SocketMethods; 0 0.000000 0.000000 372: 2438 0.000000 0.000000 373:sub sysread { 2438 0.007931 0.020000 374: my $self = shift; 4876 0.018936 0.050000 375: if (my $timeout = 2438 0.018170 0.050000 376: die "read timeout" unless $self- 0 0.000000 0.000000 377: } 0 0.000000 0.000000 378: else { 0 0.000000 0.000000 379: # since we have made the socket non-blocking 0 0.000000 0.000000 380: # use select to wait for some data to arrive 0 0.000000 0.000000 381: $self->can_read(undef) || die "Assert"; 0 0.000000 0.000000 382: } 2434 0.052023 0.080000 383: sysread($self, $_[0], $_[1], $_[2] || 0); 0 0.000000 0.000000 384:} 0 0.000000 0.000000 385: 2438 0.000000 0.000000 386:sub can_read { 2438 0.008696 0.020000 387: my($self, $timeout) = @_; 2438 0.007115 0.000000 388: my $fbits = ''; 2438 0.014739 0.050000 389: vec($fbits, fileno($self), 1) = 1; 2438 ######## 0.070000 390: my $nfound = select($fbits, undef, undef, 2438 0.007992 0.010000 391: die "select failed: $!" unless defined 2438 0.020198 0.010000 392: return $nfound > 0; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/Protocol/http Page 98 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 393:} 0 0.000000 0.000000 394: 0 0.000000 0.000000 395:sub ping { 0 0.000000 0.000000 396: my $self = shift; 0 0.000000 0.000000 397: !$self->can_read(0); 0 0.000000 0.000000 398:} 0 0.000000 0.000000 399: 351 0.000000 0.000000 400:sub increment_response_count { 351 0.001245 0.020000 401: my $self = shift; 702 0.002104 0.010000 402: return 0 0.000000 0.000000 403:} 0 0.000000 0.000000 404: 0 0.000000 0.000000 405:#-------------------------------------------- 0 0.000000 0.000000 406:package LWP::Protocol::http::Socket; 3 0.000013 0.000000 407:use vars qw(@ISA); 1 0.000006 0.000000 408:@ISA = qw(LWP::Protocol::http::SocketMethods 0 0.000000 0.000000 409: 1 0.000033 0.000000 410:1; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/UserAgent.pm Page 99 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package LWP::UserAgent; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:# $Id: UserAgent.pm,v 2.31 2004/04/10 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:use strict; 0 0.000000 0.000000 6:use vars qw(@ISA $VERSION); 0 0.000000 0.000000 7: 0 0.000000 0.000000 8:require LWP::MemberMixin; 0 0.000000 0.000000 9:@ISA = qw(LWP::MemberMixin); 0 0.000000 0.000000 10:$VERSION = sprintf("%d.%03d", q$Revision: 0 0.000000 0.000000 11: 0 0.000000 0.000000 12:use HTTP::Request (); 0 0.000000 0.000000 13:use HTTP::Response (); 0 0.000000 0.000000 14:use HTTP::Date (); 0 0.000000 0.000000 15: 0 0.000000 0.000000 16:use LWP (); 0 0.000000 0.000000 17:use LWP::Debug (); 0 0.000000 0.000000 18:use LWP::Protocol (); 0 0.000000 0.000000 19: 0 0.000000 0.000000 20:use Carp (); 0 0.000000 0.000000 21: 0 0.000000 0.000000 22:if ($ENV{PERL_LWP_USE_HTTP_10}) { 0 0.000000 0.000000 23: require LWP::Protocol::http10; 0 0.000000 0.000000 24: LWP::Protocol::implementor('http', 0 0.000000 0.000000 25: eval { 0 0.000000 0.000000 26: require LWP::Protocol::https10; 0 0.000000 0.000000 27: LWP::Protocol::implementor('https', 0 0.000000 0.000000 28: }; 0 0.000000 0.000000 29:} 0 0.000000 0.000000 30: 0 0.000000 0.000000 31: 0 0.000000 0.000000 32: 0 0.000000 0.000000 33:sub new 290 0.000000 0.000000 34:{ 290 0.001645 0.000000 35: my($class, %cnf) = @_; 290 0.001884 0.010000 36: LWP::Debug::trace('()'); 0 0.000000 0.000000 37: 290 0.001044 0.000000 38: my $agent = delete $cnf{agent}; 290 0.001810 0.000000 39: $agent = $class->_agent unless defined 0 0.000000 0.000000 40: 290 0.000963 0.020000 41: my $from = delete $cnf{from}; 290 0.000848 0.000000 42: my $timeout = delete $cnf{timeout}; 290 0.000907 0.000000 43: $timeout = 3*60 unless defined $timeout; 290 0.000889 0.010000 44: my $use_eval = delete $cnf{use_eval}; 290 0.000751 0.010000 45: $use_eval = 1 unless defined $use_eval; 290 0.000878 0.000000 46: my $parse_head = delete $cnf{parse_head}; 290 0.000810 0.000000 47: $parse_head = 1 unless defined 290 0.000821 0.000000 48: my $max_size = delete $cnf{max_size}; 290 0.000884 0.010000 49: my $max_redirect = delete 290 0.000754 0.000000 50: $max_redirect = 7 unless defined 290 0.000876 0.000000 51: my $env_proxy = delete $cnf{env_proxy}; 0 0.000000 0.000000 52: 290 0.000768 0.000000 53: my $cookie_jar = delete $cnf{cookie_jar}; 290 0.000721 0.000000 54: my $conn_cache = delete $cnf{conn_cache}; 290 0.000776 0.010000 55: my $keep_alive = delete $cnf{keep_alive}; 0 0.000000 0.000000 56: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/UserAgent.pm Page 100 ================================================================= count wall tm cpu time line 290 0.000781 0.000000 57: Carp::croak("Can't mix conn_cache and 0 0.000000 0.000000 58: if $conn_cache && $keep_alive; 0 0.000000 0.000000 59: 0 0.000000 0.000000 60: 290 0.000988 0.000000 61: my $protocols_allowed = delete 290 0.000934 0.000000 62: my $protocols_forbidden = delete 0 0.000000 0.000000 63: 290 0.000846 0.000000 64: my $requests_redirectable = delete 290 0.001579 0.000000 65: $requests_redirectable = ['GET', 'HEAD'] 0 0.000000 0.000000 66: unless defined $requests_redirectable; 0 0.000000 0.000000 67: 0 0.000000 0.000000 68: # Actually ""s are just as good as 0's, 290 0.001520 0.000000 69: Carp::croak("protocols_allowed has to be 0 0.000000 0.000000 70: if $protocols_allowed and 290 0.000868 0.010000 71: Carp::croak("protocols_forbidden has to 0 0.000000 0.000000 72: if $protocols_forbidden and 290 0.001305 0.000000 73: Carp::croak("requests_redirectable has to 0 0.000000 0.000000 74: if $requests_redirectable and 0 0.000000 0.000000 75: 0 0.000000 0.000000 76: 290 0.000942 0.000000 77: if (%cnf && $^W) { 0 0.000000 0.000000 78: Carp::carp("Unrecognized LWP::UserAgent 0 0.000000 0.000000 79: } 0 0.000000 0.000000 80: 290 0.004964 0.000000 81: my $self = bless { 0 0.000000 0.000000 82: from => $from, 0 0.000000 0.000000 83: timeout => $timeout, 0 0.000000 0.000000 84: use_eval => $use_eval, 0 0.000000 0.000000 85: parse_head => $parse_head, 0 0.000000 0.000000 86: max_size => $max_size, 0 0.000000 0.000000 87: max_redirect => $max_redirect, 0 0.000000 0.000000 88: proxy => undef, 0 0.000000 0.000000 89: no_proxy => [], 0 0.000000 0.000000 90: protocols_allowed 0 0.000000 0.000000 91: protocols_forbidden 0 0.000000 0.000000 92: requests_redirectable 0 0.000000 0.000000 93: }, $class; 0 0.000000 0.000000 94: 290 0.001861 0.000000 95: $self->agent($agent) if $agent; 290 0.000796 0.000000 96: $self->cookie_jar($cookie_jar) if 290 0.000784 0.000000 97: $self->env_proxy if $env_proxy; 0 0.000000 0.000000 98: 290 0.000774 0.010000 99: $self->protocols_allowed( 290 0.000762 0.000000 100: $self- 0 0.000000 0.000000 101: 290 0.000726 0.000000 102: if ($keep_alive) { 0 0.000000 0.000000 103: $conn_cache ||= { total_capacity => 0 0.000000 0.000000 104: } 290 0.002107 0.000000 105: $self->conn_cache($conn_cache) if 0 0.000000 0.000000 106: 290 0.001867 0.000000 107: return $self; 0 0.000000 0.000000 108:} 0 0.000000 0.000000 109: 0 0.000000 0.000000 110: 0 0.000000 0.000000 111:# private method. check sanity of given 1161 0.000000 0.000000 112:sub _request_sanity_check { ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/UserAgent.pm Page 101 ================================================================= count wall tm cpu time line 1161 0.004019 0.020000 113: my($self, $request) = @_; 0 0.000000 0.000000 114: # some sanity checking 1161 0.003122 0.000000 115: if (defined $request) { 1161 0.003696 0.000000 116: if (ref $request) { 1161 0.010285 0.010000 117: Carp::croak("You need a request object, 0 0.000000 0.000000 118: if ref($request) eq 'ARRAY' or 0 0.000000 0.000000 119: !$request->can('method') or !$request- 0 0.000000 0.000000 120: } 0 0.000000 0.000000 121: else { 0 0.000000 0.000000 122: Carp::croak("You need a request object, 0 0.000000 0.000000 123: } 0 0.000000 0.000000 124: } 0 0.000000 0.000000 125: else { 0 0.000000 0.000000 126: Carp::croak("No request object passed 0 0.000000 0.000000 127: } 0 0.000000 0.000000 128:} 0 0.000000 0.000000 129: 0 0.000000 0.000000 130: 0 0.000000 0.000000 131:sub send_request 387 0.000000 0.000000 132:{ 387 0.001670 0.010000 133: my($self, $request, $arg, $size) = @_; 387 0.002223 0.000000 134: $self->_request_sanity_check($request); 0 0.000000 0.000000 135: 387 0.002269 0.000000 136: my($method, $url) = ($request->method, 0 0.000000 0.000000 137: 387 0.004237 0.020000 138: local($SIG{__DIE__}); # protect against 0 0.000000 0.000000 139: 0 0.000000 0.000000 140: # Check that we have a METHOD and a URL 387 0.001783 0.000000 141: return _new_response($request, 0 0.000000 0.000000 142: unless $method; 387 0.001779 0.010000 143: return _new_response($request, 0 0.000000 0.000000 144: unless $url; 387 0.002301 0.000000 145: return _new_response($request, 0 0.000000 0.000000 146: unless $url->scheme; 0 0.000000 0.000000 147: 387 0.001451 0.000000 148: LWP::Debug::trace("$method $url"); 0 0.000000 0.000000 149: 0 0.000000 0.000000 150: # Locate protocol to use 387 0.001195 0.010000 151: my $scheme = ''; 387 0.003482 0.000000 152: my $proxy = $self->_need_proxy($url); 387 0.001214 0.000000 153: if (defined $proxy) { 0 0.000000 0.000000 154: $scheme = $proxy->scheme; 0 0.000000 0.000000 155: } 0 0.000000 0.000000 156: else { 387 0.001904 0.000000 157: $scheme = $url->scheme; 0 0.000000 0.000000 158: } 0 0.000000 0.000000 159: 387 0.001121 0.010000 160: my $protocol; 0 0.000000 0.000000 161: 0 0.000000 0.000000 162: { 0 0.000000 0.000000 163: # Honor object-specific restrictions by 0 0.000000 0.000000 164: # into class LWP::Protocol::nogo. 774 0.002153 0.010000 165: my $x; 387 0.002454 0.010000 166: if($x = $self->protocols_allowed) 0 0.000000 0.000000 167: if(grep lc($_) eq $scheme, @$x) { 0 0.000000 0.000000 168: LWP::Debug::trace("$scheme URLs are ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/UserAgent.pm Page 102 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169: } 0 0.000000 0.000000 170: else { 0 0.000000 0.000000 171: LWP::Debug::trace("$scheme URLs 0 0.000000 0.000000 172: require LWP::Protocol::nogo; 0 0.000000 0.000000 173: $protocol = LWP::Protocol::nogo- 0 0.000000 0.000000 174: } 0 0.000000 0.000000 175: } 0 0.000000 0.000000 176: elsif ($x = $self->protocols_forbidden) 0 0.000000 0.000000 177: if(grep lc($_) eq $scheme, @$x) { 0 0.000000 0.000000 178: LWP::Debug::trace("$scheme URLs are 0 0.000000 0.000000 179: require LWP::Protocol::nogo; 0 0.000000 0.000000 180: $protocol = LWP::Protocol::nogo- 0 0.000000 0.000000 181: } 0 0.000000 0.000000 182: else { 0 0.000000 0.000000 183: LWP::Debug::trace("$scheme URLs 0 0.000000 0.000000 184: } 0 0.000000 0.000000 185: } 0 0.000000 0.000000 186: # else fall thru and create the 0 0.000000 0.000000 187: } 0 0.000000 0.000000 188: 387 0.001184 0.000000 189: unless($protocol) { 774 0.003765 0.020000 190: $protocol = eval { 387 0.001246 0.000000 191: if ($@) { 0 0.000000 0.000000 192: $@ =~ s/ at .* line \d+.*//s; # remove 0 0.000000 0.000000 193: my $response = _new_response($request, 0 0.000000 0.000000 194: if ($scheme eq "https") { 0 0.000000 0.000000 195: $response->message($response->message . 0 0.000000 0.000000 196: $response->content_type("text/plain"); 0 0.000000 0.000000 197: $response->content(<request($request, 0 0.000000 0.000000 215: $arg, $size, $timeout); 0 0.000000 0.000000 216: }; 387 0.001608 0.010000 217: if ($@) { 36 0.000430 0.000000 218: $@ =~ s/ at .* line \d+.*//s; # remove 36 0.000319 0.000000 219: $response = _new_response($request, 0 0.000000 0.000000 220: 0 0.000000 0.000000 221: $@); 0 0.000000 0.000000 222: } 0 0.000000 0.000000 223: } 0 0.000000 0.000000 224: else { ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/UserAgent.pm Page 103 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 225: $response = $protocol->request($request, 0 0.000000 0.000000 226: $arg, $size, $timeout); 0 0.000000 0.000000 227: # XXX: Should we die unless $response- 0 0.000000 0.000000 228: } 0 0.000000 0.000000 229: 387 0.002440 0.000000 230: $response->request($request); # record 387 0.001150 0.000000 231: $cookie_jar->extract_cookies($response) 387 0.002768 0.000000 232: $response->header("Client-Date" => 387 0.008342 0.000000 233: return $response; 0 0.000000 0.000000 234:} 0 0.000000 0.000000 235: 0 0.000000 0.000000 236: 0 0.000000 0.000000 237:sub prepare_request 387 0.000000 0.000000 238:{ 387 0.001600 0.000000 239: my($self, $request) = @_; 387 0.002252 0.000000 240: $self->_request_sanity_check($request); 0 0.000000 0.000000 241: 0 0.000000 0.000000 242: # Extract fields that will be used below 387 0.002599 0.020000 243: my ($agent, $from, $cookie_jar, 387 0.001542 0.000000 244: @{$self}{qw(agent from cookie_jar 0 0.000000 0.000000 245: 0 0.000000 0.000000 246: # Set User-Agent and From headers if they 387 0.001817 0.000000 247: $request->init_header('User-Agent' => 387 0.001107 0.010000 248: $request->init_header('From' => $from) if 387 0.001107 0.000000 249: if (defined $max_size) { 387 0.001398 0.010000 250: my $last = $max_size - 1; 387 0.001088 0.000000 251: $last = 0 if $last < 0; # there is no way 387 0.001487 0.000000 252: $request->init_header('Range' => "bytes=0- 0 0.000000 0.000000 253: } 387 0.000984 0.000000 254: $cookie_jar->add_cookie_header($request) 0 0.000000 0.000000 255: 387 0.002132 0.000000 256: return($request); 0 0.000000 0.000000 257:} 0 0.000000 0.000000 258: 0 0.000000 0.000000 259: 0 0.000000 0.000000 260:sub simple_request 387 0.000000 0.000000 261:{ 387 0.001507 0.000000 262: my($self, $request, $arg, $size) = @_; 387 0.002519 0.000000 263: $self->_request_sanity_check($request); 387 0.002520 0.010000 264: my $new_request = $self- 387 0.002543 0.010000 265: return($self->send_request($new_request, 0 0.000000 0.000000 266:} 0 0.000000 0.000000 267: 0 0.000000 0.000000 268: 0 0.000000 0.000000 269:sub request 387 0.000000 0.000000 270:{ 387 0.001836 0.000000 271: my($self, $request, $arg, $size, 0 0.000000 0.000000 272: 387 0.002281 0.000000 273: LWP::Debug::trace('()'); 0 0.000000 0.000000 274: 387 0.002388 0.000000 275: my $response = $self- 0 0.000000 0.000000 276: 387 0.002363 0.000000 277: my $code = $response->code; 387 0.001315 0.010000 278: $response->previous($previous) if defined 0 0.000000 0.000000 279: 387 0.002914 0.010000 280: LWP::Debug::debug('Simple response: ' . ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/UserAgent.pm Page 104 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 281: (HTTP::Status::status_message($code) 0 0.000000 0.000000 282: "Unknown code $code")); 0 0.000000 0.000000 283: 387 0.002742 0.000000 284: if ($code == 0 0.000000 0.000000 285: $code == &HTTP::Status::RC_FOUND or 0 0.000000 0.000000 286: $code == &HTTP::Status::RC_SEE_OTHER or 0 0.000000 0.000000 287: $code == 0 0.000000 0.000000 288: { 29 0.000214 0.000000 289: my $referral = $request->clone; 0 0.000000 0.000000 290: 0 0.000000 0.000000 291: # These headers should never be forwarded 29 0.000126 0.000000 292: $referral->remove_header('Host', 'Cookie'); 0 0.000000 0.000000 293: 29 0.000101 0.000000 294: if ($referral->header('Referer') && 0 0.000000 0.000000 295: $request->url->scheme eq 'https' && 0 0.000000 0.000000 296: $referral->url->scheme eq 'http') 0 0.000000 0.000000 297: { 0 0.000000 0.000000 298: # RFC 2616, section 15.1.3. 0 0.000000 0.000000 299: LWP::Debug::trace("https -> http 0 0.000000 0.000000 300: $referral->remove_header('Referer'); 0 0.000000 0.000000 301: } 0 0.000000 0.000000 302: 29 0.000200 0.000000 303: if ($code == &HTTP::Status::RC_SEE_OTHER || 0 0.000000 0.000000 304: $code == &HTTP::Status::RC_FOUND) 0 0.000000 0.000000 305: { 19 0.000109 0.000000 306: my $method = uc($referral->method); 19 0.000072 0.000000 307: unless ($method eq "GET" || $method eq 0 0.000000 0.000000 308: $referral->method("GET"); 0 0.000000 0.000000 309: $referral->content(""); 0 0.000000 0.000000 310: $referral->remove_content_headers; 0 0.000000 0.000000 311: } 0 0.000000 0.000000 312: } 0 0.000000 0.000000 313: 0 0.000000 0.000000 314: # And then we update the URL based on the 29 0.000102 0.000000 315: my $referral_uri = $response- 0 0.000000 0.000000 316: { 0 0.000000 0.000000 317: # Some servers erroneously return a 0 0.000000 0.000000 318: # so make it absolute if it not already 58 0.000203 0.000000 319: local $URI::ABS_ALLOW_RELATIVE_SCHEME = 29 0.000187 0.000000 320: my $base = $response->base; 29 0.000100 0.000000 321: $referral_uri = "" unless defined 29 0.000146 0.000000 322: $referral_uri = $HTTP::URI_CLASS- 0 0.000000 0.000000 323: ->abs($base); 0 0.000000 0.000000 324: } 29 0.000187 0.000000 325: $referral->url($referral_uri); 0 0.000000 0.000000 326: 0 0.000000 0.000000 327: # Check for loop in the redirects, we only 29 0.000100 0.000000 328: my $count = 0; 29 0.000077 0.000000 329: my $r = $response; 29 0.000093 0.000000 330: while ($r) { 32 0.000127 0.000000 331: if (++$count > $self->{max_redirect}) { 0 0.000000 0.000000 332: $response->header("Client-Warning" => 0 0.000000 0.000000 333: "Redirect loop detected (max_redirect = 0 0.000000 0.000000 334: return $response; 0 0.000000 0.000000 335: } 32 0.000218 0.000000 336: $r = $r->previous; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/UserAgent.pm Page 105 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 337: } 0 0.000000 0.000000 338: 29 0.000232 0.000000 339: return $response unless $self- 29 0.000236 0.000000 340: return $self->request($referral, $arg, 0 0.000000 0.000000 341: 0 0.000000 0.000000 342: } 0 0.000000 0.000000 343: elsif ($code == 0 0.000000 0.000000 344: $code == 0 0.000000 0.000000 345: ) 0 0.000000 0.000000 346: { 0 0.000000 0.000000 347: my $proxy = ($code == 0 0.000000 0.000000 348: my $ch_header = $proxy ? "Proxy- 0 0.000000 0.000000 349: my @challenge = $response- 0 0.000000 0.000000 350: unless (@challenge) { 0 0.000000 0.000000 351: $response->header("Client-Warning" => 0 0.000000 0.000000 352: "Missing Authenticate header"); 0 0.000000 0.000000 353: return $response; 0 0.000000 0.000000 354: } 0 0.000000 0.000000 355: 0 0.000000 0.000000 356: require HTTP::Headers::Util; 0 0.000000 0.000000 357: CHALLENGE: for my $challenge (@challenge) { 0 0.000000 0.000000 358: $challenge =~ tr/,/;/; # "," is used to 0 0.000000 0.000000 359: ($challenge) = 0 0.000000 0.000000 360: my $scheme = lc(shift(@$challenge)); 0 0.000000 0.000000 361: shift(@$challenge); # no value 0 0.000000 0.000000 362: $challenge = { @$challenge }; # make 0 0.000000 0.000000 363: for (keys %$challenge) { # make 0 0.000000 0.000000 364: $challenge->{lc $_} = delete $challenge- 0 0.000000 0.000000 365: } 0 0.000000 0.000000 366: 0 0.000000 0.000000 367: unless ($scheme =~ /^([a-z]+(?:-[a- 0 0.000000 0.000000 368: $response->header("Client-Warning" => 0 0.000000 0.000000 369: "Bad authentication scheme '$scheme'"); 0 0.000000 0.000000 370: return $response; 0 0.000000 0.000000 371: } 0 0.000000 0.000000 372: $scheme = $1; # untainted now 0 0.000000 0.000000 373: my $class = "LWP::Authen::\u$scheme"; 0 0.000000 0.000000 374: $class =~ s/-/_/g; 0 0.000000 0.000000 375: 0 0.000000 0.000000 376: no strict 'refs'; 0 0.000000 0.000000 377: unless (%{"$class\::"}) { 0 0.000000 0.000000 378: # try to load it 0 0.000000 0.000000 379: eval "require $class"; 0 0.000000 0.000000 380: if ($@) { 0 0.000000 0.000000 381: if ($@ =~ /^Can\'t locate/) { 0 0.000000 0.000000 382: $response->header("Client-Warning" => 0 0.000000 0.000000 383: "Unsupported authentication scheme 0 0.000000 0.000000 384: } 0 0.000000 0.000000 385: else { 0 0.000000 0.000000 386: $response->header("Client-Warning" => $@); 0 0.000000 0.000000 387: } 0 0.000000 0.000000 388: next CHALLENGE; 0 0.000000 0.000000 389: } 0 0.000000 0.000000 390: } 0 0.000000 0.000000 391: unless ($class->can("authenticate")) { 0 0.000000 0.000000 392: $response->header("Client-Warning" => ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/UserAgent.pm Page 106 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 393: "Unsupported authentication scheme 0 0.000000 0.000000 394: next CHALLENGE; 0 0.000000 0.000000 395: } 0 0.000000 0.000000 396: return $class->authenticate($self, 0 0.000000 0.000000 397: $request, $arg, $size); 0 0.000000 0.000000 398: } 0 0.000000 0.000000 399: return $response; 0 0.000000 0.000000 400: } 358 0.002935 0.000000 401: return $response; 0 0.000000 0.000000 402:} 0 0.000000 0.000000 403: 0 0.000000 0.000000 404: 0 0.000000 0.000000 405:# 0 0.000000 0.000000 406:# Now the shortcuts... 0 0.000000 0.000000 407:# 0 0.000000 0.000000 408:sub get { 0 0.000000 0.000000 409: require HTTP::Request::Common; 0 0.000000 0.000000 410: my($self, @parameters) = @_; 0 0.000000 0.000000 411: my @suff = $self- 0 0.000000 0.000000 412: return $self->request( 0 0.000000 0.000000 413:} 0 0.000000 0.000000 414: 0 0.000000 0.000000 415: 0 0.000000 0.000000 416:sub post { 0 0.000000 0.000000 417: require HTTP::Request::Common; 0 0.000000 0.000000 418: my($self, @parameters) = @_; 0 0.000000 0.000000 419: my @suff = $self- 0 0.000000 0.000000 420: return $self->request( 0 0.000000 0.000000 421:} 0 0.000000 0.000000 422: 0 0.000000 0.000000 423: 0 0.000000 0.000000 424:sub head { 0 0.000000 0.000000 425: require HTTP::Request::Common; 0 0.000000 0.000000 426: my($self, @parameters) = @_; 0 0.000000 0.000000 427: my @suff = $self- 0 0.000000 0.000000 428: return $self->request( 0 0.000000 0.000000 429:} 0 0.000000 0.000000 430: 0 0.000000 0.000000 431: 0 0.000000 0.000000 432:sub _process_colonic_headers { 0 0.000000 0.000000 433: # Process :content_cb / :content_file / 0 0.000000 0.000000 434: my($self, $args, $start_index) = @_; 0 0.000000 0.000000 435: 0 0.000000 0.000000 436: my($arg, $size); 0 0.000000 0.000000 437: for(my $i = $start_index; $i < @$args; $i 0 0.000000 0.000000 438: next unless defined $args->[$i]; 0 0.000000 0.000000 439: 0 0.000000 0.000000 440: #printf "Considering %s => %s\n", $args- 0 0.000000 0.000000 441: 0 0.000000 0.000000 442: if($args->[$i] eq ':content_cb') { 0 0.000000 0.000000 443: # Some sanity-checking... 0 0.000000 0.000000 444: $arg = $args->[$i + 1]; 0 0.000000 0.000000 445: Carp::croak("A :content_cb value can't 0 0.000000 0.000000 446: Carp::croak("A :content_cb value must be 0 0.000000 0.000000 447: unless ref $arg and UNIVERSAL::isa($arg, 0 0.000000 0.000000 448: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/UserAgent.pm Page 107 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 449: } 0 0.000000 0.000000 450: elsif ($args->[$i] eq ':content_file') { 0 0.000000 0.000000 451: $arg = $args->[$i + 1]; 0 0.000000 0.000000 452: 0 0.000000 0.000000 453: # Some sanity-checking... 0 0.000000 0.000000 454: Carp::croak("A :content_file value can't 0 0.000000 0.000000 455: unless defined $arg; 0 0.000000 0.000000 456: Carp::croak("A :content_file value can't 0 0.000000 0.000000 457: if ref $arg; 0 0.000000 0.000000 458: Carp::croak("A :content_file value can't 0 0.000000 0.000000 459: unless length $arg; 0 0.000000 0.000000 460: 0 0.000000 0.000000 461: } 0 0.000000 0.000000 462: elsif ($args->[$i] eq ':read_size_hint') { 0 0.000000 0.000000 463: $size = $args->[$i + 1]; 0 0.000000 0.000000 464: # Bother checking it? 0 0.000000 0.000000 465: 0 0.000000 0.000000 466: } 0 0.000000 0.000000 467: else { 0 0.000000 0.000000 468: next; 0 0.000000 0.000000 469: } 0 0.000000 0.000000 470: splice @$args, $i, 2; 0 0.000000 0.000000 471: $i -= 2; 0 0.000000 0.000000 472: } 0 0.000000 0.000000 473: 0 0.000000 0.000000 474: # And return a suitable suffix-list for 0 0.000000 0.000000 475: 0 0.000000 0.000000 476: return unless defined $arg; 0 0.000000 0.000000 477: return $arg, $size if defined $size; 0 0.000000 0.000000 478: return $arg; 0 0.000000 0.000000 479:} 0 0.000000 0.000000 480: 0 0.000000 0.000000 481: 0 0.000000 0.000000 482:# 0 0.000000 0.000000 483:# This whole allow/forbid thing is based on 0 0.000000 0.000000 484:# 0 0.000000 0.000000 485:sub is_protocol_supported 0 0.000000 0.000000 486:{ 0 0.000000 0.000000 487: my($self, $scheme) = @_; 0 0.000000 0.000000 488: if (ref $scheme) { 0 0.000000 0.000000 489: # assume we got a reference to an URI object 0 0.000000 0.000000 490: $scheme = $scheme->scheme; 0 0.000000 0.000000 491: } 0 0.000000 0.000000 492: else { 0 0.000000 0.000000 493: Carp::croak("Illegal scheme '$scheme' passed 0 0.000000 0.000000 494: if $scheme =~ /\W/; 0 0.000000 0.000000 495: $scheme = lc $scheme; 0 0.000000 0.000000 496: } 0 0.000000 0.000000 497: 0 0.000000 0.000000 498: my $x; 0 0.000000 0.000000 499: if(ref($self) and $x = $self- 0 0.000000 0.000000 500: return 0 unless grep lc($_) eq $scheme, 0 0.000000 0.000000 501: } 0 0.000000 0.000000 502: elsif (ref($self) and $x = $self- 0 0.000000 0.000000 503: return 0 if grep lc($_) eq $scheme, 0 0.000000 0.000000 504: } ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/UserAgent.pm Page 108 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 505: 0 0.000000 0.000000 506: local($SIG{__DIE__}); # protect against 0 0.000000 0.000000 507: $x = LWP::Protocol::implementor($scheme); 0 0.000000 0.000000 508: return 1 if $x and $x ne 0 0.000000 0.000000 509: return 0; 0 0.000000 0.000000 510:} 0 0.000000 0.000000 511: 0 0.000000 0.000000 512: 774 0.002323 0.020000 513:sub protocols_allowed { shift- 774 0.002138 0.000000 514:sub protocols_forbidden { shift- 58 0.000202 0.000000 515:sub requests_redirectable { shift- 0 0.000000 0.000000 516: 0 0.000000 0.000000 517: 0 0.000000 0.000000 518:sub redirect_ok 29 0.000000 0.000000 519:{ 0 0.000000 0.000000 520: # RFC 2616, section 10.3.2 and 10.3.3 0 0.000000 0.000000 521: # If the 30[12] status code is received 0 0.000000 0.000000 522: # than GET or HEAD, the user agent MUST 0 0.000000 0.000000 523: # request unless it can be confirmed by 0 0.000000 0.000000 524: # change the conditions under which the 0 0.000000 0.000000 525: 0 0.000000 0.000000 526: # Note that this routine used to be just: 0 0.000000 0.000000 527: # return 0 if $_[1]->method eq "POST"; 0 0.000000 0.000000 528: 29 0.000131 0.000000 529: my($self, $new_request, $response) = @_; 29 0.000165 0.000000 530: my $method = $response->request->method; 29 0.000187 0.000000 531: return 0 unless grep $_ eq $method, 29 0.000108 0.000000 532: @{ $self->requests_redirectable || [] 0 0.000000 0.000000 533: 29 0.000163 0.000000 534: if ($new_request->url->scheme eq 'file') 0 0.000000 0.000000 535: $response->header("Client-Warning" => 0 0.000000 0.000000 536: "Can't redirect to a file:// URL!"); 0 0.000000 0.000000 537: return 0; 0 0.000000 0.000000 538: } 0 0.000000 0.000000 539: 0 0.000000 0.000000 540: # Otherwise it's apparently okay... 29 0.000166 0.000000 541: return 1; 0 0.000000 0.000000 542:} 0 0.000000 0.000000 543: 0 0.000000 0.000000 544: 0 0.000000 0.000000 545:sub credentials 0 0.000000 0.000000 546:{ 0 0.000000 0.000000 547: my($self, $netloc, $realm, $uid, $pass) = 0 0.000000 0.000000 548: @{ $self- 0 0.000000 0.000000 549: ($uid, $pass); 0 0.000000 0.000000 550:} 0 0.000000 0.000000 551: 0 0.000000 0.000000 552: 0 0.000000 0.000000 553:sub get_basic_credentials 0 0.000000 0.000000 554:{ 0 0.000000 0.000000 555: my($self, $realm, $uri, $proxy) = @_; 0 0.000000 0.000000 556: return if $proxy; 0 0.000000 0.000000 557: 0 0.000000 0.000000 558: my $host_port = lc($uri->host_port); 0 0.000000 0.000000 559: if (exists $self- 0 0.000000 0.000000 560: return @{ $self- ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/UserAgent.pm Page 109 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 561: } 0 0.000000 0.000000 562: 0 0.000000 0.000000 563: return (undef, undef); 0 0.000000 0.000000 564:} 0 0.000000 0.000000 565: 0 0.000000 0.000000 566: 290 0.000000 0.000000 567:sub agent { 290 0.000999 0.000000 568: my $self = shift; 290 0.001214 0.000000 569: my $old = $self->{agent}; 290 0.000969 0.000000 570: if (@_) { 290 0.000954 0.000000 571: my $agent = shift; 290 0.001509 0.000000 572: $agent .= $self->_agent if $agent && $agent 290 0.001355 0.010000 573: $self->{agent} = $agent; 0 0.000000 0.000000 574: } 290 0.001167 0.000000 575: $old; 0 0.000000 0.000000 576:} 0 0.000000 0.000000 577: 0 0.000000 0.000000 578: 580 0.001946 0.000000 579:sub _agent { "libwww- 0 0.000000 0.000000 580: 580 0.001984 0.000000 581:sub timeout { shift->_elem('timeout', 0 0.000000 0.000000 582:sub from { shift->_elem('from', 0 0.000000 0.000000 583:sub parse_head { shift->_elem('parse_head', 580 0.001599 0.000000 584:sub max_size { shift->_elem('max_size', 0 0.000000 0.000000 585:sub max_redirect { shift- 0 0.000000 0.000000 586: 0 0.000000 0.000000 587: 0 0.000000 0.000000 588:sub cookie_jar { 0 0.000000 0.000000 589: my $self = shift; 0 0.000000 0.000000 590: my $old = $self->{cookie_jar}; 0 0.000000 0.000000 591: if (@_) { 0 0.000000 0.000000 592: my $jar = shift; 0 0.000000 0.000000 593: if (ref($jar) eq "HASH") { 0 0.000000 0.000000 594: require HTTP::Cookies; 0 0.000000 0.000000 595: $jar = HTTP::Cookies->new(%$jar); 0 0.000000 0.000000 596: } 0 0.000000 0.000000 597: $self->{cookie_jar} = $jar; 0 0.000000 0.000000 598: } 0 0.000000 0.000000 599: $old; 0 0.000000 0.000000 600:} 0 0.000000 0.000000 601: 0 0.000000 0.000000 602: 0 0.000000 0.000000 603:sub conn_cache { 0 0.000000 0.000000 604: my $self = shift; 0 0.000000 0.000000 605: my $old = $self->{conn_cache}; 0 0.000000 0.000000 606: if (@_) { 0 0.000000 0.000000 607: my $cache = shift; 0 0.000000 0.000000 608: if (ref($cache) eq "HASH") { 0 0.000000 0.000000 609: require LWP::ConnCache; 0 0.000000 0.000000 610: $cache = LWP::ConnCache->new(%$cache); 0 0.000000 0.000000 611: } 0 0.000000 0.000000 612: $self->{conn_cache} = $cache; 0 0.000000 0.000000 613: } 0 0.000000 0.000000 614: $old; 0 0.000000 0.000000 615:} 0 0.000000 0.000000 616: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/UserAgent.pm Page 110 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 617: 0 0.000000 0.000000 618:# depreciated 0 0.000000 0.000000 619:sub use_eval { shift->_elem('use_eval', 0 0.000000 0.000000 620:sub use_alarm 0 0.000000 0.000000 621:{ 0 0.000000 0.000000 622: Carp::carp("LWP::UserAgent- 0 0.000000 0.000000 623: if @_ > 1 && $^W; 0 0.000000 0.000000 624: ""; 0 0.000000 0.000000 625:} 0 0.000000 0.000000 626: 0 0.000000 0.000000 627: 0 0.000000 0.000000 628:sub clone 0 0.000000 0.000000 629:{ 0 0.000000 0.000000 630: my $self = shift; 0 0.000000 0.000000 631: my $copy = bless { %$self }, ref $self; 0 0.000000 0.000000 632: 0 0.000000 0.000000 633: # elements that are references must be 0 0.000000 0.000000 634: $copy->{'proxy'} = { %{$self->{'proxy'}} 0 0.000000 0.000000 635: $copy->{'no_proxy'} = [ @{$self- 0 0.000000 0.000000 636: 0 0.000000 0.000000 637: # remove reference to objects for now 0 0.000000 0.000000 638: delete $copy->{cookie_jar}; 0 0.000000 0.000000 639: delete $copy->{conn_cache}; 0 0.000000 0.000000 640: 0 0.000000 0.000000 641: $copy; 0 0.000000 0.000000 642:} 0 0.000000 0.000000 643: 0 0.000000 0.000000 644: 0 0.000000 0.000000 645:sub mirror 0 0.000000 0.000000 646:{ 0 0.000000 0.000000 647: my($self, $url, $file) = @_; 0 0.000000 0.000000 648: 0 0.000000 0.000000 649: LWP::Debug::trace('()'); 0 0.000000 0.000000 650: my $request = HTTP::Request->new('GET', 0 0.000000 0.000000 651: 0 0.000000 0.000000 652: if (-e $file) { 0 0.000000 0.000000 653: my($mtime) = (stat($file))[9]; 0 0.000000 0.000000 654: if($mtime) { 0 0.000000 0.000000 655: $request->header('If-Modified-Since' => 0 0.000000 0.000000 656: HTTP::Date::time2str($mtime)); 0 0.000000 0.000000 657: } 0 0.000000 0.000000 658: } 0 0.000000 0.000000 659: my $tmpfile = "$file-$$"; 0 0.000000 0.000000 660: 0 0.000000 0.000000 661: my $response = $self->request($request, 0 0.000000 0.000000 662: if ($response->is_success) { 0 0.000000 0.000000 663: 0 0.000000 0.000000 664: my $file_length = (stat($tmpfile))[7]; 0 0.000000 0.000000 665: my($content_length) = $response- 0 0.000000 0.000000 666: 0 0.000000 0.000000 667: if (defined $content_length and $file_length 0 0.000000 0.000000 668: unlink($tmpfile); 0 0.000000 0.000000 669: die "Transfer truncated: " . 0 0.000000 0.000000 670: "only $file_length out of $content_length 0 0.000000 0.000000 671: } 0 0.000000 0.000000 672: elsif (defined $content_length and ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/UserAgent.pm Page 111 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 673: unlink($tmpfile); 0 0.000000 0.000000 674: die "Content-length mismatch: " . 0 0.000000 0.000000 675: "expected $content_length bytes, got 0 0.000000 0.000000 676: } 0 0.000000 0.000000 677: else { 0 0.000000 0.000000 678: # OK 0 0.000000 0.000000 679: if (-e $file) { 0 0.000000 0.000000 680: # Some dosish systems fail to rename if the 0 0.000000 0.000000 681: chmod 0777, $file; 0 0.000000 0.000000 682: unlink $file; 0 0.000000 0.000000 683: } 0 0.000000 0.000000 684: rename($tmpfile, $file) or 0 0.000000 0.000000 685: die "Cannot rename '$tmpfile' to '$file': 0 0.000000 0.000000 686: 0 0.000000 0.000000 687: if (my $lm = $response->last_modified) { 0 0.000000 0.000000 688: # make sure the file has the same last 0 0.000000 0.000000 689: utime $lm, $lm, $file; 0 0.000000 0.000000 690: } 0 0.000000 0.000000 691: } 0 0.000000 0.000000 692: } 0 0.000000 0.000000 693: else { 0 0.000000 0.000000 694: unlink($tmpfile); 0 0.000000 0.000000 695: } 0 0.000000 0.000000 696: return $response; 0 0.000000 0.000000 697:} 0 0.000000 0.000000 698: 0 0.000000 0.000000 699: 0 0.000000 0.000000 700:sub proxy 0 0.000000 0.000000 701:{ 0 0.000000 0.000000 702: my $self = shift; 0 0.000000 0.000000 703: my $key = shift; 0 0.000000 0.000000 704: 0 0.000000 0.000000 705: LWP::Debug::trace("$key @_"); 0 0.000000 0.000000 706: 0 0.000000 0.000000 707: return map $self->proxy($_, @_), @$key if 0 0.000000 0.000000 708: 0 0.000000 0.000000 709: my $old = $self->{'proxy'}{$key}; 0 0.000000 0.000000 710: $self->{'proxy'}{$key} = shift if @_; 0 0.000000 0.000000 711: return $old; 0 0.000000 0.000000 712:} 0 0.000000 0.000000 713: 0 0.000000 0.000000 714: 0 0.000000 0.000000 715:sub env_proxy { 0 0.000000 0.000000 716: my ($self) = @_; 0 0.000000 0.000000 717: my($k,$v); 0 0.000000 0.000000 718: while(($k, $v) = each %ENV) { 0 0.000000 0.000000 719: if ($ENV{REQUEST_METHOD}) { 0 0.000000 0.000000 720: # Need to be careful when called in the 0 0.000000 0.000000 721: # the HTTP_PROXY variable is under 0 0.000000 0.000000 722: next if $k =~ /^HTTP_/; 0 0.000000 0.000000 723: $k = "HTTP_PROXY" if $k eq 0 0.000000 0.000000 724: } 0 0.000000 0.000000 725: $k = lc($k); 0 0.000000 0.000000 726: next unless $k =~ /^(.*)_proxy$/; 0 0.000000 0.000000 727: $k = $1; 0 0.000000 0.000000 728: if ($k eq 'no') { ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/UserAgent.pm Page 112 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 729: $self->no_proxy(split(/\s*,\s*/, $v)); 0 0.000000 0.000000 730: } 0 0.000000 0.000000 731: else { 0 0.000000 0.000000 732: $self->proxy($k, $v); 0 0.000000 0.000000 733: } 0 0.000000 0.000000 734: } 0 0.000000 0.000000 735:} 0 0.000000 0.000000 736: 0 0.000000 0.000000 737: 0 0.000000 0.000000 738:sub no_proxy { 0 0.000000 0.000000 739: my($self, @no) = @_; 0 0.000000 0.000000 740: if (@no) { 0 0.000000 0.000000 741: push(@{ $self->{'no_proxy'} }, @no); 0 0.000000 0.000000 742: } 0 0.000000 0.000000 743: else { 0 0.000000 0.000000 744: $self->{'no_proxy'} = []; 0 0.000000 0.000000 745: } 0 0.000000 0.000000 746:} 0 0.000000 0.000000 747: 0 0.000000 0.000000 748: 0 0.000000 0.000000 749:# Private method which returns the URL of the 0 0.000000 0.000000 750:# URL, or undefined if none is configured. 0 0.000000 0.000000 751:sub _need_proxy 387 0.000000 0.000000 752:{ 387 0.003673 0.020000 753: my($self, $url) = @_; 387 0.001362 0.000000 754: $url = $HTTP::URI_CLASS->new($url) unless 0 0.000000 0.000000 755: 387 0.001923 0.000000 756: my $scheme = $url->scheme || return; 387 0.002107 0.000000 757: if (my $proxy = $self- 0 0.000000 0.000000 758: if (@{ $self->{'no_proxy'} }) { 0 0.000000 0.000000 759: if (my $host = eval { $url->host }) { 0 0.000000 0.000000 760: for my $domain (@{ $self->{'no_proxy'} }) { 0 0.000000 0.000000 761: if ($host =~ /\Q$domain\E$/) { 0 0.000000 0.000000 762: LWP::Debug::trace("no_proxy configured"); 0 0.000000 0.000000 763: return; 0 0.000000 0.000000 764: } 0 0.000000 0.000000 765: } 0 0.000000 0.000000 766: } 0 0.000000 0.000000 767: } 0 0.000000 0.000000 768: LWP::Debug::debug("Proxied to $proxy"); 0 0.000000 0.000000 769: return $HTTP::URI_CLASS->new($proxy); 0 0.000000 0.000000 770: } 387 0.002248 0.000000 771: LWP::Debug::debug('Not proxied'); 387 0.002077 0.010000 772: undef; 0 0.000000 0.000000 773:} 0 0.000000 0.000000 774: 0 0.000000 0.000000 775: 36 0.000000 0.000000 776:sub _new_response { 36 0.000159 0.000000 777: my($request, $code, $message) = @_; 36 0.000272 0.000000 778: my $response = HTTP::Response->new($code, 36 0.000241 0.000000 779: $response->request($request); 36 0.000292 0.000000 780: $response->header("Client-Date" => 36 0.000124 0.000000 781: $response->header("Client-Warning" => 36 0.000119 0.000000 782: $response->header("Content-Type" => 36 0.000248 0.000000 783: $response->content("$code $message\n"); 36 0.000227 0.000000 784: return $response; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/LWP/UserAgent.pm Page 113 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 785:} 0 0.000000 0.000000 786: 0 0.000000 0.000000 787: 0 0.000000 0.000000 788:1; 0 0.000000 0.000000 789: 0 0.000000 0.000000 790:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/Net/HTTP.pm Page 114 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package Net::HTTP; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:# $Id: HTTP.pm,v 1.44 2004/04/09 15:07:04 0 0.000000 0.000000 4: 3 0.000011 0.000000 5:use strict; 3 0.000008 0.000000 6:use vars qw($VERSION @ISA); 0 0.000000 0.000000 7: 1 0.000004 0.000000 8:$VERSION = "1.00"; 2 0.000008 0.000000 9:eval { require IO::Socket::INET } || require 1 0.000005 0.000000 10:require Net::HTTP::Methods; 0 0.000000 0.000000 11: 1 0.000009 0.000000 12:@ISA=qw(IO::Socket::INET Net::HTTP::Methods); 0 0.000000 0.000000 13: 387 0.000000 0.000000 14:sub configure { 387 0.001398 0.010000 15: my($self, $cnf) = @_; 387 0.002803 0.020000 16: $self->http_configure($cnf); 0 0.000000 0.000000 17:} 0 0.000000 0.000000 18: 387 0.000000 0.000000 19:sub http_connect { 387 0.001336 0.000000 20: my($self, $cnf) = @_; 387 0.002619 0.000000 21: $self->SUPER::configure($cnf); 0 0.000000 0.000000 22:} 0 0.000000 0.000000 23: 1 0.000023 0.000000 24:1; 0 0.000000 0.000000 25: 0 0.000000 0.000000 26:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/Net/HTTP/Methods. Page 115 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package Net::HTTP::Methods; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:# $Id: Methods.pm,v 1.14 2003/10/15 10:45:29 0 0.000000 0.000000 4: 1 0.000004 0.000000 5:require 5.005; # 4-arg substr 0 0.000000 0.000000 6: 3 0.000013 0.000000 7:use strict; 3 0.000011 0.000000 8:use vars qw($VERSION); 0 0.000000 0.000000 9: 1 0.000006 0.000000 10:$VERSION = "1.00"; 0 0.000000 0.000000 11: 1 0.000004 0.000000 12:my $CRLF = "\015\012"; # "\r\n" is not 0 0.000000 0.000000 13: 0 0.000000 0.000000 14:sub new { 0 0.000000 0.000000 15: my($class, %cnf) = @_; 0 0.000000 0.000000 16: require Symbol; 0 0.000000 0.000000 17: my $self = bless Symbol::gensym(), 0 0.000000 0.000000 18: return $self->http_configure(\%cnf); 0 0.000000 0.000000 19:} 0 0.000000 0.000000 20: 387 0.000000 0.000000 21:sub http_configure { 387 0.001451 0.020000 22: my($self, $cnf) = @_; 0 0.000000 0.000000 23: 387 0.001357 0.000000 24: die "Listen option not allowed" if $cnf- 387 0.002555 0.000000 25: my $host = delete $cnf->{Host}; 387 0.001603 0.010000 26: my $peer = $cnf->{PeerAddr} || $cnf- 387 0.001320 0.000000 27: if ($host) { 0 0.000000 0.000000 28: $cnf->{PeerAddr} = $host unless $peer; 0 0.000000 0.000000 29: } 0 0.000000 0.000000 30: else { 387 0.001192 0.000000 31: $host = $peer; 387 0.001681 0.010000 32: $host =~ s/:.*//; 0 0.000000 0.000000 33: } 387 0.001356 0.000000 34: $cnf->{PeerPort} = $self- 387 0.001354 0.010000 35: $cnf->{Proto} = 'tcp'; 0 0.000000 0.000000 36: 387 0.001832 0.000000 37: my $keep_alive = delete $cnf- 387 0.001247 0.000000 38: my $http_version = delete $cnf- 387 0.001104 0.010000 39: $http_version = "1.1" unless defined 387 0.001208 0.010000 40: my $peer_http_version = delete $cnf- 387 0.001114 0.000000 41: $peer_http_version = "1.0" unless defined 387 0.001693 0.000000 42: my $send_te = delete $cnf->{SendTE}; 387 0.001299 0.020000 43: my $max_line_length = delete $cnf- 387 0.001021 0.010000 44: $max_line_length = 4*1024 unless defined 387 0.001240 0.020000 45: my $max_header_lines = delete $cnf- 387 0.001092 0.000000 46: $max_header_lines = 128 unless defined 0 0.000000 0.000000 47: 387 0.002267 0.010000 48: return undef unless $self- 0 0.000000 0.000000 49: 355 0.001887 0.000000 50: unless ($host =~ /:/) { 355 0.002400 0.000000 51: my $p = $self->peerport; 355 0.001779 0.000000 52: $host .= ":$p"; 0 0.000000 0.000000 53: } 355 0.001722 0.000000 54: $self->host($host); 355 0.001224 0.000000 55: $self->keep_alive($keep_alive); 355 0.001271 0.000000 56: $self->send_te($send_te); ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/Net/HTTP/Methods. Page 116 ================================================================= count wall tm cpu time line 355 0.002883 0.010000 57: $self->http_version($http_version); 355 0.001256 0.000000 58: $self- 355 0.001224 0.030000 59: $self->max_line_length($max_line_length); 355 0.001171 0.010000 60: $self- 0 0.000000 0.000000 61: 710 0.003266 0.000000 62: ${*$self}{'http_buf'} = ""; 0 0.000000 0.000000 63: 355 0.006748 0.000000 64: return $self; 0 0.000000 0.000000 65:} 0 0.000000 0.000000 66: 0 0.000000 0.000000 67:sub http_default_port { 0 0.000000 0.000000 68: 80; 0 0.000000 0.000000 69:} 0 0.000000 0.000000 70: 0 0.000000 0.000000 71:# set up property accessors 1 0.000004 0.000000 72:for my $method (qw(host keep_alive send_te 6 0.000023 0.000000 73: my $prop_name = "http_" . $method; 3 0.000012 0.000000 74: no strict 'refs'; 0 0.000000 0.000000 75: *$method = sub { 3191 0.010523 0.040000 76: my $self = shift; 6382 0.027063 0.080000 77: my $old = ${*$self}{$prop_name}; 5321 0.023811 0.060000 78: ${*$self}{$prop_name} = shift if @_; 3191 0.016305 0.080000 79: return $old; 6 0.000100 0.000000 80: }; 0 0.000000 0.000000 81:} 0 0.000000 0.000000 82: 0 0.000000 0.000000 83:# we want this one to be a bit smarter 355 0.000000 0.000000 84:sub http_version { 355 0.001227 0.010000 85: my $self = shift; 710 0.003084 0.010000 86: my $old = ${*$self}{'http_version'}; 355 0.001076 0.010000 87: if (@_) { 355 0.001143 0.000000 88: my $v = shift; 355 0.001021 0.000000 89: $v = "1.0" if $v eq "1"; # float 355 0.001315 0.000000 90: unless ($v eq "1.0" or $v eq "1.1") { 0 0.000000 0.000000 91: require Carp; 0 0.000000 0.000000 92: Carp::croak("Unsupported HTTP version 0 0.000000 0.000000 93: } 710 0.004054 0.010000 94: ${*$self}{'http_version'} = $v; 0 0.000000 0.000000 95: } 355 0.001592 0.000000 96: $old; 0 0.000000 0.000000 97:} 0 0.000000 0.000000 98: 355 0.000000 0.000000 99:sub format_request { 355 0.001234 0.020000 100: my $self = shift; 355 0.001147 0.010000 101: my $method = shift; 355 0.001176 0.000000 102: my $uri = shift; 0 0.000000 0.000000 103: 355 0.001660 0.000000 104: my $content = (@_ % 2) ? pop : ""; 0 0.000000 0.000000 105: 355 0.001308 0.010000 106: for ($method, $uri) { 710 0.002250 0.010000 107: require Carp; 710 0.003961 0.020000 108: Carp::croak("Bad method or uri") if /\s/ || 0 0.000000 0.000000 109: } 0 0.000000 0.000000 110: 1065 0.005302 0.000000 111: push(@{${*$self}{'http_request_method'}}, 710 0.003085 0.000000 112: my $ver = ${*$self}{'http_version'}; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/Net/HTTP/Methods. Page 117 ================================================================= count wall tm cpu time line 710 0.002824 0.020000 113: my $peer_ver = 0 0.000000 0.000000 114: 355 0.000970 0.000000 115: my @h; 355 0.000956 0.000000 116: my @connection; 355 0.002713 0.000000 117: my %given = (host => 0, "content-length" 355 0.001169 0.000000 118: while (@_) { 1065 0.004320 0.010000 119: my($k, $v) = splice(@_, 0, 2); 1065 0.003192 0.000000 120: my $lc_k = lc($k); 1065 0.003042 0.010000 121: if ($lc_k eq "connection") { 0 0.000000 0.000000 122: push(@connection, split(/\s*,\s*/, $v)); 0 0.000000 0.000000 123: next; 0 0.000000 0.000000 124: } 1065 0.003438 0.010000 125: if (exists $given{$lc_k}) { 355 0.001262 0.000000 126: $given{$lc_k}++; 0 0.000000 0.000000 127: } 1065 0.005635 0.020000 128: push(@h, "$k: $v"); 0 0.000000 0.000000 129: } 0 0.000000 0.000000 130: 355 0.000981 0.000000 131: if (length($content) && !$given{'content- 0 0.000000 0.000000 132: push(@h, "Content-Length: " . 0 0.000000 0.000000 133: } 0 0.000000 0.000000 134: 355 0.000956 0.000000 135: my @h2; 355 0.001284 0.020000 136: if ($given{te}) { 0 0.000000 0.000000 137: push(@connection, "TE") unless grep lc($_) 0 0.000000 0.000000 138: } 0 0.000000 0.000000 139: elsif ($self->send_te && zlib_ok()) { 0 0.000000 0.000000 140: # gzip is less wanted since the 0 0.000000 0.000000 141: # it does not really allow chunked decoding 0 0.000000 0.000000 142: push(@h2, "TE: deflate,gzip;q=0.3"); 0 0.000000 0.000000 143: push(@connection, "TE"); 0 0.000000 0.000000 144: } 0 0.000000 0.000000 145: 355 0.001354 0.010000 146: unless (grep lc($_) eq "close", 355 0.001142 0.000000 147: if ($self->keep_alive) { 0 0.000000 0.000000 148: if ($peer_ver eq "1.0") { 0 0.000000 0.000000 149: # from looking at Netscape's headers 0 0.000000 0.000000 150: push(@h2, "Keep-Alive: 300"); 0 0.000000 0.000000 151: unshift(@connection, "Keep-Alive"); 0 0.000000 0.000000 152: } 0 0.000000 0.000000 153: } 0 0.000000 0.000000 154: else { 355 0.002148 0.000000 155: push(@connection, "close") if $ver ge 0 0.000000 0.000000 156: } 0 0.000000 0.000000 157: } 355 0.002317 0.010000 158: push(@h2, "Connection: " . join(", ", 355 0.001340 0.010000 159: push(@h2, "Host: ${*$self}{'http_host'}") 0 0.000000 0.000000 160: 355 0.005001 0.010000 161: return join($CRLF, "$method $uri 0 0.000000 0.000000 162:} 0 0.000000 0.000000 163: 0 0.000000 0.000000 164: 0 0.000000 0.000000 165:sub write_request { 0 0.000000 0.000000 166: my $self = shift; 0 0.000000 0.000000 167: $self->print($self->format_request(@_)); 0 0.000000 0.000000 168:} ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/Net/HTTP/Methods. Page 118 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169: 0 0.000000 0.000000 170:sub format_chunk { 0 0.000000 0.000000 171: my $self = shift; 0 0.000000 0.000000 172: return $_[0] unless defined($_[0]) && 0 0.000000 0.000000 173: return sprintf("%x", length($_[0])) . 0 0.000000 0.000000 174:} 0 0.000000 0.000000 175: 0 0.000000 0.000000 176:sub write_chunk { 0 0.000000 0.000000 177: my $self = shift; 0 0.000000 0.000000 178: return 1 unless defined($_[0]) && 0 0.000000 0.000000 179: $self->print(sprintf("%x", length($_[0])) 0 0.000000 0.000000 180:} 0 0.000000 0.000000 181: 0 0.000000 0.000000 182:sub format_chunk_eof { 0 0.000000 0.000000 183: my $self = shift; 0 0.000000 0.000000 184: my @h; 0 0.000000 0.000000 185: while (@_) { 0 0.000000 0.000000 186: push(@h, sprintf "%s: %s$CRLF", splice(@_, 0 0.000000 0.000000 187: } 0 0.000000 0.000000 188: return join("", "0$CRLF", @h, $CRLF); 0 0.000000 0.000000 189:} 0 0.000000 0.000000 190: 0 0.000000 0.000000 191:sub write_chunk_eof { 0 0.000000 0.000000 192: my $self = shift; 0 0.000000 0.000000 193: $self->print($self- 0 0.000000 0.000000 194:} 0 0.000000 0.000000 195: 0 0.000000 0.000000 196: 2745 0.000000 0.000000 197:sub my_read { 2745 0.009206 0.020000 198: die if @_ > 3; 2745 0.007898 0.020000 199: my $self = shift; 2745 0.007660 0.020000 200: my $len = $_[1]; 5490 0.021292 0.050000 201: for (${*$self}{'http_buf'}) { 2745 0.007750 0.010000 202: if (length) { 1110 0.007544 0.040000 203: $_[0] = substr($_, 0, $len, ""); 1110 0.007835 0.020000 204: return length($_[0]); 0 0.000000 0.000000 205: } 0 0.000000 0.000000 206: else { 1635 0.012298 0.010000 207: return $self->sysread($_[0], $len); 0 0.000000 0.000000 208: } 0 0.000000 0.000000 209: } 0 0.000000 0.000000 210:} 0 0.000000 0.000000 211: 0 0.000000 0.000000 212: 5287 0.000000 0.000000 213:sub my_readline { 5287 0.016851 0.030000 214: my $self = shift; 10574 0.041426 0.110000 215: for (${*$self}{'http_buf'}) { 10574 0.042079 0.080000 216: my $max_line_length = 5287 0.012837 0.040000 217: my $pos; 5287 0.012851 0.020000 218: while (1) { 0 0.000000 0.000000 219: # find line ending 6084 0.018406 0.030000 220: $pos = index($_, "\012"); 6084 0.019490 0.090000 221: last if $pos >= 0; 803 0.002649 0.000000 222: die "Line too long (limit is 0 0.000000 0.000000 223: if $max_line_length && length($_) > 0 0.000000 0.000000 224: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/Net/HTTP/Methods. Page 119 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 225: # need to read more data to find a line 803 0.006402 0.010000 226: my $n = $self->sysread($_, 1024, 799 0.002947 0.020000 227: if (!$n) { 2 0.000024 0.000000 228: return undef unless length; 0 0.000000 0.000000 229: return substr($_, 0, length, ""); 0 0.000000 0.000000 230: } 0 0.000000 0.000000 231: } 5281 0.014227 0.040000 232: die "Line too long ($pos; limit is 0 0.000000 0.000000 233: if $max_line_length && $pos > 0 0.000000 0.000000 234: 5281 0.022329 0.050000 235: my $line = substr($_, 0, $pos+1, ""); 5281 0.034258 0.060000 236: $line =~ s/(\015?\012)\z// || die "Assert"; 5281 0.042346 0.040000 237: return wantarray ? ($line, $1) : $line; 0 0.000000 0.000000 238: } 0 0.000000 0.000000 239:} 0 0.000000 0.000000 240: 0 0.000000 0.000000 241: 0 0.000000 0.000000 242:sub _rbuf { 0 0.000000 0.000000 243: my $self = shift; 0 0.000000 0.000000 244: if (@_) { 0 0.000000 0.000000 245: for (${*$self}{'http_buf'}) { 0 0.000000 0.000000 246: my $old; 0 0.000000 0.000000 247: $old = $_ if defined wantarray; 0 0.000000 0.000000 248: $_ = shift; 0 0.000000 0.000000 249: return $old; 0 0.000000 0.000000 250: } 0 0.000000 0.000000 251: } 0 0.000000 0.000000 252: else { 0 0.000000 0.000000 253: return ${*$self}{'http_buf'}; 0 0.000000 0.000000 254: } 0 0.000000 0.000000 255:} 0 0.000000 0.000000 256: 0 0.000000 0.000000 257:sub _rbuf_length { 0 0.000000 0.000000 258: my $self = shift; 0 0.000000 0.000000 259: return length ${*$self}{'http_buf'}; 0 0.000000 0.000000 260:} 0 0.000000 0.000000 261: 0 0.000000 0.000000 262: 510 0.000000 0.000000 263:sub _read_header_lines { 510 0.001997 0.000000 264: my $self = shift; 510 0.001496 0.010000 265: my $junk_out = shift; 0 0.000000 0.000000 266: 510 0.001326 0.000000 267: my @headers; 510 0.001484 0.000000 268: my $line_count = 0; 1020 0.005018 0.010000 269: my $max_header_lines = 510 0.003247 0.000000 270: while (my $line = my_readline($self)) { 2405 0.018489 0.020000 271: if ($line =~ /^(\S+)\s*:\s*(.*)/s) { 2404 0.015678 0.040000 272: push(@headers, $1, $2); 0 0.000000 0.000000 273: } 0 0.000000 0.000000 274: elsif (@headers && $line =~ s/^\s+//) { 0 0.000000 0.000000 275: $headers[-1] .= " " . $line; 0 0.000000 0.000000 276: } 0 0.000000 0.000000 277: elsif ($junk_out) { 1 0.000005 0.000000 278: push(@$junk_out, $line); 0 0.000000 0.000000 279: } 0 0.000000 0.000000 280: else { ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/Net/HTTP/Methods. Page 120 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 281: die "Bad header: '$line'\n"; 0 0.000000 0.000000 282: } 2405 0.006489 0.020000 283: if ($max_header_lines) { 2405 0.006113 0.020000 284: $line_count++; 2405 0.014445 0.040000 285: if ($line_count >= $max_header_lines) { 0 0.000000 0.000000 286: die "Too many header lines (limit is 0 0.000000 0.000000 287: } 0 0.000000 0.000000 288: } 0 0.000000 0.000000 289: } 510 0.008978 0.010000 290: return @headers; 0 0.000000 0.000000 291:} 0 0.000000 0.000000 292: 0 0.000000 0.000000 293: 355 0.000000 0.000000 294:sub read_response_headers { 355 0.002591 0.010000 295: my($self, %opt) = @_; 355 0.001298 0.000000 296: my $laxed = $opt{laxed}; 0 0.000000 0.000000 297: 355 0.002587 0.010000 298: my($status, $eol) = my_readline($self); 351 0.001099 0.000000 299: unless (defined $status) { 2 0.000007 0.000000 300: die "EOF instead of response status line" 0 0.000000 0.000000 301: # assume HTTP/0.9 4 0.000023 0.000000 302: ${*$self}{'http_peer_http_version'} = "0.9"; 4 0.000021 0.000000 303: ${*$self}{'http_status'} = "200"; 2 0.000005 0.000000 304: return 200 unless wantarray; 2 0.000039 0.000000 305: return (200, "EOF"); 0 0.000000 0.000000 306: } 0 0.000000 0.000000 307: 349 0.002989 0.010000 308: my($peer_ver, $code, $message) = 349 0.003155 0.000000 309: if (!$peer_ver || $peer_ver !~ s,^HTTP/,, 0 0.000000 0.000000 310: die "Bad response status line: '$status'" 0 0.000000 0.000000 311: # assume HTTP/0.9 0 0.000000 0.000000 312: ${*$self}{'http_peer_http_version'} = "0.9"; 0 0.000000 0.000000 313: ${*$self}{'http_status'} = "200"; 0 0.000000 0.000000 314: substr(${*$self}{'http_buf'}, 0, 0) = 0 0.000000 0.000000 315: return 200 unless wantarray; 0 0.000000 0.000000 316: return (200, "Assumed OK"); 0 0.000000 0.000000 317: }; 0 0.000000 0.000000 318: 698 0.003631 0.010000 319: ${*$self}{'http_peer_http_version'} = 698 0.003654 0.010000 320: ${*$self}{'http_status'} = $code; 0 0.000000 0.000000 321: 349 0.000924 0.000000 322: my $junk_out; 349 0.001048 0.000000 323: if ($laxed) { 349 0.001598 0.010000 324: $junk_out = $opt{junk_out} || []; 0 0.000000 0.000000 325: } 349 0.002750 0.010000 326: my @headers = $self- 0 0.000000 0.000000 327: 0 0.000000 0.000000 328: # pick out headers that read_entity_body 349 0.001037 0.010000 329: my @te; 349 0.000877 0.000000 330: my $content_length; 349 0.001420 0.020000 331: for (my $i = 0; $i < @headers; $i += 2) { 2404 0.008299 0.020000 332: my $h = lc($headers[$i]); 2404 0.009608 0.020000 333: if ($h eq 'transfer-encoding') { 161 0.000846 0.000000 334: push(@te, $headers[$i+1]); 0 0.000000 0.000000 335: } 0 0.000000 0.000000 336: elsif ($h eq 'content-length') { ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/Net/HTTP/Methods. Page 121 ================================================================= count wall tm cpu time line 182 0.000857 0.000000 337: $content_length = $headers[$i+1]; 0 0.000000 0.000000 338: } 349 0.000939 0.010000 339: } 698 0.003842 0.030000 340: ${*$self}{'http_te'} = join(",", @te); 698 0.004299 0.010000 341: ${*$self}{'http_content_length'} = 698 0.003517 0.000000 342: ${*$self}{'http_first_body'}++; 698 0.002910 0.000000 343: delete ${*$self}{'http_trailers'}; 349 0.000985 0.010000 344: return $code unless wantarray; 349 0.012581 0.010000 345: return ($code, $message, @headers); 0 0.000000 0.000000 346:} 0 0.000000 0.000000 347: 0 0.000000 0.000000 348: 3088 0.000000 0.000000 349:sub read_entity_body { 3088 0.010516 0.040000 350: my $self = shift; 3088 0.010550 0.000000 351: my $buf_ref = \$_[0]; 3088 0.009367 0.020000 352: my $size = $_[1]; 3088 0.008687 0.020000 353: die "Offset not supported yet" if $_[2]; 0 0.000000 0.000000 354: 3088 0.007403 0.020000 355: my $chunked; 3088 0.007154 0.040000 356: my $bytes; 0 0.000000 0.000000 357: 6176 0.026054 0.040000 358: if (${*$self}{'http_first_body'}) { 698 0.002977 0.010000 359: ${*$self}{'http_first_body'} = 0; 698 0.002863 0.000000 360: delete ${*$self}{'http_chunked'}; 698 0.002687 0.030000 361: delete ${*$self}{'http_bytes'}; 1047 0.004508 0.030000 362: my $method = 698 0.003089 0.000000 363: my $status = ${*$self}{'http_status'}; 698 0.004161 0.020000 364: if ($method eq "HEAD" || $status =~ 0 0.000000 0.000000 365: # these responses are always empty 0 0.000000 0.000000 366: $bytes = 0; 0 0.000000 0.000000 367: } 188 0.001199 0.010000 368: elsif (my $te = ${*$self}{'http_te'}) { 161 0.001340 0.000000 369: my @te = split(/\s*,\s*/, lc($te)); 161 0.000672 0.000000 370: die "Chunked must be last Transfer- 0 0.000000 0.000000 371: unless pop(@te) eq "chunked"; 0 0.000000 0.000000 372: 161 0.000722 0.000000 373: for (@te) { 0 0.000000 0.000000 374: if ($_ eq "deflate" && zlib_ok()) { 0 0.000000 0.000000 375: #require Compress::Zlib; 0 0.000000 0.000000 376: my $i = Compress::Zlib::inflateInit(); 0 0.000000 0.000000 377: die "Can't make inflator" unless $i; 0 0.000000 0.000000 378: $_ = sub { scalar($i->inflate($_[0])) } 0 0.000000 0.000000 379: } 0 0.000000 0.000000 380: elsif ($_ eq "gzip" && zlib_ok()) { 0 0.000000 0.000000 381: #require Compress::Zlib; 0 0.000000 0.000000 382: my @buf; 0 0.000000 0.000000 383: $_ = sub { 0 0.000000 0.000000 384: push(@buf, $_[0]); 0 0.000000 0.000000 385: return Compress::Zlib::memGunzip(join("", 0 0.000000 0.000000 386: return ""; 0 0.000000 0.000000 387: }; 0 0.000000 0.000000 388: } 0 0.000000 0.000000 389: elsif ($_ eq "identity") { 0 0.000000 0.000000 390: $_ = sub { $_[0] }; 0 0.000000 0.000000 391: } 0 0.000000 0.000000 392: else { ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/Net/HTTP/Methods. Page 122 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 393: die "Can't handle transfer encoding 0 0.000000 0.000000 394: } 0 0.000000 0.000000 395: } 0 0.000000 0.000000 396: 161 0.000617 0.020000 397: @te = reverse(@te); 0 0.000000 0.000000 398: 322 0.001722 0.000000 399: ${*$self}{'http_te2'} = @te ? \@te : ""; 161 0.000809 0.000000 400: $chunked = -1; 0 0.000000 0.000000 401: } 0 0.000000 0.000000 402: elsif (defined(my $content_length = 182 0.000982 0.000000 403: $bytes = $content_length; 0 0.000000 0.000000 404: } 0 0.000000 0.000000 405: else { 0 0.000000 0.000000 406: # XXX Multi-Part types are self 0 0.000000 0.000000 407: # only has to deal with 0 0.000000 0.000000 408: 0 0.000000 0.000000 409: # Read until EOF 0 0.000000 0.000000 410: } 0 0.000000 0.000000 411: } 0 0.000000 0.000000 412: else { 5478 0.022435 0.050000 413: $chunked = ${*$self}{'http_chunked'}; 5478 0.023394 0.050000 414: $bytes = ${*$self}{'http_bytes'}; 0 0.000000 0.000000 415: } 0 0.000000 0.000000 416: 3088 0.008468 0.010000 417: if (defined $chunked) { 0 0.000000 0.000000 418: # The state encoded in $chunked is: 0 0.000000 0.000000 419: # $chunked == 0: read CRLF after chunk, 0 0.000000 0.000000 420: # $chunked == -1: read chunk 0 0.000000 0.000000 421: # $chunked > 0: bytes left in current 0 0.000000 0.000000 422: 1952 0.005038 0.000000 423: if ($chunked <= 0) { 1089 0.006710 0.000000 424: my $line = my_readline($self); 1089 0.003098 0.010000 425: if ($chunked == 0) { 928 0.003160 0.010000 426: die "Missing newline after chunk data: 0 0.000000 0.000000 427: if !defined($line) || $line ne ""; 928 0.005726 0.030000 428: $line = my_readline($self); 928 0.002665 0.010000 429: die "EOF when chunk header expected" unless 0 0.000000 0.000000 430: } 1089 0.003104 0.000000 431: my $chunk_len = $line; 1089 0.003748 0.000000 432: $chunk_len =~ s/;.*//; # ignore 1089 0.006899 0.030000 433: unless ($chunk_len =~ /^([\da-fA- 0 0.000000 0.000000 434: die "Bad chunk-size in HTTP response: 0 0.000000 0.000000 435: } 1089 0.005630 0.020000 436: $chunked = hex($1); 1089 0.003343 0.010000 437: if ($chunked == 0) { 322 0.002327 0.010000 438: ${*$self}{'http_trailers'} = [$self- 161 0.000494 0.000000 439: $$buf_ref = ""; 0 0.000000 0.000000 440: 161 0.000441 0.000000 441: my $n = 0; 322 0.001645 0.010000 442: if (my $transforms = delete 0 0.000000 0.000000 443: for (@$transforms) { 0 0.000000 0.000000 444: $$buf_ref = &$_($$buf_ref, 1); 0 0.000000 0.000000 445: } 0 0.000000 0.000000 446: $n = length($$buf_ref); 0 0.000000 0.000000 447: } 0 0.000000 0.000000 448: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/Net/HTTP/Methods. Page 123 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 449: # in case somebody tries to read more, make 0 0.000000 0.000000 450: # to return EOF 322 0.001417 0.010000 451: delete ${*$self}{'http_chunked'}; 322 0.001409 0.010000 452: ${*$self}{'http_bytes'} = 0; 0 0.000000 0.000000 453: 161 0.001055 0.000000 454: return $n; 0 0.000000 0.000000 455: } 0 0.000000 0.000000 456: } 0 0.000000 0.000000 457: 1791 0.005052 0.030000 458: my $n = $chunked; 1791 0.004923 0.000000 459: $n = $size if $size && $size < $n; 1791 0.010899 0.000000 460: $n = my_read($self, $$buf_ref, $n); 1791 0.005032 0.020000 461: return undef unless defined $n; 0 0.000000 0.000000 462: 3582 0.017676 0.030000 463: ${*$self}{'http_chunked'} = $chunked - $n; 0 0.000000 0.000000 464: 1791 0.005262 0.000000 465: if ($n > 0) { 3582 0.016155 0.020000 466: if (my $transforms = 0 0.000000 0.000000 467: for (@$transforms) { 0 0.000000 0.000000 468: $$buf_ref = &$_($$buf_ref, 0); 0 0.000000 0.000000 469: } 0 0.000000 0.000000 470: $n = length($$buf_ref); 0 0.000000 0.000000 471: $n = -1 if $n == 0; 0 0.000000 0.000000 472: } 0 0.000000 0.000000 473: } 1791 0.011235 0.020000 474: return $n; 0 0.000000 0.000000 475: } 0 0.000000 0.000000 476: elsif (defined $bytes) { 1110 0.002857 0.000000 477: unless ($bytes) { 182 0.000566 0.000000 478: $$buf_ref = ""; 182 0.001176 0.000000 479: return 0; 0 0.000000 0.000000 480: } 928 0.002699 0.000000 481: my $n = $bytes; 928 0.002943 0.000000 482: $n = $size if $size && $size < $n; 928 0.005785 0.020000 483: $n = my_read($self, $$buf_ref, $n); 928 0.002824 0.010000 484: return undef unless defined $n; 1856 0.009401 0.030000 485: ${*$self}{'http_bytes'} = $bytes - $n; 928 0.006212 0.020000 486: return $n; 0 0.000000 0.000000 487: } 0 0.000000 0.000000 488: else { 0 0.000000 0.000000 489: # read until eof 26 0.000082 0.000000 490: $size ||= 8*1024; 26 0.000172 0.000000 491: return my_read($self, $$buf_ref, $size); 0 0.000000 0.000000 492: } 0 0.000000 0.000000 493:} 0 0.000000 0.000000 494: 351 0.000000 0.000000 495:sub get_trailers { 351 0.001204 0.000000 496: my $self = shift; 1053 0.005645 0.010000 497: @{${*$self}{'http_trailers'} || []}; 0 0.000000 0.000000 498:} 0 0.000000 0.000000 499: 0 0.000000 0.000000 500:BEGIN { 1 0.000054 0.000000 501:my $zlib_ok; 0 0.000000 0.000000 502: 355 0.000000 0.000000 503:sub zlib_ok { 355 0.001995 0.010000 504: return $zlib_ok if defined $zlib_ok; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/Net/HTTP/Methods. Page 124 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 505: 0 0.000000 0.000000 506: # Try to load Compress::Zlib. 1 0.000002 0.000000 507: local $@; 1 0.000012 0.000000 508: local $SIG{__DIE__}; 1 0.000005 0.000000 509: $zlib_ok = 0; 0 0.000000 0.000000 510: 1 0.000003 0.000000 511: eval { 1 0.000502 0.000000 512: require Compress::Zlib; 0 0.000000 0.000000 513: Compress::Zlib->VERSION(1.10); 0 0.000000 0.000000 514: $zlib_ok++; 0 0.000000 0.000000 515: }; 0 0.000000 0.000000 516: 1 0.000010 0.000000 517: return $zlib_ok; 0 0.000000 0.000000 518:} 0 0.000000 0.000000 519: 0 0.000000 0.000000 520:} # BEGIN 0 0.000000 0.000000 521: 1 0.000022 0.000000 522:1; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI.pm Page 125 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package URI; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:use strict; 0 0.000000 0.000000 4:use vars qw($VERSION); 0 0.000000 0.000000 5:$VERSION = "1.30"; # $Date: 2004/01/14 0 0.000000 0.000000 6: 0 0.000000 0.000000 7:use vars qw($ABS_REMOTE_LEADING_DOTS 0 0.000000 0.000000 8: 0 0.000000 0.000000 9:my %implements; # mapping from scheme to 0 0.000000 0.000000 10: 0 0.000000 0.000000 11:# Some "official" character classes 0 0.000000 0.000000 12: 0 0.000000 0.000000 13:use vars qw($reserved $mark $unreserved $uric 0 0.000000 0.000000 14:$reserved = q(;/?:@&=+$,[]); 0 0.000000 0.000000 15:$mark = q(-_.!~*'()); 0 0.000000 0.000000 16:$unreserved = "A-Za-z0-9\Q$mark\E"; 0 0.000000 0.000000 17:$uric = quotemeta($reserved) . 0 0.000000 0.000000 18: 0 0.000000 0.000000 19:$scheme_re = '[a-zA-Z][a-zA-Z0-9.+\-]*'; 0 0.000000 0.000000 20: 0 0.000000 0.000000 21:use Carp (); 0 0.000000 0.000000 22:use URI::Escape (); 0 0.000000 0.000000 23: 1664 0.008270 0.010000 24:use overload ('""' => sub { ${$_[0]} }, 0 0.000000 0.000000 25: '==' => sub { 0 0.000000 0.000000 26: 0 0.000000 0.000000 27: }, 0 0.000000 0.000000 28: fallback => 1, 0 0.000000 0.000000 29: ); 0 0.000000 0.000000 30: 0 0.000000 0.000000 31:sub new 474 0.000000 0.000000 32:{ 474 0.002679 0.010000 33: my($class, $uri, $scheme) = @_; 0 0.000000 0.000000 34: 474 0.002059 0.000000 35: $uri = defined ($uri) ? "$uri" : ""; # 0 0.000000 0.000000 36: # Get rid of potential wrapping 474 0.002432 0.010000 37: $uri =~ s/^<(?:URL:)?(.*)>$/$1/; # 474 0.001849 0.010000 38: $uri =~ s/^"(.*)"$/$1/; 474 0.002440 0.000000 39: $uri =~ s/^\s+//; 474 0.002132 0.000000 40: $uri =~ s/\s+$//; 0 0.000000 0.000000 41: 474 0.001214 0.010000 42: my $impclass; 474 0.003882 0.010000 43: if ($uri =~ m/^($scheme_re):/so) { 443 0.002810 0.000000 44: $scheme = $1; 0 0.000000 0.000000 45: } 0 0.000000 0.000000 46: else { 31 0.000114 0.000000 47: if (($impclass = ref($scheme))) { 31 0.000178 0.000000 48: $scheme = $scheme->scheme; 0 0.000000 0.000000 49: } 0 0.000000 0.000000 50: elsif ($scheme && $scheme =~ 0 0.000000 0.000000 51: $scheme = $1; 0 0.000000 0.000000 52: } 0 0.000000 0.000000 53: } 0 0.000000 0.000000 54: $impclass ||= implementor($scheme) || 474 0.003072 0.010000 55: do { 0 0.000000 0.000000 56: require URI::_foreign; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI.pm Page 126 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: $impclass = 'URI::_foreign'; 0 0.000000 0.000000 58: }; 0 0.000000 0.000000 59: 474 0.002616 0.000000 60: return $impclass->_init($uri, $scheme); 0 0.000000 0.000000 61:} 0 0.000000 0.000000 62: 0 0.000000 0.000000 63: 0 0.000000 0.000000 64:sub new_abs 29 0.000000 0.000000 65:{ 29 0.000142 0.000000 66: my($class, $uri, $base) = @_; 29 0.000173 0.000000 67: $uri = $class->new($uri, $base); 29 0.000221 0.000000 68: $uri->abs($base); 0 0.000000 0.000000 69:} 0 0.000000 0.000000 70: 0 0.000000 0.000000 71: 0 0.000000 0.000000 72:sub _init 474 0.000000 0.000000 73:{ 474 0.001594 0.000000 74: my $class = shift; 474 0.002067 0.000000 75: my($str, $scheme) = @_; 474 0.003334 0.010000 76: $str =~ 474 0.003304 0.000000 77: $str = "$scheme:$str" unless $str =~ 0 0.000000 0.000000 78: $class- 474 0.003029 0.000000 79: my $self = bless \$str, $class; 474 0.003671 0.000000 80: $self; 0 0.000000 0.000000 81:} 0 0.000000 0.000000 82: 0 0.000000 0.000000 83: 0 0.000000 0.000000 84:sub implementor 443 0.000000 0.000000 85:{ 443 0.001793 0.000000 86: my($scheme, $impclass) = @_; 443 0.003067 0.010000 87: if (!$scheme || $scheme !~ 0 0.000000 0.000000 88: require URI::_generic; 0 0.000000 0.000000 89: return "URI::_generic"; 0 0.000000 0.000000 90: } 0 0.000000 0.000000 91: 443 0.001518 0.000000 92: $scheme = lc($scheme); 0 0.000000 0.000000 93: 443 0.001279 0.000000 94: if ($impclass) { 0 0.000000 0.000000 95: # Set the implementor class for a given 0 0.000000 0.000000 96: my $old = $implements{$scheme}; 0 0.000000 0.000000 97: $impclass- 0 0.000000 0.000000 98: $implements{$scheme} = $impclass; 0 0.000000 0.000000 99: return $old; 0 0.000000 0.000000 100: } 0 0.000000 0.000000 101: 443 0.001896 0.000000 102: my $ic = $implements{$scheme}; 443 0.002494 0.010000 103: return $ic if $ic; 0 0.000000 0.000000 104: 0 0.000000 0.000000 105: # scheme not yet known, look for internal 0 0.000000 0.000000 106: # preloaded (with 'use') implementation 1 0.000003 0.000000 107: $ic = "URI::$scheme"; # default location 0 0.000000 0.000000 108: 0 0.000000 0.000000 109: # turn scheme into a valid perl 1 0.000003 0.000000 110: $ic =~ s/\+/_P/g; 1 0.000003 0.000000 111: $ic =~ s/\./_O/g; 1 0.000002 0.000000 112: $ic =~ s/\-/_/g; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI.pm Page 127 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113: 0 0.000000 0.000000 114: no strict 'refs'; 0 0.000000 0.000000 115: # check we actually have one for the 2 0.000020 0.000000 116: unless (@{"${ic}::ISA"}) { 0 0.000000 0.000000 117: # Try to load it 1 0.000073 0.000000 118: eval "require $ic"; 1 0.000004 0.000000 119: die $@ if $@ && $@ !~ /Can\'t 2 0.000010 0.000000 120: return unless @{"${ic}::ISA"}; 0 0.000000 0.000000 121: } 0 0.000000 0.000000 122: 1 0.000006 0.000000 123: $ic->_init_implementor($scheme); 1 0.000005 0.000000 124: $implements{$scheme} = $ic; 1 0.000006 0.000000 125: $ic; 0 0.000000 0.000000 126:} 0 0.000000 0.000000 127: 0 0.000000 0.000000 128: 0 0.000000 0.000000 129:sub _init_implementor 1 0.000000 0.000000 130:{ 1 0.000007 0.000000 131: my($class, $scheme) = @_; 0 0.000000 0.000000 132: # Remember that one implementor class may 0 0.000000 0.000000 133: # serve to implement several URI schemes. 0 0.000000 0.000000 134:} 0 0.000000 0.000000 135: 0 0.000000 0.000000 136: 0 0.000000 0.000000 137:sub clone 145 0.000000 0.000000 138:{ 145 0.000460 0.000000 139: my $self = shift; 145 0.000507 0.000000 140: my $other = $$self; 145 0.001123 0.000000 141: bless \$other, ref $self; 0 0.000000 0.000000 142:} 0 0.000000 0.000000 143: 0 0.000000 0.000000 144: 0 0.000000 0.000000 145:sub _no_scheme_ok { 0 } 0 0.000000 0.000000 146: 0 0.000000 0.000000 147:sub _scheme 1422 0.000000 0.000000 148:{ 1422 0.004700 0.010000 149: my $self = shift; 0 0.000000 0.000000 150: 1422 0.004273 0.030000 151: unless (@_) { 1364 0.009770 0.000000 152: return unless $$self =~ /^($scheme_re):/o; 1333 0.009747 0.030000 153: return $1; 0 0.000000 0.000000 154: } 0 0.000000 0.000000 155: 58 0.000139 0.000000 156: my $old; 58 0.000168 0.000000 157: my $new = shift; 58 0.000174 0.000000 158: if (defined($new) && length($new)) { 58 0.000451 0.000000 159: Carp::croak("Bad scheme '$new'") unless $new 58 0.000463 0.010000 160: $old = $1 if $$self =~ s/^($scheme_re)://o; 58 0.000303 0.000000 161: my $newself = URI->new("$new:$$self"); 58 0.000266 0.000000 162: $$self = $$newself; 58 0.000340 0.000000 163: bless $self, ref($newself); 0 0.000000 0.000000 164: } 0 0.000000 0.000000 165: else { 0 0.000000 0.000000 166: if ($self->_no_scheme_ok) { 0 0.000000 0.000000 167: $old = $1 if $$self =~ 0 0.000000 0.000000 168: Carp::carp("Oops, opaque part now look ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI.pm Page 128 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169: if $^W && $$self =~ m/^$scheme_re:/o 0 0.000000 0.000000 170: } 0 0.000000 0.000000 171: else { 0 0.000000 0.000000 172: $old = $1 if $$self =~ 0 0.000000 0.000000 173: } 0 0.000000 0.000000 174: } 0 0.000000 0.000000 175: 58 0.000316 0.000000 176: return $old; 0 0.000000 0.000000 177:} 0 0.000000 0.000000 178: 0 0.000000 0.000000 179:sub scheme 1422 0.000000 0.000000 180:{ 1422 0.007321 0.030000 181: my $scheme = shift->_scheme(@_); 1422 0.003877 0.010000 182: return unless defined $scheme; 1360 0.007814 0.040000 183: lc($scheme); 0 0.000000 0.000000 184:} 0 0.000000 0.000000 185: 0 0.000000 0.000000 186: 0 0.000000 0.000000 187:sub opaque 0 0.000000 0.000000 188:{ 0 0.000000 0.000000 189: my $self = shift; 0 0.000000 0.000000 190: 0 0.000000 0.000000 191: unless (@_) { 0 0.000000 0.000000 192: $$self =~ /^(?:$scheme_re:)?([^\#]*)/o or 0 0.000000 0.000000 193: return $1; 0 0.000000 0.000000 194: } 0 0.000000 0.000000 195: 0 0.000000 0.000000 196: $$self =~ /^($scheme_re:)? # optional 0 0.000000 0.000000 197: ([^\#]*) # opaque 0 0.000000 0.000000 198: (\#.*)? # optional 0 0.000000 0.000000 199: $/sx or die; 0 0.000000 0.000000 200: 0 0.000000 0.000000 201: my $old_scheme = $1; 0 0.000000 0.000000 202: my $old_opaque = $2; 0 0.000000 0.000000 203: my $old_frag = $3; 0 0.000000 0.000000 204: 0 0.000000 0.000000 205: my $new_opaque = shift; 0 0.000000 0.000000 206: $new_opaque = "" unless defined 0 0.000000 0.000000 207: $new_opaque =~ 0 0.000000 0.000000 208: 0 0.000000 0.000000 209: $$self = defined($old_scheme) ? 0 0.000000 0.000000 210: $$self .= $new_opaque; 0 0.000000 0.000000 211: $$self .= $old_frag if defined $old_frag; 0 0.000000 0.000000 212: 0 0.000000 0.000000 213: $old_opaque; 0 0.000000 0.000000 214:} 0 0.000000 0.000000 215: 0 0.000000 0.000000 216:*path = \&opaque; # alias 0 0.000000 0.000000 217: 0 0.000000 0.000000 218: 0 0.000000 0.000000 219:sub fragment 58 0.000000 0.000000 220:{ 58 0.000186 0.000000 221: my $self = shift; 58 0.000180 0.000000 222: unless (@_) { 58 0.000336 0.000000 223: return unless $$self =~ /\#(.*)/s; 0 0.000000 0.000000 224: return $1; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI.pm Page 129 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 225: } 0 0.000000 0.000000 226: 0 0.000000 0.000000 227: my $old; 0 0.000000 0.000000 228: $old = $1 if $$self =~ s/\#(.*)//s; 0 0.000000 0.000000 229: 0 0.000000 0.000000 230: my $new_frag = shift; 0 0.000000 0.000000 231: if (defined $new_frag) { 0 0.000000 0.000000 232: $new_frag =~ 0 0.000000 0.000000 233: $$self .= "#$new_frag"; 0 0.000000 0.000000 234: } 0 0.000000 0.000000 235: $old; 0 0.000000 0.000000 236:} 0 0.000000 0.000000 237: 0 0.000000 0.000000 238: 0 0.000000 0.000000 239:sub as_string 0 0.000000 0.000000 240:{ 0 0.000000 0.000000 241: my $self = shift; 0 0.000000 0.000000 242: $$self; 0 0.000000 0.000000 243:} 0 0.000000 0.000000 244: 0 0.000000 0.000000 245: 0 0.000000 0.000000 246:sub canonical 0 0.000000 0.000000 247:{ 0 0.000000 0.000000 248: my $self = shift; 0 0.000000 0.000000 249: 0 0.000000 0.000000 250: # Make sure scheme is lowercased 0 0.000000 0.000000 251: my $scheme = $self->_scheme || ""; 0 0.000000 0.000000 252: my $uc_scheme = $scheme =~ /[A-Z]/; 0 0.000000 0.000000 253: my $lc_esc = $$self =~ /%(?:[a-f][a- 0 0.000000 0.000000 254: if ($uc_scheme || $lc_esc) { 0 0.000000 0.000000 255: my $other = $self->clone; 0 0.000000 0.000000 256: $other->_scheme(lc $scheme) if $uc_scheme; 0 0.000000 0.000000 257: $$other =~ s/(%(?:[a-f][a-fA-F0-9]|[A-F0- 0 0.000000 0.000000 258: if $lc_esc; 0 0.000000 0.000000 259: return $other; 0 0.000000 0.000000 260: } 0 0.000000 0.000000 261: $self; 0 0.000000 0.000000 262:} 0 0.000000 0.000000 263: 0 0.000000 0.000000 264:# Compare two URIs, subclasses will provide a 0 0.000000 0.000000 265:sub eq { 0 0.000000 0.000000 266: my($self, $other) = @_; 0 0.000000 0.000000 267: $self = URI->new($self, $other) unless 0 0.000000 0.000000 268: $other = URI->new($other, $self) unless 0 0.000000 0.000000 269: ref($self) eq ref($other) && 0 0.000000 0.000000 270: $self->canonical->as_string eq $other- 0 0.000000 0.000000 271:} 0 0.000000 0.000000 272: 0 0.000000 0.000000 273:# generic-URI transformation methods 0 0.000000 0.000000 274:sub abs { $_[0]; } 0 0.000000 0.000000 275:sub rel { $_[0]; } 0 0.000000 0.000000 276: 0 0.000000 0.000000 277:# help out Storable 0 0.000000 0.000000 278:sub STORABLE_freeze { 0 0.000000 0.000000 279: my($self, $cloning) = @_; 0 0.000000 0.000000 280: return $$self; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI.pm Page 130 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 281:} 0 0.000000 0.000000 282: 0 0.000000 0.000000 283:sub STORABLE_thaw { 0 0.000000 0.000000 284: my($self, $cloning, $str) = @_; 0 0.000000 0.000000 285: $$self = $str; 0 0.000000 0.000000 286:} 0 0.000000 0.000000 287: 0 0.000000 0.000000 288:1; 0 0.000000 0.000000 289: 0 0.000000 0.000000 290:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI/Escape.pm Page 131 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:# 0 0.000000 0.000000 2:# $Id: Escape.pm,v 3.22 2004/01/14 13:33:44 0 0.000000 0.000000 3:# 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:package URI::Escape; 0 0.000000 0.000000 6:use strict; 0 0.000000 0.000000 7: 0 0.000000 0.000000 8:=head1 NAME 0 0.000000 0.000000 9: 0 0.000000 0.000000 10: 0 0.000000 0.000000 11: 0 0.000000 0.000000 12: 0 0.000000 0.000000 13: 0 0.000000 0.000000 14: 0 0.000000 0.000000 15: 0 0.000000 0.000000 16: 0 0.000000 0.000000 17: 0 0.000000 0.000000 18: 0 0.000000 0.000000 19: 0 0.000000 0.000000 20: 0 0.000000 0.000000 21: 0 0.000000 0.000000 22: 0 0.000000 0.000000 23: 0 0.000000 0.000000 24: 0 0.000000 0.000000 25: 0 0.000000 0.000000 26: 0 0.000000 0.000000 27: 0 0.000000 0.000000 28: 0 0.000000 0.000000 29: 0 0.000000 0.000000 30: 0 0.000000 0.000000 31: 0 0.000000 0.000000 32: 0 0.000000 0.000000 33: 0 0.000000 0.000000 34: 0 0.000000 0.000000 35: 0 0.000000 0.000000 36: 0 0.000000 0.000000 37: 0 0.000000 0.000000 38: 0 0.000000 0.000000 39: 0 0.000000 0.000000 40: 0 0.000000 0.000000 41: 0 0.000000 0.000000 42: 0 0.000000 0.000000 43: 0 0.000000 0.000000 44: 0 0.000000 0.000000 45: 0 0.000000 0.000000 46: 0 0.000000 0.000000 47: 0 0.000000 0.000000 48: 0 0.000000 0.000000 49: 0 0.000000 0.000000 50: 0 0.000000 0.000000 51: 0 0.000000 0.000000 52: 0 0.000000 0.000000 53: 0 0.000000 0.000000 54: 0 0.000000 0.000000 55: 0 0.000000 0.000000 56: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI/Escape.pm Page 132 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: 0 0.000000 0.000000 58: 0 0.000000 0.000000 59: 0 0.000000 0.000000 60: 0 0.000000 0.000000 61: 0 0.000000 0.000000 62: 0 0.000000 0.000000 63: 0 0.000000 0.000000 64: 0 0.000000 0.000000 65: 0 0.000000 0.000000 66: 0 0.000000 0.000000 67: 0 0.000000 0.000000 68: 0 0.000000 0.000000 69: 0 0.000000 0.000000 70: 0 0.000000 0.000000 71: 0 0.000000 0.000000 72: 0 0.000000 0.000000 73: 0 0.000000 0.000000 74: 0 0.000000 0.000000 75: 0 0.000000 0.000000 76: 0 0.000000 0.000000 77: 0 0.000000 0.000000 78: 0 0.000000 0.000000 79: 0 0.000000 0.000000 80: 0 0.000000 0.000000 81: 0 0.000000 0.000000 82: 0 0.000000 0.000000 83: 0 0.000000 0.000000 84: 0 0.000000 0.000000 85: 0 0.000000 0.000000 86: 0 0.000000 0.000000 87: 0 0.000000 0.000000 88: 0 0.000000 0.000000 89: 0 0.000000 0.000000 90: 0 0.000000 0.000000 91: 0 0.000000 0.000000 92: 0 0.000000 0.000000 93: 0 0.000000 0.000000 94: 0 0.000000 0.000000 95: 0 0.000000 0.000000 96: 0 0.000000 0.000000 97: 0 0.000000 0.000000 98: 0 0.000000 0.000000 99: 0 0.000000 0.000000 100: 0 0.000000 0.000000 101: 0 0.000000 0.000000 102: 0 0.000000 0.000000 103: 0 0.000000 0.000000 104: 0 0.000000 0.000000 105: 0 0.000000 0.000000 106: 0 0.000000 0.000000 107: 0 0.000000 0.000000 108: 0 0.000000 0.000000 109: 0 0.000000 0.000000 110:use vars qw(@ISA @EXPORT @EXPORT_OK 0 0.000000 0.000000 111:use vars qw(%escapes); 0 0.000000 0.000000 112: ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI/Escape.pm Page 133 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113:require Exporter; 0 0.000000 0.000000 114:@ISA = qw(Exporter); 0 0.000000 0.000000 115:@EXPORT = qw(uri_escape uri_unescape); 0 0.000000 0.000000 116:@EXPORT_OK = qw(%escapes); 0 0.000000 0.000000 117:$VERSION = sprintf("%d.%02d", q$Revision: 0 0.000000 0.000000 118: 0 0.000000 0.000000 119:use Carp (); 0 0.000000 0.000000 120: 0 0.000000 0.000000 121:# Build a char->hex map 0 0.000000 0.000000 122:for (0..255) { 0 0.000000 0.000000 123: $escapes{chr($_)} = sprintf("%%%02X", 0 0.000000 0.000000 124:} 0 0.000000 0.000000 125: 0 0.000000 0.000000 126:my %subst; # compiled patternes 0 0.000000 0.000000 127: 0 0.000000 0.000000 128:sub uri_escape 0 0.000000 0.000000 129:{ 0 0.000000 0.000000 130: my($text, $patn) = @_; 0 0.000000 0.000000 131: return undef unless defined $text; 0 0.000000 0.000000 132: if (defined $patn){ 0 0.000000 0.000000 133: unless (exists $subst{$patn}) { 0 0.000000 0.000000 134: # Because we can't compile the regex we 0 0.000000 0.000000 135: (my $tmp = $patn) =~ s,/,\\/,g; 0 0.000000 0.000000 136: eval "\$subst{\$patn} = sub {\$_[0] =~ 0 0.000000 0.000000 137: Carp::croak("uri_escape: $@") if $@; 0 0.000000 0.000000 138: } 0 0.000000 0.000000 139: &{$subst{$patn}}($text); 0 0.000000 0.000000 140: } else { 0 0.000000 0.000000 141: # Default unsafe characters. RFC 2732 0 0.000000 0.000000 142: $text =~ s/([^A-Za-z0-9\- 0 0.000000 0.000000 143: } 0 0.000000 0.000000 144: $text; 0 0.000000 0.000000 145:} 0 0.000000 0.000000 146: 0 0.000000 0.000000 147:sub uri_unescape 387 0.000000 0.000000 148:{ 0 0.000000 0.000000 149: # Note from RFC1630: "Sequences which 0 0.000000 0.000000 150: # but are not followed by two hexadecimal 0 0.000000 0.000000 151: # for future extension" 387 0.001709 0.000000 152: my $str = shift; 387 0.001267 0.000000 153: if (@_ && wantarray) { 0 0.000000 0.000000 154: # not executed for the common case of a 0 0.000000 0.000000 155: my @str = ($str, @_); # need to copy 0 0.000000 0.000000 156: foreach (@str) { 0 0.000000 0.000000 157: s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; 0 0.000000 0.000000 158: } 0 0.000000 0.000000 159: return @str; 0 0.000000 0.000000 160: } 387 0.001607 0.000000 161: $str =~ s/%([0-9A-Fa- 387 0.002944 0.000000 162: $str; 0 0.000000 0.000000 163:} 0 0.000000 0.000000 164: 0 0.000000 0.000000 165:1; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI/_generic.pm Page 134 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package URI::_generic; 1 0.000005 0.000000 2:require URI; 1 0.000006 0.000000 3:require URI::_query; 1 0.000008 0.000000 4:@ISA=qw(URI URI::_query); 0 0.000000 0.000000 5: 3 0.000011 0.000000 6:use strict; 3 0.000010 0.000000 7:use URI::Escape qw(uri_unescape); 3 0.003429 0.000000 8:use Carp (); 0 0.000000 0.000000 9: 2 0.000016 0.000000 10:my $ACHAR = $URI::uric; $ACHAR =~ 2 0.000012 0.000000 11:my $PCHAR = $URI::uric; $PCHAR =~ 0 0.000000 0.000000 12: 62 0.000167 0.000000 13:sub _no_scheme_ok { 1 } 0 0.000000 0.000000 14: 0 0.000000 0.000000 15:sub authority 1191 0.000000 0.000000 16:{ 1191 0.004116 0.010000 17: my $self = shift; 1191 0.015470 0.000000 18: $$self =~ 0 0.000000 0.000000 19: 1191 0.003724 0.010000 20: if (@_) { 31 0.000114 0.000000 21: my $auth = shift; 31 0.000135 0.000000 22: $$self = $1; 31 0.000144 0.000000 23: my $rest = $3; 31 0.000113 0.000000 24: if (defined $auth) { 31 0.000213 0.000000 25: $auth =~ 31 0.000153 0.000000 26: $$self .= "//$auth"; 0 0.000000 0.000000 27: } 31 0.000221 0.000000 28: _check_path($rest, $$self); 31 0.000110 0.000000 29: $$self .= $rest; 0 0.000000 0.000000 30: } 1191 0.009894 0.010000 31: $2; 0 0.000000 0.000000 32:} 0 0.000000 0.000000 33: 0 0.000000 0.000000 34:sub path 31 0.000000 0.000000 35:{ 31 0.000108 0.000000 36: my $self = shift; 31 0.000282 0.000000 37: $$self =~ 0 0.000000 0.000000 38: 31 0.000086 0.000000 39: if (@_) { 0 0.000000 0.000000 40: $$self = $1; 0 0.000000 0.000000 41: my $rest = $3; 0 0.000000 0.000000 42: my $new_path = shift; 0 0.000000 0.000000 43: $new_path = "" unless defined $new_path; 0 0.000000 0.000000 44: $new_path =~ 0 0.000000 0.000000 45: _check_path($new_path, $$self); 0 0.000000 0.000000 46: $$self .= $new_path . $rest; 0 0.000000 0.000000 47: } 31 0.000219 0.000000 48: $2; 0 0.000000 0.000000 49:} 0 0.000000 0.000000 50: 0 0.000000 0.000000 51:sub path_query 387 0.000000 0.000000 52:{ 387 0.001493 0.000000 53: my $self = shift; 387 0.004321 0.000000 54: $$self =~ 0 0.000000 0.000000 55: 387 0.001202 0.000000 56: if (@_) { ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI/_generic.pm Page 135 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: $$self = $1; 0 0.000000 0.000000 58: my $rest = $3; 0 0.000000 0.000000 59: my $new_path = shift; 0 0.000000 0.000000 60: $new_path = "" unless defined $new_path; 0 0.000000 0.000000 61: $new_path =~ 0 0.000000 0.000000 62: _check_path($new_path, $$self); 0 0.000000 0.000000 63: $$self .= $new_path . $rest; 0 0.000000 0.000000 64: } 387 0.002781 0.000000 65: $2; 0 0.000000 0.000000 66:} 0 0.000000 0.000000 67: 0 0.000000 0.000000 68:sub _check_path 31 0.000000 0.000000 69:{ 31 0.000122 0.000000 70: my($path, $pre) = @_; 31 0.000078 0.000000 71: my $prefix; 31 0.000155 0.000000 72: if ($pre =~ m,/,) { # authority present 31 0.000112 0.000000 73: $prefix = "/" if length($path) && $path !~ 0 0.000000 0.000000 74: } 0 0.000000 0.000000 75: else { 0 0.000000 0.000000 76: if ($path =~ m,^//,) { 0 0.000000 0.000000 77: Carp::carp("Path starting with double 0 0.000000 0.000000 78: if $^W; 0 0.000000 0.000000 79: } 0 0.000000 0.000000 80: elsif (!length($pre) && $path =~ 0 0.000000 0.000000 81: Carp::carp("Path might look like scheme, 0 0.000000 0.000000 82: if $^W; 0 0.000000 0.000000 83: $prefix = "./"; 0 0.000000 0.000000 84: } 0 0.000000 0.000000 85: } 31 0.000133 0.000000 86: substr($_[0], 0, 0) = $prefix if defined 0 0.000000 0.000000 87:} 0 0.000000 0.000000 88: 0 0.000000 0.000000 89:sub path_segments 0 0.000000 0.000000 90:{ 0 0.000000 0.000000 91: my $self = shift; 0 0.000000 0.000000 92: my $path = $self->path; 0 0.000000 0.000000 93: if (@_) { 0 0.000000 0.000000 94: my @arg = @_; # make a copy 0 0.000000 0.000000 95: for (@arg) { 0 0.000000 0.000000 96: if (ref($_)) { 0 0.000000 0.000000 97: my @seg = @$_; 0 0.000000 0.000000 98: $seg[0] =~ s/%/%25/g; 0 0.000000 0.000000 99: for (@seg) { s/;/%3B/g; } 0 0.000000 0.000000 100: $_ = join(";", @seg); 0 0.000000 0.000000 101: } 0 0.000000 0.000000 102: else { 0 0.000000 0.000000 103: s/%/%25/g; s/;/%3B/g; 0 0.000000 0.000000 104: } 0 0.000000 0.000000 105: s,/,%2F,g; 0 0.000000 0.000000 106: } 0 0.000000 0.000000 107: $self->path(join("/", @arg)); 0 0.000000 0.000000 108: } 0 0.000000 0.000000 109: return $path unless wantarray; 0 0.000000 0.000000 110: map {/;/ ? $self->_split_segment($_) 0 0.000000 0.000000 111: : uri_unescape($_) } 0 0.000000 0.000000 112: split('/', $path, -1); ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI/_generic.pm Page 136 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113:} 0 0.000000 0.000000 114: 0 0.000000 0.000000 115: 0 0.000000 0.000000 116:sub _split_segment 0 0.000000 0.000000 117:{ 0 0.000000 0.000000 118: my $self = shift; 0 0.000000 0.000000 119: require URI::_segment; 0 0.000000 0.000000 120: URI::_segment->new(@_); 0 0.000000 0.000000 121:} 0 0.000000 0.000000 122: 0 0.000000 0.000000 123: 0 0.000000 0.000000 124:sub abs 58 0.000000 0.000000 125:{ 58 0.000246 0.000000 126: my $self = shift; 58 0.000415 0.000000 127: my $base = shift || Carp::croak("Missing 0 0.000000 0.000000 128: 58 0.000285 0.000000 129: if (my $scheme = $self->scheme) { 27 0.000075 0.000000 130: return $self unless 27 0.000088 0.000000 131: $base = URI->new($base) unless ref $base; 27 0.000131 0.000000 132: return $self unless $scheme eq $base- 0 0.000000 0.000000 133: } 0 0.000000 0.000000 134: 58 0.000206 0.000000 135: $base = URI->new($base) unless ref $base; 58 0.000308 0.000000 136: my $abs = $self->clone; 58 0.000304 0.000000 137: $abs->scheme($base->scheme); 58 0.000583 0.000000 138: return $abs if $$self =~ 31 0.000194 0.000000 139: $abs->authority($base->authority); 0 0.000000 0.000000 140: 31 0.000199 0.000000 141: my $path = $self->path; 31 0.000116 0.000000 142: return $abs if $path =~ m,^/,; 0 0.000000 0.000000 143: 29 0.000101 0.000000 144: if (!length($path)) { 29 0.000141 0.000000 145: my $abs = $base->clone; 29 0.000215 0.000000 146: my $query = $self->query; 29 0.000083 0.000000 147: $abs->query($query) if defined $query; 29 0.000176 0.000000 148: $abs->fragment($self->fragment); 29 0.000363 0.000000 149: return $abs; 0 0.000000 0.000000 150: } 0 0.000000 0.000000 151: 0 0.000000 0.000000 152: my $p = $base->path; 0 0.000000 0.000000 153: $p =~ s,[^/]+$,,; 0 0.000000 0.000000 154: $p .= $path; 0 0.000000 0.000000 155: my @p = split('/', $p, -1); 0 0.000000 0.000000 156: shift(@p) if @p && !length($p[0]); 0 0.000000 0.000000 157: my $i = 1; 0 0.000000 0.000000 158: while ($i < @p) { 0 0.000000 0.000000 159: #print "$i ", join("/", @p), " ($p[$i])\n"; 0 0.000000 0.000000 160: if ($p[$i-1] eq ".") { 0 0.000000 0.000000 161: splice(@p, $i-1, 1); 0 0.000000 0.000000 162: $i-- if $i > 1; 0 0.000000 0.000000 163: } 0 0.000000 0.000000 164: elsif ($p[$i] eq ".." && $p[$i-1] ne "..") { 0 0.000000 0.000000 165: splice(@p, $i-1, 2); 0 0.000000 0.000000 166: if ($i > 1) { 0 0.000000 0.000000 167: $i--; 0 0.000000 0.000000 168: push(@p, "") if $i == @p; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI/_generic.pm Page 137 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169: } 0 0.000000 0.000000 170: } 0 0.000000 0.000000 171: else { 0 0.000000 0.000000 172: $i++; 0 0.000000 0.000000 173: } 0 0.000000 0.000000 174: } 0 0.000000 0.000000 175: $p[-1] = "" if @p && $p[-1] eq "."; # 0 0.000000 0.000000 176: if ($URI::ABS_REMOTE_LEADING_DOTS) { 0 0.000000 0.000000 177: shift @p while @p && $p[0] =~ 0 0.000000 0.000000 178: } 0 0.000000 0.000000 179: $abs->path("/" . join("/", @p)); 0 0.000000 0.000000 180: $abs; 0 0.000000 0.000000 181:} 0 0.000000 0.000000 182: 0 0.000000 0.000000 183:# The oposite of $url->abs. Return a URI 0 0.000000 0.000000 184:sub rel { 0 0.000000 0.000000 185: my $self = shift; 0 0.000000 0.000000 186: my $base = shift || Carp::croak("Missing 0 0.000000 0.000000 187: my $rel = $self->clone; 0 0.000000 0.000000 188: $base = URI->new($base) unless ref $base; 0 0.000000 0.000000 189: 0 0.000000 0.000000 190: #my($scheme, $auth, $path) = 0 0.000000 0.000000 191: my $scheme = $rel->scheme; 0 0.000000 0.000000 192: my $auth = $rel->canonical->authority; 0 0.000000 0.000000 193: my $path = $rel->path; 0 0.000000 0.000000 194: 0 0.000000 0.000000 195: if (!defined($scheme) && !defined($auth)) 0 0.000000 0.000000 196: # it is already relative 0 0.000000 0.000000 197: return $rel; 0 0.000000 0.000000 198: } 0 0.000000 0.000000 199: 0 0.000000 0.000000 200: #my($bscheme, $bauth, $bpath) = 0 0.000000 0.000000 201: my $bscheme = $base->scheme; 0 0.000000 0.000000 202: my $bauth = $base->canonical- 0 0.000000 0.000000 203: my $bpath = $base->path; 0 0.000000 0.000000 204: 0 0.000000 0.000000 205: for ($bscheme, $bauth, $auth) { 0 0.000000 0.000000 206: $_ = '' unless defined 0 0.000000 0.000000 207: } 0 0.000000 0.000000 208: 0 0.000000 0.000000 209: unless ($scheme eq $bscheme && $auth eq 0 0.000000 0.000000 210: # different location, can't make it relative 0 0.000000 0.000000 211: return $rel; 0 0.000000 0.000000 212: } 0 0.000000 0.000000 213: 0 0.000000 0.000000 214: for ($path, $bpath) { $_ = "/$_" unless 0 0.000000 0.000000 215: 0 0.000000 0.000000 216: # Make it relative by eliminating scheme 0 0.000000 0.000000 217: $rel->scheme(undef); 0 0.000000 0.000000 218: $rel->authority(undef); 0 0.000000 0.000000 219: 0 0.000000 0.000000 220: # This loop is based on code from Nicolai 0 0.000000 0.000000 221: # First we calculate common initial path 0 0.000000 0.000000 222: my $li = 1; 0 0.000000 0.000000 223: while (1) { 0 0.000000 0.000000 224: my $i = index($path, '/', $li); ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI/_generic.pm Page 138 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 225: last if $i < 0 || 0 0.000000 0.000000 226: $i != index($bpath, '/', $li) 0 0.000000 0.000000 227: substr($path,$li,$i-$li) ne 0 0.000000 0.000000 228: $li=$i+1; 0 0.000000 0.000000 229: } 0 0.000000 0.000000 230: # then we nuke it from both paths 0 0.000000 0.000000 231: substr($path, 0,$li) = ''; 0 0.000000 0.000000 232: substr($bpath,0,$li) = ''; 0 0.000000 0.000000 233: 0 0.000000 0.000000 234: if ($path eq $bpath && 0 0.000000 0.000000 235: defined($rel->fragment) && 0 0.000000 0.000000 236: !defined($rel->query)) { 0 0.000000 0.000000 237: $rel->path(""); 0 0.000000 0.000000 238: } 0 0.000000 0.000000 239: else { 0 0.000000 0.000000 240: # Add one "../" for each path 0 0.000000 0.000000 241: $path = ('../' x $bpath =~ tr|/|/|) . 0 0.000000 0.000000 242: $path = "./" if $path eq ""; 0 0.000000 0.000000 243: $rel->path($path); 0 0.000000 0.000000 244: } 0 0.000000 0.000000 245: 0 0.000000 0.000000 246: $rel; 0 0.000000 0.000000 247:} 0 0.000000 0.000000 248: 1 0.000028 0.000000 249:1; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI/_query.pm Page 139 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package URI::_query; 0 0.000000 0.000000 2: 3 0.000010 0.000000 3:use strict; 3 0.000009 0.000000 4:use URI (); 3 0.000011 0.000000 5:use URI::Escape qw(uri_unescape); 0 0.000000 0.000000 6: 0 0.000000 0.000000 7:sub query 29 0.000000 0.000000 8:{ 29 0.000104 0.000000 9: my $self = shift; 29 0.000247 0.000000 10: $$self =~ 0 0.000000 0.000000 11: 29 0.000101 0.000000 12: if (@_) { 0 0.000000 0.000000 13: my $q = shift; 0 0.000000 0.000000 14: $$self = $1; 0 0.000000 0.000000 15: if (defined $q) { 0 0.000000 0.000000 16: $q =~ 0 0.000000 0.000000 17: $$self .= "?$q"; 0 0.000000 0.000000 18: } 0 0.000000 0.000000 19: $$self .= $3; 0 0.000000 0.000000 20: } 29 0.000207 0.000000 21: $2; 0 0.000000 0.000000 22:} 0 0.000000 0.000000 23: 0 0.000000 0.000000 24:# Handle ...?foo=bar&bar=foo type of query 0 0.000000 0.000000 25:sub query_form { 0 0.000000 0.000000 26: my $self = shift; 0 0.000000 0.000000 27: my $old = $self->query; 0 0.000000 0.000000 28: if (@_) { 0 0.000000 0.000000 29: # Try to set query string 0 0.000000 0.000000 30: my @new = @_; 0 0.000000 0.000000 31: if (@new == 1) { 0 0.000000 0.000000 32: my $n = $new[0]; 0 0.000000 0.000000 33: if (ref($n) eq "ARRAY") { 0 0.000000 0.000000 34: @new = @$n; 0 0.000000 0.000000 35: } 0 0.000000 0.000000 36: elsif (ref($n) eq "HASH") { 0 0.000000 0.000000 37: @new = %$n; 0 0.000000 0.000000 38: } 0 0.000000 0.000000 39: } 0 0.000000 0.000000 40: my @query; 0 0.000000 0.000000 41: while (my($key,$vals) = splice(@new, 0 0.000000 0.000000 42: $key = '' unless defined $key; 0 0.000000 0.000000 43: $key =~ 0 0.000000 0.000000 44: $key =~ s/ /+/g; 0 0.000000 0.000000 45: $vals = [ref($vals) ? @$vals : $vals]; 0 0.000000 0.000000 46: for my $val (@$vals) { 0 0.000000 0.000000 47: $val = '' unless defined 0 0.000000 0.000000 48: $val =~ 0 0.000000 0.000000 49: $val =~ s/ /+/g; 0 0.000000 0.000000 50: push(@query, "$key=$val"); 0 0.000000 0.000000 51: } 0 0.000000 0.000000 52: } 0 0.000000 0.000000 53: $self->query(@query ? join('&', 0 0.000000 0.000000 54: } 0 0.000000 0.000000 55: return if !defined($old) || !length($old) 0 0.000000 0.000000 56: return unless $old =~ /=/; # not a form ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI/_query.pm Page 140 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: map { s/\+/ /g; uri_unescape($_) } 0 0.000000 0.000000 58: map { /=/ ? split(/=/, $_, 2) : ($_ 0 0.000000 0.000000 59:} 0 0.000000 0.000000 60: 0 0.000000 0.000000 61:# Handle ...?dog+bones type of query 0 0.000000 0.000000 62:sub query_keywords 0 0.000000 0.000000 63:{ 0 0.000000 0.000000 64: my $self = shift; 0 0.000000 0.000000 65: my $old = $self->query; 0 0.000000 0.000000 66: if (@_) { 0 0.000000 0.000000 67: # Try to set query string 0 0.000000 0.000000 68: my @copy = @_; 0 0.000000 0.000000 69: @copy = @{$copy[0]} if @copy == 1 && 0 0.000000 0.000000 70: for (@copy) { 0 0.000000 0.000000 71: $self->query(@copy ? join('+', @copy) : 0 0.000000 0.000000 72: } 0 0.000000 0.000000 73: return if !defined($old) || 0 0.000000 0.000000 74: return if $old =~ /=/; # not keywords, 0 0.000000 0.000000 75: map { uri_unescape($_) } split(/\+/, 0 0.000000 0.000000 76:} 0 0.000000 0.000000 77: 0 0.000000 0.000000 78:# Some URI::URL compatibility stuff 1 0.000006 0.000000 79:*equery = \&query; 0 0.000000 0.000000 80: 1 0.000014 0.000000 81:1; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI/_server.pm Page 141 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package URI::_server; 1 0.000005 0.000000 2:require URI::_generic; 1 0.000009 0.000000 3:@ISA=qw(URI::_generic); 0 0.000000 0.000000 4: 3 0.000011 0.000000 5:use strict; 3 0.000011 0.000000 6:use URI::Escape qw(uri_unescape); 0 0.000000 0.000000 7: 0 0.000000 0.000000 8:sub userinfo 0 0.000000 0.000000 9:{ 0 0.000000 0.000000 10: my $self = shift; 0 0.000000 0.000000 11: my $old = $self->authority; 0 0.000000 0.000000 12: 0 0.000000 0.000000 13: if (@_) { 0 0.000000 0.000000 14: my $new = $old; 0 0.000000 0.000000 15: $new = "" unless defined $new; 0 0.000000 0.000000 16: $new =~ s/.*@//; # remove old stuff 0 0.000000 0.000000 17: my $ui = shift; 0 0.000000 0.000000 18: if (defined $ui) { 0 0.000000 0.000000 19: $ui =~ s/@/%40/g; # protect @ 0 0.000000 0.000000 20: $new = "$ui\@$new"; 0 0.000000 0.000000 21: } 0 0.000000 0.000000 22: $self->authority($new); 0 0.000000 0.000000 23: } 0 0.000000 0.000000 24: return undef if !defined($old) || $old !~ 0 0.000000 0.000000 25: return $1; 0 0.000000 0.000000 26:} 0 0.000000 0.000000 27: 0 0.000000 0.000000 28:sub host 387 0.000000 0.000000 29:{ 387 0.001553 0.000000 30: my $self = shift; 387 0.002638 0.000000 31: my $old = $self->authority; 387 0.001415 0.010000 32: if (@_) { 0 0.000000 0.000000 33: my $tmp = $old; 0 0.000000 0.000000 34: $tmp = "" unless defined $tmp; 0 0.000000 0.000000 35: my $ui = ($tmp =~ /(.*@)/) ? $1 : ""; 0 0.000000 0.000000 36: my $port = ($tmp =~ /(:\d+)$/) ? $1 : ""; 0 0.000000 0.000000 37: my $new = shift; 0 0.000000 0.000000 38: $new = "" unless defined $new; 0 0.000000 0.000000 39: if (length $new) { 0 0.000000 0.000000 40: $new =~ s/[@]/%40/g; # protect @ 0 0.000000 0.000000 41: $port = $1 if $new =~ s/(:\d+)$//; 0 0.000000 0.000000 42: } 0 0.000000 0.000000 43: $self->authority("$ui$new$port"); 0 0.000000 0.000000 44: } 387 0.001048 0.010000 45: return undef unless defined $old; 387 0.001648 0.000000 46: $old =~ s/.*@//; 387 0.001341 0.010000 47: $old =~ s/:\d+$//; 387 0.002830 0.020000 48: return uri_unescape($old); 0 0.000000 0.000000 49:} 0 0.000000 0.000000 50: 0 0.000000 0.000000 51:sub _port 387 0.000000 0.000000 52:{ 387 0.001393 0.000000 53: my $self = shift; 387 0.002261 0.000000 54: my $old = $self->authority; 387 0.001179 0.000000 55: if (@_) { 0 0.000000 0.000000 56: my $new = $old; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI/_server.pm Page 142 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: $new =~ s/:\d*$//; 0 0.000000 0.000000 58: my $port = shift; 0 0.000000 0.000000 59: $new .= ":$port" if defined $port; 0 0.000000 0.000000 60: $self->authority($new); 0 0.000000 0.000000 61: } 387 0.001784 0.020000 62: return $1 if defined($old) && $old =~ 387 0.001939 0.000000 63: return; 0 0.000000 0.000000 64:} 0 0.000000 0.000000 65: 0 0.000000 0.000000 66:sub port 387 0.000000 0.000000 67:{ 387 0.001488 0.020000 68: my $self = shift; 387 0.002367 0.010000 69: my $port = $self->_port(@_); 387 0.002772 0.000000 70: $port = $self->default_port if 387 0.001989 0.010000 71: $port; 0 0.000000 0.000000 72:} 0 0.000000 0.000000 73: 0 0.000000 0.000000 74:sub host_port 0 0.000000 0.000000 75:{ 0 0.000000 0.000000 76: my $self = shift; 0 0.000000 0.000000 77: my $old = $self->authority; 0 0.000000 0.000000 78: $self->host(shift) if @_; 0 0.000000 0.000000 79: return undef unless defined $old; 0 0.000000 0.000000 80: $old =~ s/.*@//; # zap userinfo 0 0.000000 0.000000 81: $old =~ s/:$//; # empty port does 0 0.000000 0.000000 82: $old .= ":" . $self->port unless $old =~ 0 0.000000 0.000000 83: $old; 0 0.000000 0.000000 84:} 0 0.000000 0.000000 85: 0 0.000000 0.000000 86: 0 0.000000 0.000000 87:sub default_port { undef } 0 0.000000 0.000000 88: 0 0.000000 0.000000 89:sub canonical 0 0.000000 0.000000 90:{ 0 0.000000 0.000000 91: my $self = shift; 0 0.000000 0.000000 92: my $other = $self->SUPER::canonical; 0 0.000000 0.000000 93: my $host = $other->host || ""; 0 0.000000 0.000000 94: my $port = $other->_port; 0 0.000000 0.000000 95: my $uc_host = $host =~ /[A-Z]/; 0 0.000000 0.000000 96: my $def_port = defined($port) && ($port 0 0.000000 0.000000 97: $port 0 0.000000 0.000000 98: if ($uc_host || $def_port) { 0 0.000000 0.000000 99: $other = $other->clone if $other == $self; 0 0.000000 0.000000 100: $other->host(lc $host) if $uc_host; 0 0.000000 0.000000 101: $other->port(undef) if $def_port; 0 0.000000 0.000000 102: } 0 0.000000 0.000000 103: $other; 0 0.000000 0.000000 104:} 0 0.000000 0.000000 105: 1 0.000014 0.000000 106:1; ================ SmallProf version 1.15 ================ Profile of /usr/lib/perl5/vendor_perl/5.8.5/URI/http.pm Page 143 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package URI::http; 0 0.000000 0.000000 2: 1 0.000005 0.000000 3:require URI::_server; 1 0.000007 0.000000 4:@ISA=qw(URI::_server); 0 0.000000 0.000000 5: 3 0.000013 0.000000 6:use strict; 3 0.000010 0.000000 7:use vars qw(%unreserved_escape); 0 0.000000 0.000000 8: 774 0.001950 0.010000 9:sub default_port { 80 } 0 0.000000 0.000000 10: 0 0.000000 0.000000 11:sub canonical 0 0.000000 0.000000 12:{ 0 0.000000 0.000000 13: my $self = shift; 0 0.000000 0.000000 14: my $other = $self->SUPER::canonical; 0 0.000000 0.000000 15: 0 0.000000 0.000000 16: my $slash_path = defined($other- 0 0.000000 0.000000 17: !length($other->path) && 0 0.000000 0.000000 18: 0 0.000000 0.000000 19: if ($slash_path || $$other =~ /%/) { 0 0.000000 0.000000 20: $other = $other->clone if $other == $self; 0 0.000000 0.000000 21: unless (%unreserved_escape) { 0 0.000000 0.000000 22: for ("A" .. "Z", "a" .. "z", "0" .."9", 0 0.000000 0.000000 23: "-", "_", ".", "!", "~", "*", "'", "(", 0 0.000000 0.000000 24: ) { 0 0.000000 0.000000 25: $unreserved_escape{sprintf "%%%02X", 0 0.000000 0.000000 26: } 0 0.000000 0.000000 27: } 0 0.000000 0.000000 28: $$other =~ s/(%[0-9A-F]{2})/exists 0 0.000000 0.000000 29: 0 0.000000 0.000000 30: $other->path("/") if $slash_path; 0 0.000000 0.000000 31: } 0 0.000000 0.000000 32: $other; 0 0.000000 0.000000 33:} 0 0.000000 0.000000 34: 1 0.000024 0.000000 35:1; ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 144 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:# This file was created by configpm when Perl 0 0.000000 0.000000 2:# made to this file will be lost the next 0 0.000000 0.000000 3: 0 0.000000 0.000000 4:package Config; 0 0.000000 0.000000 5:@EXPORT = qw(%Config); 0 0.000000 0.000000 6:@EXPORT_OK = qw(myconfig config_sh 0 0.000000 0.000000 7: 0 0.000000 0.000000 8:my %Export_Cache = map {($_ => 1)} (@EXPORT, 0 0.000000 0.000000 9: 0 0.000000 0.000000 10:# Define our own import method to avoid 2 0.000000 0.000000 11:sub import { 1 0.000004 0.000000 12: my $pkg = shift; 1 0.000006 0.000000 13: @_ = @EXPORT unless @_; 0 0.000000 0.000000 14: 1 0.000007 0.000000 15: my @funcs = grep $_ ne '%Config', @_; 1 0.000004 0.000000 16: my $export_Config = @funcs < @_ ? 1 : 0; 0 0.000000 0.000000 17: 1 0.000003 0.000000 18: my $callpkg = caller(0); 1 0.000010 0.000000 19: foreach my $func (@funcs) { 0 0.000000 0.000000 20: die sprintf qq{"%s" is not exported by the 0 0.000000 0.000000 21: $func, __PACKAGE__ unless 0 0.000000 0.000000 22: *{$callpkg.'::'.$func} = \&{$func}; 0 0.000000 0.000000 23: } 0 0.000000 0.000000 24: 2 0.000014 0.000000 25: *{"$callpkg\::Config"} = \%Config if 1 0.000003 0.000000 26: return; 0 0.000000 0.000000 27:} 0 0.000000 0.000000 28: 0 0.000000 0.000000 29:die "Perl lib version (v5.8.5) doesn't match 0 0.000000 0.000000 30: unless $^V; 0 0.000000 0.000000 31: 0 0.000000 0.000000 32:$^V eq v5.8.5 0 0.000000 0.000000 33: or die "Perl lib version (v5.8.5) doesn't 0 0.000000 0.000000 34: sprintf("v%vd",$^V) . ")"; 0 0.000000 0.000000 35: 0 0.000000 0.000000 36:## 0 0.000000 0.000000 37:## This file was produced by running the 0 0.000000 0.000000 38:## definitions figured out by Configure. 0 0.000000 0.000000 39:## do not forget to propagate your changes by 0 0.000000 0.000000 40:## instead choose to run each of the .SH 0 0.000000 0.000000 41:## 0 0.000000 0.000000 42:# 0 0.000000 0.000000 43:## Package name : perl5 0 0.000000 0.000000 44:## Source directory : . 0 0.000000 0.000000 45:## Configuration time: Tue Aug 15 05:53:52 0 0.000000 0.000000 46:## Configured by : Red Hat, Inc. 0 0.000000 0.000000 47:## Target system : linux mehak.karan.org 0 0.000000 0.000000 48:# 0 0.000000 0.000000 49:## Configure command line arguments. 0 0.000000 0.000000 50:#PERL_PATCHLEVEL= 0 0.000000 0.000000 51: 0 0.000000 0.000000 52:our $summary : unique = <<'!END!'; 0 0.000000 0.000000 53:Summary of my $package (revision $revision 0 0.000000 0.000000 54: Platform: 0 0.000000 0.000000 55: osname=$osname, osvers=$osvers, 0 0.000000 0.000000 56: uname='$myuname' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 145 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: config_args='$config_args' 0 0.000000 0.000000 58: hint=$hint, useposix=$useposix, 0 0.000000 0.000000 59: usethreads=$usethreads 0 0.000000 0.000000 60: useperlio=$useperlio d_sfio=$d_sfio 0 0.000000 0.000000 61: use64bitint=$use64bitint 0 0.000000 0.000000 62: usemymalloc=$usemymalloc, 0 0.000000 0.000000 63: Compiler: 0 0.000000 0.000000 64: cc='$cc', ccflags ='$ccflags', 0 0.000000 0.000000 65: optimize='$optimize', 0 0.000000 0.000000 66: cppflags='$cppflags' 0 0.000000 0.000000 67: ccversion='$ccversion', 0 0.000000 0.000000 68: intsize=$intsize, longsize=$longsize, 0 0.000000 0.000000 69: d_longlong=$d_longlong, 0 0.000000 0.000000 70: ivtype='$ivtype', ivsize=$ivsize, 0 0.000000 0.000000 71: alignbytes=$alignbytes, 0 0.000000 0.000000 72: Linker and Libraries: 0 0.000000 0.000000 73: ld='$ld', ldflags ='$ldflags' 0 0.000000 0.000000 74: libpth=$libpth 0 0.000000 0.000000 75: libs=$libs 0 0.000000 0.000000 76: perllibs=$perllibs 0 0.000000 0.000000 77: libc=$libc, so=$so, 0 0.000000 0.000000 78: gnulibc_version='$gnulibc_version' 0 0.000000 0.000000 79: Dynamic Linking: 0 0.000000 0.000000 80: dlsrc=$dlsrc, dlext=$dlext, 0 0.000000 0.000000 81: cccdlflags='$cccdlflags', 0 0.000000 0.000000 82: 0 0.000000 0.000000 83:!END! 0 0.000000 0.000000 84:my $summary_expanded; 0 0.000000 0.000000 85: 0 0.000000 0.000000 86:sub myconfig { 0 0.000000 0.000000 87: return $summary_expanded if 0 0.000000 0.000000 88: ($summary_expanded = $summary) =~ 0 0.000000 0.000000 89: { my $c = $Config{$1}; defined($c) ? $c : 0 0.000000 0.000000 90: $summary_expanded; 0 0.000000 0.000000 91:} 0 0.000000 0.000000 92: 0 0.000000 0.000000 93:our $Config_SH : unique = <<'!END!'; 0 0.000000 0.000000 94:archlibexp='/usr/lib64/perl5/5.8.5/x86_64- 0 0.000000 0.000000 95:archname='x86_64-linux-thread-multi' 0 0.000000 0.000000 96:cc='gcc' 0 0.000000 0.000000 97:ccflags='-D_REENTRANT -D_GNU_SOURCE - 0 0.000000 0.000000 98:cppflags='-D_REENTRANT -D_GNU_SOURCE - 0 0.000000 0.000000 99:dlsrc='dl_dlopen.xs' 0 0.000000 0.000000 100:dynamic_ext='B ByteLoader Cwd DB_File 0 0.000000 0.000000 101:installarchlib='/usr/lib64/perl5/5.8.5/x86_64 0 0.000000 0.000000 102:installprivlib='/usr/lib/perl5/5.8.5' 0 0.000000 0.000000 103:libpth='/usr/local/lib64 /lib64 /usr/lib64' 0 0.000000 0.000000 104:libs='-lresolv -lnsl -lgdbm -ldb -ldl -lm - 0 0.000000 0.000000 105:osname='linux' 0 0.000000 0.000000 106:osvers='2.6.9-34.0.2.el' 0 0.000000 0.000000 107:prefix='/usr' 0 0.000000 0.000000 108:privlibexp='/usr/lib/perl5/5.8.5' 0 0.000000 0.000000 109:sharpbang='#!' 0 0.000000 0.000000 110:shsharp='true' 0 0.000000 0.000000 111:so='so' 0 0.000000 0.000000 112:startsh='#!/bin/sh' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 146 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113:static_ext=' ' 0 0.000000 0.000000 114:Author='' 0 0.000000 0.000000 115:CONFIG='true' 0 0.000000 0.000000 116:Date='$Date' 0 0.000000 0.000000 117:Header='' 0 0.000000 0.000000 118:Id='$Id' 0 0.000000 0.000000 119:Locker='' 0 0.000000 0.000000 120:Log='$Log' 0 0.000000 0.000000 121:Mcc='Mcc' 0 0.000000 0.000000 122:PATCHLEVEL='8' 0 0.000000 0.000000 123:PERL_API_REVISION='5' 0 0.000000 0.000000 124:PERL_API_SUBVERSION='0' 0 0.000000 0.000000 125:PERL_API_VERSION='8' 0 0.000000 0.000000 126:PERL_CONFIG_SH='true' 0 0.000000 0.000000 127:PERL_REVISION='5' 0 0.000000 0.000000 128:PERL_SUBVERSION='5' 0 0.000000 0.000000 129:PERL_VERSION='8' 0 0.000000 0.000000 130:RCSfile='$RCSfile' 0 0.000000 0.000000 131:Revision='$Revision' 0 0.000000 0.000000 132:SUBVERSION='5' 0 0.000000 0.000000 133:Source='' 0 0.000000 0.000000 134:State='' 0 0.000000 0.000000 135:_a='.a' 0 0.000000 0.000000 136:_exe='' 0 0.000000 0.000000 137:_o='.o' 0 0.000000 0.000000 138:afs='false' 0 0.000000 0.000000 139:afsroot='/afs' 0 0.000000 0.000000 140:alignbytes='8' 0 0.000000 0.000000 141:ansi2knr='' 0 0.000000 0.000000 142:aphostname='' 0 0.000000 0.000000 143:api_revision='5' 0 0.000000 0.000000 144:api_subversion='0' 0 0.000000 0.000000 145:api_version='8' 0 0.000000 0.000000 146:api_versionstring='5.8.0' 0 0.000000 0.000000 147:ar='ar' 0 0.000000 0.000000 148:archlib='/usr/lib64/perl5/5.8.5/x86_64-linux- 0 0.000000 0.000000 149:archname64='' 0 0.000000 0.000000 150:archobjs='' 0 0.000000 0.000000 151:asctime_r_proto='REENTRANT_PROTO_B_SB' 0 0.000000 0.000000 152:awk='awk' 0 0.000000 0.000000 153:baserev='5.0' 0 0.000000 0.000000 154:bash='' 0 0.000000 0.000000 155:bin='/usr/bin' 0 0.000000 0.000000 156:binexp='/usr/bin' 0 0.000000 0.000000 157:bison='bison' 0 0.000000 0.000000 158:byacc='byacc' 0 0.000000 0.000000 159:byteorder='12345678' 0 0.000000 0.000000 160:c='' 0 0.000000 0.000000 161:castflags='0' 0 0.000000 0.000000 162:cat='cat' 0 0.000000 0.000000 163:cccdlflags='-fPIC' 0 0.000000 0.000000 164:ccdlflags='-Wl,-E -Wl,- 0 0.000000 0.000000 165:ccflags_uselargefiles='-D_LARGEFILE_SOURCE - 0 0.000000 0.000000 166:ccname='gcc' 0 0.000000 0.000000 167:ccsymbols='' 0 0.000000 0.000000 168:ccversion='' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 147 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169:cf_by='Red Hat, Inc.' 0 0.000000 0.000000 170:cf_email='Red Hat, 0 0.000000 0.000000 171:cf_time='Tue Aug 15 05:53:52 BST 2006' 0 0.000000 0.000000 172:charsize='1' 0 0.000000 0.000000 173:chgrp='' 0 0.000000 0.000000 174:chmod='chmod' 0 0.000000 0.000000 175:chown='' 0 0.000000 0.000000 176:clocktype='clock_t' 0 0.000000 0.000000 177:comm='comm' 0 0.000000 0.000000 178:compress='' 0 0.000000 0.000000 179:config_arg0='Configure' 0 0.000000 0.000000 180:config_arg10='-Dlibpth=/usr/local/lib64 0 0.000000 0.000000 181:config_arg11='-Dprivlib=/usr/lib/perl5/5.8.5' 0 0.000000 0.000000 182:config_arg12='- 0 0.000000 0.000000 183:config_arg13='- 0 0.000000 0.000000 184:config_arg14='- 0 0.000000 0.000000 185:config_arg15='- 0 0.000000 0.000000 186:config_arg16='- 0 0.000000 0.000000 187:config_arg17='-Darchname=x86_64-linux' 0 0.000000 0.000000 188:config_arg18='-Dvendorprefix=/usr' 0 0.000000 0.000000 189:config_arg19='-Dsiteprefix=/usr' 0 0.000000 0.000000 190:config_arg1='-des' 0 0.000000 0.000000 191:config_arg20='-Duseshrplib' 0 0.000000 0.000000 192:config_arg21='-Dusethreads' 0 0.000000 0.000000 193:config_arg22='-Duseithreads' 0 0.000000 0.000000 194:config_arg23='-Duselargefiles' 0 0.000000 0.000000 195:config_arg24='-Dd_dosuid' 0 0.000000 0.000000 196:config_arg25='-Dd_semctl_semun' 0 0.000000 0.000000 197:config_arg26='-Di_db' 0 0.000000 0.000000 198:config_arg27='-Ui_ndbm' 0 0.000000 0.000000 199:config_arg28='-Di_gdbm' 0 0.000000 0.000000 200:config_arg29='-Di_shadow' 0 0.000000 0.000000 201:config_arg2='-Doptimize=-O2 -g -pipe -m64' 0 0.000000 0.000000 202:config_arg30='-Di_syslog' 0 0.000000 0.000000 203:config_arg31='-Dman3ext=3pm' 0 0.000000 0.000000 204:config_arg32='-Duseperlio' 0 0.000000 0.000000 205:config_arg33='-Dinstallusrbinperl' 0 0.000000 0.000000 206:config_arg34='-Ubincompat5005' 0 0.000000 0.000000 207:config_arg35='-Uversiononly' 0 0.000000 0.000000 208:config_arg36='-Dpager=/usr/bin/less -isr' 0 0.000000 0.000000 209:config_arg37='-Dinc_version_list=5.8.4 5.8.3 0 0.000000 0.000000 210:config_arg3='-Dversion=5.8.5' 0 0.000000 0.000000 211:config_arg4='-Dmyhostname=localhost' 0 0.000000 0.000000 212:config_arg5='-Dperladmin=root@localhost' 0 0.000000 0.000000 213:config_arg6='-Dcc=gcc' 0 0.000000 0.000000 214:config_arg7='-Dcf_by=Red Hat, Inc.' 0 0.000000 0.000000 215:config_arg8='-Dinstallprefix=/usr' 0 0.000000 0.000000 216:config_arg9='-Dprefix=/usr' 0 0.000000 0.000000 217:config_argc='37' 0 0.000000 0.000000 218:config_args='-des -Doptimize=-O2 -g -pipe - 0 0.000000 0.000000 219:contains='grep' 0 0.000000 0.000000 220:cp='cp' 0 0.000000 0.000000 221:cpio='' 0 0.000000 0.000000 222:cpp='cpp' 0 0.000000 0.000000 223:cpp_stuff='42' 0 0.000000 0.000000 224:cppccsymbols='' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 148 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 225:cpplast='-' 0 0.000000 0.000000 226:cppminus='-' 0 0.000000 0.000000 227:cpprun='gcc -E' 0 0.000000 0.000000 228:cppstdin='gcc -E' 0 0.000000 0.000000 229:cppsymbols='_FILE_OFFSET_BITS=64 0 0.000000 0.000000 230:crypt_r_proto='REENTRANT_PROTO_B_CCS' 0 0.000000 0.000000 231:cryptlib='' 0 0.000000 0.000000 232:csh='csh' 0 0.000000 0.000000 233:ctermid_r_proto='0' 0 0.000000 0.000000 234:ctime_r_proto='REENTRANT_PROTO_B_SB' 0 0.000000 0.000000 235:d_Gconvert='gcvt((x),(n),(b))' 0 0.000000 0.000000 236:d_PRIEUldbl='define' 0 0.000000 0.000000 237:d_PRIFUldbl='define' 0 0.000000 0.000000 238:d_PRIGUldbl='define' 0 0.000000 0.000000 239:d_PRIXU64='define' 0 0.000000 0.000000 240:d_PRId64='define' 0 0.000000 0.000000 241:d_PRIeldbl='define' 0 0.000000 0.000000 242:d_PRIfldbl='define' 0 0.000000 0.000000 243:d_PRIgldbl='define' 0 0.000000 0.000000 244:d_PRIi64='define' 0 0.000000 0.000000 245:d_PRIo64='define' 0 0.000000 0.000000 246:d_PRIu64='define' 0 0.000000 0.000000 247:d_PRIx64='define' 0 0.000000 0.000000 248:d_SCNfldbl='define' 0 0.000000 0.000000 249:d__fwalk='undef' 0 0.000000 0.000000 250:d_access='define' 0 0.000000 0.000000 251:d_accessx='undef' 0 0.000000 0.000000 252:d_aintl='undef' 0 0.000000 0.000000 253:d_alarm='define' 0 0.000000 0.000000 254:d_archlib='define' 0 0.000000 0.000000 255:d_asctime_r='define' 0 0.000000 0.000000 256:d_atolf='undef' 0 0.000000 0.000000 257:d_atoll='define' 0 0.000000 0.000000 258:d_attribut='define' 0 0.000000 0.000000 259:d_bcmp='define' 0 0.000000 0.000000 260:d_bcopy='define' 0 0.000000 0.000000 261:d_bsd='undef' 0 0.000000 0.000000 262:d_bsdgetpgrp='undef' 0 0.000000 0.000000 263:d_bsdsetpgrp='undef' 0 0.000000 0.000000 264:d_bzero='define' 0 0.000000 0.000000 265:d_casti32='undef' 0 0.000000 0.000000 266:d_castneg='define' 0 0.000000 0.000000 267:d_charvspr='define' 0 0.000000 0.000000 268:d_chown='define' 0 0.000000 0.000000 269:d_chroot='define' 0 0.000000 0.000000 270:d_chsize='undef' 0 0.000000 0.000000 271:d_class='undef' 0 0.000000 0.000000 272:d_closedir='define' 0 0.000000 0.000000 273:d_cmsghdr_s='define' 0 0.000000 0.000000 274:d_const='define' 0 0.000000 0.000000 275:d_copysignl='define' 0 0.000000 0.000000 276:d_crypt='define' 0 0.000000 0.000000 277:d_crypt_r='define' 0 0.000000 0.000000 278:d_csh='define' 0 0.000000 0.000000 279:d_ctermid_r='undef' 0 0.000000 0.000000 280:d_ctime_r='define' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 149 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 281:d_cuserid='define' 0 0.000000 0.000000 282:d_dbl_dig='define' 0 0.000000 0.000000 283:d_dbminitproto='undef' 0 0.000000 0.000000 284:d_difftime='define' 0 0.000000 0.000000 285:d_dirfd='define' 0 0.000000 0.000000 286:d_dirnamlen='undef' 0 0.000000 0.000000 287:d_dlerror='define' 0 0.000000 0.000000 288:d_dlopen='define' 0 0.000000 0.000000 289:d_dlsymun='undef' 0 0.000000 0.000000 290:d_dosuid='define' 0 0.000000 0.000000 291:d_drand48_r='define' 0 0.000000 0.000000 292:d_drand48proto='define' 0 0.000000 0.000000 293:d_dup2='define' 0 0.000000 0.000000 294:d_eaccess='undef' 0 0.000000 0.000000 295:d_endgrent='define' 0 0.000000 0.000000 296:d_endgrent_r='undef' 0 0.000000 0.000000 297:d_endhent='define' 0 0.000000 0.000000 298:d_endhostent_r='undef' 0 0.000000 0.000000 299:d_endnent='define' 0 0.000000 0.000000 300:d_endnetent_r='undef' 0 0.000000 0.000000 301:d_endpent='define' 0 0.000000 0.000000 302:d_endprotoent_r='undef' 0 0.000000 0.000000 303:d_endpwent='define' 0 0.000000 0.000000 304:d_endpwent_r='undef' 0 0.000000 0.000000 305:d_endsent='define' 0 0.000000 0.000000 306:d_endservent_r='undef' 0 0.000000 0.000000 307:d_eofnblk='define' 0 0.000000 0.000000 308:d_eunice='undef' 0 0.000000 0.000000 309:d_faststdio='undef' 0 0.000000 0.000000 310:d_fchdir='define' 0 0.000000 0.000000 311:d_fchmod='define' 0 0.000000 0.000000 312:d_fchown='define' 0 0.000000 0.000000 313:d_fcntl='define' 0 0.000000 0.000000 314:d_fcntl_can_lock='define' 0 0.000000 0.000000 315:d_fd_macros='define' 0 0.000000 0.000000 316:d_fd_set='define' 0 0.000000 0.000000 317:d_fds_bits='define' 0 0.000000 0.000000 318:d_fgetpos='define' 0 0.000000 0.000000 319:d_finite='define' 0 0.000000 0.000000 320:d_finitel='define' 0 0.000000 0.000000 321:d_flexfnam='define' 0 0.000000 0.000000 322:d_flock='define' 0 0.000000 0.000000 323:d_flockproto='define' 0 0.000000 0.000000 324:d_fork='define' 0 0.000000 0.000000 325:d_fp_class='undef' 0 0.000000 0.000000 326:d_fpathconf='define' 0 0.000000 0.000000 327:d_fpclass='undef' 0 0.000000 0.000000 328:d_fpclassify='undef' 0 0.000000 0.000000 329:d_fpclassl='undef' 0 0.000000 0.000000 330:d_fpos64_t='undef' 0 0.000000 0.000000 331:d_frexpl='define' 0 0.000000 0.000000 332:d_fs_data_s='undef' 0 0.000000 0.000000 333:d_fseeko='define' 0 0.000000 0.000000 334:d_fsetpos='define' 0 0.000000 0.000000 335:d_fstatfs='define' 0 0.000000 0.000000 336:d_fstatvfs='define' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 150 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 337:d_fsync='define' 0 0.000000 0.000000 338:d_ftello='define' 0 0.000000 0.000000 339:d_ftime='undef' 0 0.000000 0.000000 340:d_getcwd='define' 0 0.000000 0.000000 341:d_getespwnam='undef' 0 0.000000 0.000000 342:d_getfsstat='undef' 0 0.000000 0.000000 343:d_getgrent='define' 0 0.000000 0.000000 344:d_getgrent_r='define' 0 0.000000 0.000000 345:d_getgrgid_r='define' 0 0.000000 0.000000 346:d_getgrnam_r='define' 0 0.000000 0.000000 347:d_getgrps='define' 0 0.000000 0.000000 348:d_gethbyaddr='define' 0 0.000000 0.000000 349:d_gethbyname='define' 0 0.000000 0.000000 350:d_gethent='define' 0 0.000000 0.000000 351:d_gethname='define' 0 0.000000 0.000000 352:d_gethostbyaddr_r='define' 0 0.000000 0.000000 353:d_gethostbyname_r='define' 0 0.000000 0.000000 354:d_gethostent_r='define' 0 0.000000 0.000000 355:d_gethostprotos='define' 0 0.000000 0.000000 356:d_getitimer='define' 0 0.000000 0.000000 357:d_getlogin='define' 0 0.000000 0.000000 358:d_getlogin_r='define' 0 0.000000 0.000000 359:d_getmnt='undef' 0 0.000000 0.000000 360:d_getmntent='define' 0 0.000000 0.000000 361:d_getnbyaddr='define' 0 0.000000 0.000000 362:d_getnbyname='define' 0 0.000000 0.000000 363:d_getnent='define' 0 0.000000 0.000000 364:d_getnetbyaddr_r='define' 0 0.000000 0.000000 365:d_getnetbyname_r='define' 0 0.000000 0.000000 366:d_getnetent_r='define' 0 0.000000 0.000000 367:d_getnetprotos='define' 0 0.000000 0.000000 368:d_getpagsz='define' 0 0.000000 0.000000 369:d_getpbyname='define' 0 0.000000 0.000000 370:d_getpbynumber='define' 0 0.000000 0.000000 371:d_getpent='define' 0 0.000000 0.000000 372:d_getpgid='define' 0 0.000000 0.000000 373:d_getpgrp2='undef' 0 0.000000 0.000000 374:d_getpgrp='define' 0 0.000000 0.000000 375:d_getppid='define' 0 0.000000 0.000000 376:d_getprior='define' 0 0.000000 0.000000 377:d_getprotobyname_r='define' 0 0.000000 0.000000 378:d_getprotobynumber_r='define' 0 0.000000 0.000000 379:d_getprotoent_r='define' 0 0.000000 0.000000 380:d_getprotoprotos='define' 0 0.000000 0.000000 381:d_getprpwnam='undef' 0 0.000000 0.000000 382:d_getpwent='define' 0 0.000000 0.000000 383:d_getpwent_r='define' 0 0.000000 0.000000 384:d_getpwnam_r='define' 0 0.000000 0.000000 385:d_getpwuid_r='define' 0 0.000000 0.000000 386:d_getsbyname='define' 0 0.000000 0.000000 387:d_getsbyport='define' 0 0.000000 0.000000 388:d_getsent='define' 0 0.000000 0.000000 389:d_getservbyname_r='define' 0 0.000000 0.000000 390:d_getservbyport_r='define' 0 0.000000 0.000000 391:d_getservent_r='define' 0 0.000000 0.000000 392:d_getservprotos='define' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 151 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 393:d_getspnam='define' 0 0.000000 0.000000 394:d_getspnam_r='define' 0 0.000000 0.000000 395:d_gettimeod='define' 0 0.000000 0.000000 396:d_gmtime_r='define' 0 0.000000 0.000000 397:d_gnulibc='define' 0 0.000000 0.000000 398:d_grpasswd='define' 0 0.000000 0.000000 399:d_hasmntopt='define' 0 0.000000 0.000000 400:d_htonl='define' 0 0.000000 0.000000 401:d_ilogbl='define' 0 0.000000 0.000000 402:d_index='undef' 0 0.000000 0.000000 403:d_inetaton='define' 0 0.000000 0.000000 404:d_int64_t='define' 0 0.000000 0.000000 405:d_isascii='define' 0 0.000000 0.000000 406:d_isfinite='undef' 0 0.000000 0.000000 407:d_isinf='define' 0 0.000000 0.000000 408:d_isnan='define' 0 0.000000 0.000000 409:d_isnanl='define' 0 0.000000 0.000000 410:d_killpg='define' 0 0.000000 0.000000 411:d_lchown='define' 0 0.000000 0.000000 412:d_ldbl_dig='define' 0 0.000000 0.000000 413:d_link='define' 0 0.000000 0.000000 414:d_localtime_r='define' 0 0.000000 0.000000 415:d_localtime_r_needs_tzset='define' 0 0.000000 0.000000 416:d_locconv='define' 0 0.000000 0.000000 417:d_lockf='define' 0 0.000000 0.000000 418:d_longdbl='define' 0 0.000000 0.000000 419:d_longlong='define' 0 0.000000 0.000000 420:d_lseekproto='define' 0 0.000000 0.000000 421:d_lstat='define' 0 0.000000 0.000000 422:d_madvise='define' 0 0.000000 0.000000 423:d_mblen='define' 0 0.000000 0.000000 424:d_mbstowcs='define' 0 0.000000 0.000000 425:d_mbtowc='define' 0 0.000000 0.000000 426:d_memchr='define' 0 0.000000 0.000000 427:d_memcmp='define' 0 0.000000 0.000000 428:d_memcpy='define' 0 0.000000 0.000000 429:d_memmove='define' 0 0.000000 0.000000 430:d_memset='define' 0 0.000000 0.000000 431:d_mkdir='define' 0 0.000000 0.000000 432:d_mkdtemp='define' 0 0.000000 0.000000 433:d_mkfifo='define' 0 0.000000 0.000000 434:d_mkstemp='define' 0 0.000000 0.000000 435:d_mkstemps='undef' 0 0.000000 0.000000 436:d_mktime='define' 0 0.000000 0.000000 437:d_mmap='define' 0 0.000000 0.000000 438:d_modfl='define' 0 0.000000 0.000000 439:d_modfl_pow32_bug='undef' 0 0.000000 0.000000 440:d_modflproto='undef' 0 0.000000 0.000000 441:d_mprotect='define' 0 0.000000 0.000000 442:d_msg='define' 0 0.000000 0.000000 443:d_msg_ctrunc='define' 0 0.000000 0.000000 444:d_msg_dontroute='define' 0 0.000000 0.000000 445:d_msg_oob='define' 0 0.000000 0.000000 446:d_msg_peek='define' 0 0.000000 0.000000 447:d_msg_proxy='define' 0 0.000000 0.000000 448:d_msgctl='define' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 152 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 449:d_msgget='define' 0 0.000000 0.000000 450:d_msghdr_s='define' 0 0.000000 0.000000 451:d_msgrcv='define' 0 0.000000 0.000000 452:d_msgsnd='define' 0 0.000000 0.000000 453:d_msync='define' 0 0.000000 0.000000 454:d_munmap='define' 0 0.000000 0.000000 455:d_mymalloc='undef' 0 0.000000 0.000000 456:d_nice='define' 0 0.000000 0.000000 457:d_nl_langinfo='define' 0 0.000000 0.000000 458:d_nv_preserves_uv='undef' 0 0.000000 0.000000 459:d_off64_t='define' 0 0.000000 0.000000 460:d_old_pthread_create_joinable='undef' 0 0.000000 0.000000 461:d_oldpthreads='undef' 0 0.000000 0.000000 462:d_oldsock='undef' 0 0.000000 0.000000 463:d_open3='define' 0 0.000000 0.000000 464:d_pathconf='define' 0 0.000000 0.000000 465:d_pause='define' 0 0.000000 0.000000 466:d_perl_otherlibdirs='undef' 0 0.000000 0.000000 467:d_phostname='undef' 0 0.000000 0.000000 468:d_pipe='define' 0 0.000000 0.000000 469:d_poll='define' 0 0.000000 0.000000 470:d_portable='define' 0 0.000000 0.000000 471:d_procselfexe='define' 0 0.000000 0.000000 472:d_pthread_atfork='define' 0 0.000000 0.000000 473:d_pthread_attr_setscope='define' 0 0.000000 0.000000 474:d_pthread_yield='define' 0 0.000000 0.000000 475:d_pwage='undef' 0 0.000000 0.000000 476:d_pwchange='undef' 0 0.000000 0.000000 477:d_pwclass='undef' 0 0.000000 0.000000 478:d_pwcomment='undef' 0 0.000000 0.000000 479:d_pwexpire='undef' 0 0.000000 0.000000 480:d_pwgecos='define' 0 0.000000 0.000000 481:d_pwpasswd='define' 0 0.000000 0.000000 482:d_pwquota='undef' 0 0.000000 0.000000 483:d_qgcvt='define' 0 0.000000 0.000000 484:d_quad='define' 0 0.000000 0.000000 485:d_random_r='define' 0 0.000000 0.000000 486:d_readdir64_r='define' 0 0.000000 0.000000 487:d_readdir='define' 0 0.000000 0.000000 488:d_readdir_r='define' 0 0.000000 0.000000 489:d_readlink='define' 0 0.000000 0.000000 490:d_readv='define' 0 0.000000 0.000000 491:d_recvmsg='define' 0 0.000000 0.000000 492:d_rename='define' 0 0.000000 0.000000 493:d_rewinddir='define' 0 0.000000 0.000000 494:d_rmdir='define' 0 0.000000 0.000000 495:d_safebcpy='undef' 0 0.000000 0.000000 496:d_safemcpy='undef' 0 0.000000 0.000000 497:d_sanemcmp='define' 0 0.000000 0.000000 498:d_sbrkproto='define' 0 0.000000 0.000000 499:d_scalbnl='define' 0 0.000000 0.000000 500:d_sched_yield='define' 0 0.000000 0.000000 501:d_scm_rights='define' 0 0.000000 0.000000 502:d_seekdir='define' 0 0.000000 0.000000 503:d_select='define' 0 0.000000 0.000000 504:d_sem='define' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 153 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 505:d_semctl='define' 0 0.000000 0.000000 506:d_semctl_semid_ds='define' 0 0.000000 0.000000 507:d_semctl_semun='define' 0 0.000000 0.000000 508:d_semget='define' 0 0.000000 0.000000 509:d_semop='define' 0 0.000000 0.000000 510:d_sendmsg='define' 0 0.000000 0.000000 511:d_setegid='define' 0 0.000000 0.000000 512:d_seteuid='define' 0 0.000000 0.000000 513:d_setgrent='define' 0 0.000000 0.000000 514:d_setgrent_r='undef' 0 0.000000 0.000000 515:d_setgrps='define' 0 0.000000 0.000000 516:d_sethent='define' 0 0.000000 0.000000 517:d_sethostent_r='undef' 0 0.000000 0.000000 518:d_setitimer='define' 0 0.000000 0.000000 519:d_setlinebuf='define' 0 0.000000 0.000000 520:d_setlocale='define' 0 0.000000 0.000000 521:d_setlocale_r='undef' 0 0.000000 0.000000 522:d_setnent='define' 0 0.000000 0.000000 523:d_setnetent_r='undef' 0 0.000000 0.000000 524:d_setpent='define' 0 0.000000 0.000000 525:d_setpgid='define' 0 0.000000 0.000000 526:d_setpgrp2='undef' 0 0.000000 0.000000 527:d_setpgrp='define' 0 0.000000 0.000000 528:d_setprior='define' 0 0.000000 0.000000 529:d_setproctitle='undef' 0 0.000000 0.000000 530:d_setprotoent_r='undef' 0 0.000000 0.000000 531:d_setpwent='define' 0 0.000000 0.000000 532:d_setpwent_r='undef' 0 0.000000 0.000000 533:d_setregid='define' 0 0.000000 0.000000 534:d_setresgid='define' 0 0.000000 0.000000 535:d_setresuid='define' 0 0.000000 0.000000 536:d_setreuid='define' 0 0.000000 0.000000 537:d_setrgid='undef' 0 0.000000 0.000000 538:d_setruid='undef' 0 0.000000 0.000000 539:d_setsent='define' 0 0.000000 0.000000 540:d_setservent_r='undef' 0 0.000000 0.000000 541:d_setsid='define' 0 0.000000 0.000000 542:d_setvbuf='define' 0 0.000000 0.000000 543:d_sfio='undef' 0 0.000000 0.000000 544:d_shm='define' 0 0.000000 0.000000 545:d_shmat='define' 0 0.000000 0.000000 546:d_shmatprototype='define' 0 0.000000 0.000000 547:d_shmctl='define' 0 0.000000 0.000000 548:d_shmdt='define' 0 0.000000 0.000000 549:d_shmget='define' 0 0.000000 0.000000 550:d_sigaction='define' 0 0.000000 0.000000 551:d_sigprocmask='define' 0 0.000000 0.000000 552:d_sigsetjmp='define' 0 0.000000 0.000000 553:d_sockatmark='define' 0 0.000000 0.000000 554:d_sockatmarkproto='define' 0 0.000000 0.000000 555:d_socket='define' 0 0.000000 0.000000 556:d_socklen_t='define' 0 0.000000 0.000000 557:d_sockpair='define' 0 0.000000 0.000000 558:d_socks5_init='undef' 0 0.000000 0.000000 559:d_sqrtl='define' 0 0.000000 0.000000 560:d_srand48_r='define' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 154 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 561:d_srandom_r='define' 0 0.000000 0.000000 562:d_sresgproto='define' 0 0.000000 0.000000 563:d_sresuproto='define' 0 0.000000 0.000000 564:d_statblks='define' 0 0.000000 0.000000 565:d_statfs_f_flags='undef' 0 0.000000 0.000000 566:d_statfs_s='define' 0 0.000000 0.000000 567:d_statvfs='define' 0 0.000000 0.000000 568:d_stdio_cnt_lval='undef' 0 0.000000 0.000000 569:d_stdio_ptr_lval='undef' 0 0.000000 0.000000 570:d_stdio_ptr_lval_nochange_cnt='undef' 0 0.000000 0.000000 571:d_stdio_ptr_lval_sets_cnt='undef' 0 0.000000 0.000000 572:d_stdio_stream_array='undef' 0 0.000000 0.000000 573:d_stdiobase='undef' 0 0.000000 0.000000 574:d_stdstdio='undef' 0 0.000000 0.000000 575:d_strchr='define' 0 0.000000 0.000000 576:d_strcoll='define' 0 0.000000 0.000000 577:d_strctcpy='define' 0 0.000000 0.000000 578:d_strerrm='strerror(e)' 0 0.000000 0.000000 579:d_strerror='define' 0 0.000000 0.000000 580:d_strerror_r='define' 0 0.000000 0.000000 581:d_strftime='define' 0 0.000000 0.000000 582:d_strtod='define' 0 0.000000 0.000000 583:d_strtol='define' 0 0.000000 0.000000 584:d_strtold='define' 0 0.000000 0.000000 585:d_strtoll='define' 0 0.000000 0.000000 586:d_strtoq='define' 0 0.000000 0.000000 587:d_strtoul='define' 0 0.000000 0.000000 588:d_strtoull='define' 0 0.000000 0.000000 589:d_strtouq='define' 0 0.000000 0.000000 590:d_strxfrm='define' 0 0.000000 0.000000 591:d_suidsafe='undef' 0 0.000000 0.000000 592:d_symlink='define' 0 0.000000 0.000000 593:d_syscall='define' 0 0.000000 0.000000 594:d_syscallproto='define' 0 0.000000 0.000000 595:d_sysconf='define' 0 0.000000 0.000000 596:d_sysernlst='' 0 0.000000 0.000000 597:d_syserrlst='define' 0 0.000000 0.000000 598:d_system='define' 0 0.000000 0.000000 599:d_tcgetpgrp='define' 0 0.000000 0.000000 600:d_tcsetpgrp='define' 0 0.000000 0.000000 601:d_telldir='define' 0 0.000000 0.000000 602:d_telldirproto='define' 0 0.000000 0.000000 603:d_time='define' 0 0.000000 0.000000 604:d_times='define' 0 0.000000 0.000000 605:d_tm_tm_gmtoff='define' 0 0.000000 0.000000 606:d_tm_tm_zone='define' 0 0.000000 0.000000 607:d_tmpnam_r='define' 0 0.000000 0.000000 608:d_truncate='define' 0 0.000000 0.000000 609:d_ttyname_r='define' 0 0.000000 0.000000 610:d_tzname='define' 0 0.000000 0.000000 611:d_u32align='define' 0 0.000000 0.000000 612:d_ualarm='define' 0 0.000000 0.000000 613:d_umask='define' 0 0.000000 0.000000 614:d_uname='define' 0 0.000000 0.000000 615:d_union_semun='undef' 0 0.000000 0.000000 616:d_unordered='undef' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 155 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 617:d_usleep='define' 0 0.000000 0.000000 618:d_usleepproto='define' 0 0.000000 0.000000 619:d_ustat='define' 0 0.000000 0.000000 620:d_vendorarch='define' 0 0.000000 0.000000 621:d_vendorbin='define' 0 0.000000 0.000000 622:d_vendorlib='define' 0 0.000000 0.000000 623:d_vendorscript='define' 0 0.000000 0.000000 624:d_vfork='undef' 0 0.000000 0.000000 625:d_void_closedir='undef' 0 0.000000 0.000000 626:d_voidsig='define' 0 0.000000 0.000000 627:d_voidtty='' 0 0.000000 0.000000 628:d_volatile='define' 0 0.000000 0.000000 629:d_vprintf='define' 0 0.000000 0.000000 630:d_wait4='define' 0 0.000000 0.000000 631:d_waitpid='define' 0 0.000000 0.000000 632:d_wcstombs='define' 0 0.000000 0.000000 633:d_wctomb='define' 0 0.000000 0.000000 634:d_writev='define' 0 0.000000 0.000000 635:d_xenix='undef' 0 0.000000 0.000000 636:date='date' 0 0.000000 0.000000 637:db_hashtype='u_int32_t' 0 0.000000 0.000000 638:db_prefixtype='size_t' 0 0.000000 0.000000 639:db_version_major='4' 0 0.000000 0.000000 640:db_version_minor='2' 0 0.000000 0.000000 641:db_version_patch='52' 0 0.000000 0.000000 642:defvoidused='15' 0 0.000000 0.000000 643:direntrytype='struct dirent' 0 0.000000 0.000000 644:dlext='so' 0 0.000000 0.000000 645:doublesize='8' 0 0.000000 0.000000 646:drand01='drand48()' 0 0.000000 0.000000 647:drand48_r_proto='REENTRANT_PROTO_I_ST' 0 0.000000 0.000000 648:eagain='EAGAIN' 0 0.000000 0.000000 649:ebcdic='undef' 0 0.000000 0.000000 650:echo='echo' 0 0.000000 0.000000 651:egrep='egrep' 0 0.000000 0.000000 652:emacs='' 0 0.000000 0.000000 653:endgrent_r_proto='0' 0 0.000000 0.000000 654:endhostent_r_proto='0' 0 0.000000 0.000000 655:endnetent_r_proto='0' 0 0.000000 0.000000 656:endprotoent_r_proto='0' 0 0.000000 0.000000 657:endpwent_r_proto='0' 0 0.000000 0.000000 658:endservent_r_proto='0' 0 0.000000 0.000000 659:eunicefix=':' 0 0.000000 0.000000 660:exe_ext='' 0 0.000000 0.000000 661:expr='expr' 0 0.000000 0.000000 662:extensions='B ByteLoader Cwd DB_File 0 0.000000 0.000000 663:extras='' 0 0.000000 0.000000 664:fflushNULL='define' 0 0.000000 0.000000 665:fflushall='undef' 0 0.000000 0.000000 666:find='' 0 0.000000 0.000000 667:firstmakefile='makefile' 0 0.000000 0.000000 668:flex='' 0 0.000000 0.000000 669:fpossize='16' 0 0.000000 0.000000 670:fpostype='fpos_t' 0 0.000000 0.000000 671:freetype='void' 0 0.000000 0.000000 672:from=':' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 156 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 673:full_ar='/usr/bin/ar' 0 0.000000 0.000000 674:full_csh='/bin/csh' 0 0.000000 0.000000 675:full_sed='/bin/sed' 0 0.000000 0.000000 676:gccansipedantic='' 0 0.000000 0.000000 677:gccosandvers='' 0 0.000000 0.000000 678:gccversion='3.4.6 20060404 (Red Hat 3.4.6-3)' 0 0.000000 0.000000 679:getgrent_r_proto='REENTRANT_PROTO_I_SBWR' 0 0.000000 0.000000 680:getgrgid_r_proto='REENTRANT_PROTO_I_TSBWR' 0 0.000000 0.000000 681:getgrnam_r_proto='REENTRANT_PROTO_I_CSBWR' 0 0.000000 0.000000 682:gethostbyaddr_r_proto='REENTRANT_PROTO_I_TsIS 0 0.000000 0.000000 683:gethostbyname_r_proto='REENTRANT_PROTO_I_CSBW 0 0.000000 0.000000 684:gethostent_r_proto='REENTRANT_PROTO_I_SBWRE' 0 0.000000 0.000000 685:getlogin_r_proto='REENTRANT_PROTO_I_BW' 0 0.000000 0.000000 686:getnetbyaddr_r_proto='REENTRANT_PROTO_I_uISBW 0 0.000000 0.000000 687:getnetbyname_r_proto='REENTRANT_PROTO_I_CSBWR 0 0.000000 0.000000 688:getnetent_r_proto='REENTRANT_PROTO_I_SBWRE' 0 0.000000 0.000000 689:getprotobyname_r_proto='REENTRANT_PROTO_I_CSB 0 0.000000 0.000000 690:getprotobynumber_r_proto='REENTRANT_PROTO_I_I 0 0.000000 0.000000 691:getprotoent_r_proto='REENTRANT_PROTO_I_SBWR' 0 0.000000 0.000000 692:getpwent_r_proto='REENTRANT_PROTO_I_SBWR' 0 0.000000 0.000000 693:getpwnam_r_proto='REENTRANT_PROTO_I_CSBWR' 0 0.000000 0.000000 694:getpwuid_r_proto='REENTRANT_PROTO_I_TSBWR' 0 0.000000 0.000000 695:getservbyname_r_proto='REENTRANT_PROTO_I_CCSB 0 0.000000 0.000000 696:getservbyport_r_proto='REENTRANT_PROTO_I_ICSB 0 0.000000 0.000000 697:getservent_r_proto='REENTRANT_PROTO_I_SBWR' 0 0.000000 0.000000 698:getspnam_r_proto='REENTRANT_PROTO_I_CSBWR' 0 0.000000 0.000000 699:gidformat='"u"' 0 0.000000 0.000000 700:gidsign='1' 0 0.000000 0.000000 701:gidsize='4' 0 0.000000 0.000000 702:gidtype='gid_t' 0 0.000000 0.000000 703:glibpth='/usr/shlib /lib /usr/lib 0 0.000000 0.000000 704:gmake='gmake' 0 0.000000 0.000000 705:gmtime_r_proto='REENTRANT_PROTO_S_TS' 0 0.000000 0.000000 706:gnulibc_version='2.3.4' 0 0.000000 0.000000 707:grep='grep' 0 0.000000 0.000000 708:groupcat='cat /etc/group' 0 0.000000 0.000000 709:groupstype='gid_t' 0 0.000000 0.000000 710:gzip='gzip' 0 0.000000 0.000000 711:h_fcntl='false' 0 0.000000 0.000000 712:h_sysfile='true' 0 0.000000 0.000000 713:hint='recommended' 0 0.000000 0.000000 714:hostcat='cat /etc/hosts' 0 0.000000 0.000000 715:html1dir=' ' 0 0.000000 0.000000 716:html1direxp='' 0 0.000000 0.000000 717:html3dir=' ' 0 0.000000 0.000000 718:html3direxp='' 0 0.000000 0.000000 719:i16size='2' 0 0.000000 0.000000 720:i16type='short' 0 0.000000 0.000000 721:i32size='4' 0 0.000000 0.000000 722:i32type='int' 0 0.000000 0.000000 723:i64size='8' 0 0.000000 0.000000 724:i64type='long' 0 0.000000 0.000000 725:i8size='1' 0 0.000000 0.000000 726:i8type='char' 0 0.000000 0.000000 727:i_arpainet='define' 0 0.000000 0.000000 728:i_bsdioctl='' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 157 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 729:i_crypt='define' 0 0.000000 0.000000 730:i_db='define' 0 0.000000 0.000000 731:i_dbm='undef' 0 0.000000 0.000000 732:i_dirent='define' 0 0.000000 0.000000 733:i_dld='undef' 0 0.000000 0.000000 734:i_dlfcn='define' 0 0.000000 0.000000 735:i_fcntl='undef' 0 0.000000 0.000000 736:i_float='define' 0 0.000000 0.000000 737:i_fp='undef' 0 0.000000 0.000000 738:i_fp_class='undef' 0 0.000000 0.000000 739:i_gdbm='define' 0 0.000000 0.000000 740:i_grp='define' 0 0.000000 0.000000 741:i_ieeefp='undef' 0 0.000000 0.000000 742:i_inttypes='define' 0 0.000000 0.000000 743:i_langinfo='define' 0 0.000000 0.000000 744:i_libutil='undef' 0 0.000000 0.000000 745:i_limits='define' 0 0.000000 0.000000 746:i_locale='define' 0 0.000000 0.000000 747:i_machcthr='undef' 0 0.000000 0.000000 748:i_malloc='define' 0 0.000000 0.000000 749:i_math='define' 0 0.000000 0.000000 750:i_memory='undef' 0 0.000000 0.000000 751:i_mntent='define' 0 0.000000 0.000000 752:i_ndbm='undef' 0 0.000000 0.000000 753:i_netdb='define' 0 0.000000 0.000000 754:i_neterrno='undef' 0 0.000000 0.000000 755:i_netinettcp='define' 0 0.000000 0.000000 756:i_niin='define' 0 0.000000 0.000000 757:i_poll='define' 0 0.000000 0.000000 758:i_prot='undef' 0 0.000000 0.000000 759:i_pthread='define' 0 0.000000 0.000000 760:i_pwd='define' 0 0.000000 0.000000 761:i_rpcsvcdbm='undef' 0 0.000000 0.000000 762:i_sfio='undef' 0 0.000000 0.000000 763:i_sgtty='undef' 0 0.000000 0.000000 764:i_shadow='define' 0 0.000000 0.000000 765:i_socks='undef' 0 0.000000 0.000000 766:i_stdarg='define' 0 0.000000 0.000000 767:i_stddef='define' 0 0.000000 0.000000 768:i_stdlib='define' 0 0.000000 0.000000 769:i_string='define' 0 0.000000 0.000000 770:i_sunmath='undef' 0 0.000000 0.000000 771:i_sysaccess='undef' 0 0.000000 0.000000 772:i_sysdir='define' 0 0.000000 0.000000 773:i_sysfile='define' 0 0.000000 0.000000 774:i_sysfilio='undef' 0 0.000000 0.000000 775:i_sysin='undef' 0 0.000000 0.000000 776:i_sysioctl='define' 0 0.000000 0.000000 777:i_syslog='define' 0 0.000000 0.000000 778:i_sysmman='define' 0 0.000000 0.000000 779:i_sysmode='undef' 0 0.000000 0.000000 780:i_sysmount='define' 0 0.000000 0.000000 781:i_sysndir='undef' 0 0.000000 0.000000 782:i_sysparam='define' 0 0.000000 0.000000 783:i_sysresrc='define' 0 0.000000 0.000000 784:i_syssecrt='undef' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 158 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 785:i_sysselct='define' 0 0.000000 0.000000 786:i_syssockio='undef' 0 0.000000 0.000000 787:i_sysstat='define' 0 0.000000 0.000000 788:i_sysstatfs='define' 0 0.000000 0.000000 789:i_sysstatvfs='define' 0 0.000000 0.000000 790:i_systime='define' 0 0.000000 0.000000 791:i_systimek='undef' 0 0.000000 0.000000 792:i_systimes='define' 0 0.000000 0.000000 793:i_systypes='define' 0 0.000000 0.000000 794:i_sysuio='define' 0 0.000000 0.000000 795:i_sysun='define' 0 0.000000 0.000000 796:i_sysutsname='define' 0 0.000000 0.000000 797:i_sysvfs='define' 0 0.000000 0.000000 798:i_syswait='define' 0 0.000000 0.000000 799:i_termio='undef' 0 0.000000 0.000000 800:i_termios='define' 0 0.000000 0.000000 801:i_time='define' 0 0.000000 0.000000 802:i_unistd='define' 0 0.000000 0.000000 803:i_ustat='define' 0 0.000000 0.000000 804:i_utime='define' 0 0.000000 0.000000 805:i_values='define' 0 0.000000 0.000000 806:i_varargs='undef' 0 0.000000 0.000000 807:i_varhdr='stdarg.h' 0 0.000000 0.000000 808:i_vfork='undef' 0 0.000000 0.000000 809:ignore_versioned_solibs='y' 0 0.000000 0.000000 810:inc_version_list='5.8.4 5.8.3 5.8.2 5.8.1 0 0.000000 0.000000 811:inc_version_list_init='"5.8.4","5.8.3","5.8.2 0 0.000000 0.000000 812:incpath='' 0 0.000000 0.000000 813:inews='' 0 0.000000 0.000000 814:installbin='/usr/bin' 0 0.000000 0.000000 815:installhtml1dir='' 0 0.000000 0.000000 816:installhtml3dir='' 0 0.000000 0.000000 817:installman1dir='/usr/share/man/man1' 0 0.000000 0.000000 818:installman3dir='/usr/share/man/man3' 0 0.000000 0.000000 819:installprefix='/usr' 0 0.000000 0.000000 820:installprefixexp='/usr' 0 0.000000 0.000000 821:installscript='/usr/bin' 0 0.000000 0.000000 822:installsitearch='/usr/lib64/perl5/site_perl/5 0 0.000000 0.000000 823:installsitebin='/usr/bin' 0 0.000000 0.000000 824:installsitehtml1dir='' 0 0.000000 0.000000 825:installsitehtml3dir='' 0 0.000000 0.000000 826:installsitelib='/usr/lib/perl5/site_perl/5.8. 0 0.000000 0.000000 827:installsiteman1dir='/usr/share/man/man1' 0 0.000000 0.000000 828:installsiteman3dir='/usr/share/man/man3' 0 0.000000 0.000000 829:installsitescript='/usr/bin' 0 0.000000 0.000000 830:installstyle='lib64/perl5' 0 0.000000 0.000000 831:installusrbinperl='define' 0 0.000000 0.000000 832:installvendorarch='/usr/lib64/perl5/vendor_pe 0 0.000000 0.000000 833:installvendorbin='/usr/bin' 0 0.000000 0.000000 834:installvendorhtml1dir='' 0 0.000000 0.000000 835:installvendorhtml3dir='' 0 0.000000 0.000000 836:installvendorlib='/usr/lib/perl5/vendor_perl/ 0 0.000000 0.000000 837:installvendorman1dir='/usr/share/man/man1' 0 0.000000 0.000000 838:installvendorman3dir='/usr/share/man/man3' 0 0.000000 0.000000 839:installvendorscript='/usr/bin' 0 0.000000 0.000000 840:intsize='4' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 159 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 841:issymlink='test -h' 0 0.000000 0.000000 842:ivdformat='"ld"' 0 0.000000 0.000000 843:ivsize='8' 0 0.000000 0.000000 844:ivtype='long' 0 0.000000 0.000000 845:known_extensions='B ByteLoader Cwd DB_File 0 0.000000 0.000000 846:ksh='' 0 0.000000 0.000000 847:ld='gcc' 0 0.000000 0.000000 848:lddlflags='-shared' 0 0.000000 0.000000 849:ldflags='' 0 0.000000 0.000000 850:ldflags_uselargefiles='' 0 0.000000 0.000000 851:ldlibpthname='LD_LIBRARY_PATH' 0 0.000000 0.000000 852:less='less' 0 0.000000 0.000000 853:lib_ext='.a' 0 0.000000 0.000000 854:libc='' 0 0.000000 0.000000 855:libperl='libperl.so' 0 0.000000 0.000000 856:libsdirs=' /usr/lib64' 0 0.000000 0.000000 857:libsfiles=' libresolv.so libnsl.so libgdbm.so 0 0.000000 0.000000 858:libsfound=' /usr/lib64/libresolv.so 0 0.000000 0.000000 859:libspath=' /usr/local/lib64 /lib64 0 0.000000 0.000000 860:libswanted='sfio socket resolv inet nsl nm 0 0.000000 0.000000 861:libswanted_uselargefiles='' 0 0.000000 0.000000 862:line='' 0 0.000000 0.000000 863:lint='' 0 0.000000 0.000000 864:lkflags='' 0 0.000000 0.000000 865:ln='ln' 0 0.000000 0.000000 866:lns='/bin/ln -s' 0 0.000000 0.000000 867:localtime_r_proto='REENTRANT_PROTO_S_TS' 0 0.000000 0.000000 868:locincpth='/usr/local/include 0 0.000000 0.000000 869:loclibpth='/usr/local/lib /opt/local/lib 0 0.000000 0.000000 870:longdblsize='16' 0 0.000000 0.000000 871:longlongsize='8' 0 0.000000 0.000000 872:longsize='8' 0 0.000000 0.000000 873:lp='' 0 0.000000 0.000000 874:lpr='' 0 0.000000 0.000000 875:ls='ls' 0 0.000000 0.000000 876:lseeksize='8' 0 0.000000 0.000000 877:lseektype='off_t' 0 0.000000 0.000000 878:mail='' 0 0.000000 0.000000 879:mailx='' 0 0.000000 0.000000 880:make='make' 0 0.000000 0.000000 881:make_set_make='#' 0 0.000000 0.000000 882:mallocobj='' 0 0.000000 0.000000 883:mallocsrc='' 0 0.000000 0.000000 884:malloctype='void *' 0 0.000000 0.000000 885:man1dir='/usr/share/man/man1' 0 0.000000 0.000000 886:man1direxp='/usr/share/man/man1' 0 0.000000 0.000000 887:man1ext='1' 0 0.000000 0.000000 888:man3dir='/usr/share/man/man3' 0 0.000000 0.000000 889:man3direxp='/usr/share/man/man3' 0 0.000000 0.000000 890:man3ext='3pm' 0 0.000000 0.000000 891:mips_type='' 0 0.000000 0.000000 892:mistrustnm='' 0 0.000000 0.000000 893:mkdir='mkdir' 0 0.000000 0.000000 894:mmaptype='void *' 0 0.000000 0.000000 895:modetype='mode_t' 0 0.000000 0.000000 896:more='more' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 160 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 897:multiarch='undef' 0 0.000000 0.000000 898:mv='' 0 0.000000 0.000000 899:myarchname='x86_64-linux' 0 0.000000 0.000000 900:mydomain='.localdomain' 0 0.000000 0.000000 901:myhostname='localhost' 0 0.000000 0.000000 902:myuname='linux mehak.karan.org 2.6.9- 0 0.000000 0.000000 903:n='-n' 0 0.000000 0.000000 904:need_va_copy='define' 0 0.000000 0.000000 905:netdb_hlen_type='size_t' 0 0.000000 0.000000 906:netdb_host_type='char *' 0 0.000000 0.000000 907:netdb_name_type='const char *' 0 0.000000 0.000000 908:netdb_net_type='in_addr_t' 0 0.000000 0.000000 909:nm='nm' 0 0.000000 0.000000 910:nm_opt='' 0 0.000000 0.000000 911:nm_so_opt='--dynamic' 0 0.000000 0.000000 912:nonxs_ext='Errno' 0 0.000000 0.000000 913:nroff='nroff' 0 0.000000 0.000000 914:nvEUformat='"E"' 0 0.000000 0.000000 915:nvFUformat='"F"' 0 0.000000 0.000000 916:nvGUformat='"G"' 0 0.000000 0.000000 917:nv_preserves_uv_bits='53' 0 0.000000 0.000000 918:nveformat='"e"' 0 0.000000 0.000000 919:nvfformat='"f"' 0 0.000000 0.000000 920:nvgformat='"g"' 0 0.000000 0.000000 921:nvsize='8' 0 0.000000 0.000000 922:nvtype='double' 0 0.000000 0.000000 923:o_nonblock='O_NONBLOCK' 0 0.000000 0.000000 924:obj_ext='.o' 0 0.000000 0.000000 925:old_pthread_create_joinable='' 0 0.000000 0.000000 926:optimize='-O2 -g -pipe -m64' 0 0.000000 0.000000 927:orderlib='false' 0 0.000000 0.000000 928:otherlibdirs=' ' 0 0.000000 0.000000 929:package='perl5' 0 0.000000 0.000000 930:pager='/usr/bin/less -isr' 0 0.000000 0.000000 931:passcat='cat /etc/passwd' 0 0.000000 0.000000 932:patchlevel='8' 0 0.000000 0.000000 933:path_sep=':' 0 0.000000 0.000000 934:perl5='/usr/bin/perl' 0 0.000000 0.000000 935:perl='' 0 0.000000 0.000000 936:perl_patchlevel='' 0 0.000000 0.000000 937:perladmin='root@localhost' 0 0.000000 0.000000 938:perllibs='-lresolv -lnsl -ldl -lm -lcrypt - 0 0.000000 0.000000 939:perlpath='/usr/bin/perl' 0 0.000000 0.000000 940:pg='pg' 0 0.000000 0.000000 941:phostname='' 0 0.000000 0.000000 942:pidtype='pid_t' 0 0.000000 0.000000 943:plibpth='' 0 0.000000 0.000000 944:pmake='' 0 0.000000 0.000000 945:pr='' 0 0.000000 0.000000 946:prefixexp='/usr' 0 0.000000 0.000000 947:privlib='/usr/lib/perl5/5.8.5' 0 0.000000 0.000000 948:procselfexe='"/proc/self/exe"' 0 0.000000 0.000000 949:prototype='define' 0 0.000000 0.000000 950:ptrsize='8' 0 0.000000 0.000000 951:quadkind='2' 0 0.000000 0.000000 952:quadtype='long' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 161 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 953:randbits='48' 0 0.000000 0.000000 954:randfunc='drand48' 0 0.000000 0.000000 955:random_r_proto='REENTRANT_PROTO_I_St' 0 0.000000 0.000000 956:randseedtype='long' 0 0.000000 0.000000 957:ranlib=':' 0 0.000000 0.000000 958:rd_nodata='-1' 0 0.000000 0.000000 959:readdir64_r_proto='REENTRANT_PROTO_I_TSR' 0 0.000000 0.000000 960:readdir_r_proto='REENTRANT_PROTO_I_TSR' 0 0.000000 0.000000 961:revision='5' 0 0.000000 0.000000 962:rm='rm' 0 0.000000 0.000000 963:rmail='' 0 0.000000 0.000000 964:run='' 0 0.000000 0.000000 965:runnm='false' 0 0.000000 0.000000 966:sPRIEUldbl='"LE"' 0 0.000000 0.000000 967:sPRIFUldbl='"LF"' 0 0.000000 0.000000 968:sPRIGUldbl='"LG"' 0 0.000000 0.000000 969:sPRIXU64='"lX"' 0 0.000000 0.000000 970:sPRId64='"ld"' 0 0.000000 0.000000 971:sPRIeldbl='"Le"' 0 0.000000 0.000000 972:sPRIfldbl='"Lf"' 0 0.000000 0.000000 973:sPRIgldbl='"Lg"' 0 0.000000 0.000000 974:sPRIi64='"li"' 0 0.000000 0.000000 975:sPRIo64='"lo"' 0 0.000000 0.000000 976:sPRIu64='"lu"' 0 0.000000 0.000000 977:sPRIx64='"lx"' 0 0.000000 0.000000 978:sSCNfldbl='"Lf"' 0 0.000000 0.000000 979:sched_yield='sched_yield()' 0 0.000000 0.000000 980:scriptdir='/usr/bin' 0 0.000000 0.000000 981:scriptdirexp='/usr/bin' 0 0.000000 0.000000 982:sed='sed' 0 0.000000 0.000000 983:seedfunc='srand48' 0 0.000000 0.000000 984:selectminbits='64' 0 0.000000 0.000000 985:selecttype='fd_set *' 0 0.000000 0.000000 986:sendmail='' 0 0.000000 0.000000 987:setgrent_r_proto='0' 0 0.000000 0.000000 988:sethostent_r_proto='0' 0 0.000000 0.000000 989:setlocale_r_proto='0' 0 0.000000 0.000000 990:setnetent_r_proto='0' 0 0.000000 0.000000 991:setprotoent_r_proto='0' 0 0.000000 0.000000 992:setpwent_r_proto='0' 0 0.000000 0.000000 993:setservent_r_proto='0' 0 0.000000 0.000000 994:sh='/bin/sh' 0 0.000000 0.000000 995:shar='' 0 0.000000 0.000000 996:shmattype='void *' 0 0.000000 0.000000 997:shortsize='2' 0 0.000000 0.000000 998:shrpenv='' 0 0.000000 0.000000 999:sig_count='65' 0 0.000000 0.000000 1000:sig_name='ZERO HUP INT QUIT ILL TRAP ABRT BUS 0 0.000000 0.000000 1001:sig_name_init='"ZERO", "HUP", "INT", "QUIT", 0 0.000000 0.000000 1002:sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 0 0.000000 0.000000 1003:sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0 0.000000 0.000000 1004:sig_size='69' 0 0.000000 0.000000 1005:signal_t='void' 0 0.000000 0.000000 1006:sitearch='/usr/lib64/perl5/site_perl/5.8.5/x8 0 0.000000 0.000000 1007:sitearchexp='/usr/lib64/perl5/site_perl/5.8.5 0 0.000000 0.000000 1008:sitebin='/usr/bin' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 162 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1009:sitebinexp='/usr/bin' 0 0.000000 0.000000 1010:sitehtml1dir='' 0 0.000000 0.000000 1011:sitehtml1direxp='' 0 0.000000 0.000000 1012:sitehtml3dir='' 0 0.000000 0.000000 1013:sitehtml3direxp='' 0 0.000000 0.000000 1014:sitelib='/usr/lib/perl5/site_perl/5.8.5' 0 0.000000 0.000000 1015:sitelib_stem='/usr/lib/perl5/site_perl' 0 0.000000 0.000000 1016:sitelibexp='/usr/lib/perl5/site_perl/5.8.5' 0 0.000000 0.000000 1017:siteman1dir='/usr/share/man/man1' 0 0.000000 0.000000 1018:siteman1direxp='/usr/share/man/man1' 0 0.000000 0.000000 1019:siteman3dir='/usr/share/man/man3' 0 0.000000 0.000000 1020:siteman3direxp='/usr/share/man/man3' 0 0.000000 0.000000 1021:siteprefix='/usr' 0 0.000000 0.000000 1022:siteprefixexp='/usr' 0 0.000000 0.000000 1023:sitescript='/usr/bin' 0 0.000000 0.000000 1024:sitescriptexp='/usr/bin' 0 0.000000 0.000000 1025:sizesize='8' 0 0.000000 0.000000 1026:sizetype='size_t' 0 0.000000 0.000000 1027:sleep='' 0 0.000000 0.000000 1028:smail='' 0 0.000000 0.000000 1029:sockethdr='' 0 0.000000 0.000000 1030:socketlib='' 0 0.000000 0.000000 1031:socksizetype='socklen_t' 0 0.000000 0.000000 1032:sort='sort' 0 0.000000 0.000000 1033:spackage='Perl5' 0 0.000000 0.000000 1034:spitshell='cat' 0 0.000000 0.000000 1035:srand48_r_proto='REENTRANT_PROTO_I_LS' 0 0.000000 0.000000 1036:srandom_r_proto='REENTRANT_PROTO_I_TS' 0 0.000000 0.000000 1037:src='.' 0 0.000000 0.000000 1038:ssizetype='ssize_t' 0 0.000000 0.000000 1039:startperl='#!/usr/bin/perl' 0 0.000000 0.000000 1040:stdchar='char' 0 0.000000 0.000000 1041:stdio_base='((fp)->_IO_read_base)' 0 0.000000 0.000000 1042:stdio_bufsiz='((fp)->_IO_read_end - (fp)- 0 0.000000 0.000000 1043:stdio_cnt='((fp)->_IO_read_end - (fp)- 0 0.000000 0.000000 1044:stdio_filbuf='' 0 0.000000 0.000000 1045:stdio_ptr='((fp)->_IO_read_ptr)' 0 0.000000 0.000000 1046:stdio_stream_array='' 0 0.000000 0.000000 1047:strerror_r_proto='REENTRANT_PROTO_B_IBW' 0 0.000000 0.000000 1048:strings='/usr/include/string.h' 0 0.000000 0.000000 1049:submit='' 0 0.000000 0.000000 1050:subversion='5' 0 0.000000 0.000000 1051:sysman='/usr/share/man/man1' 0 0.000000 0.000000 1052:tail='' 0 0.000000 0.000000 1053:tar='' 0 0.000000 0.000000 1054:targetarch='' 0 0.000000 0.000000 1055:tbl='' 0 0.000000 0.000000 1056:tee='' 0 0.000000 0.000000 1057:test='test' 0 0.000000 0.000000 1058:timeincl='/usr/include/sys/time.h 0 0.000000 0.000000 1059:timetype='time_t' 0 0.000000 0.000000 1060:tmpnam_r_proto='REENTRANT_PROTO_B_B' 0 0.000000 0.000000 1061:to=':' 0 0.000000 0.000000 1062:touch='touch' 0 0.000000 0.000000 1063:tr='tr' 0 0.000000 0.000000 1064:trnl='\n' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 163 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1065:troff='' 0 0.000000 0.000000 1066:ttyname_r_proto='REENTRANT_PROTO_I_IBW' 0 0.000000 0.000000 1067:u16size='2' 0 0.000000 0.000000 1068:u16type='unsigned short' 0 0.000000 0.000000 1069:u32size='4' 0 0.000000 0.000000 1070:u32type='unsigned int' 0 0.000000 0.000000 1071:u64size='8' 0 0.000000 0.000000 1072:u64type='unsigned long' 0 0.000000 0.000000 1073:u8size='1' 0 0.000000 0.000000 1074:u8type='unsigned char' 0 0.000000 0.000000 1075:uidformat='"u"' 0 0.000000 0.000000 1076:uidsign='1' 0 0.000000 0.000000 1077:uidsize='4' 0 0.000000 0.000000 1078:uidtype='uid_t' 0 0.000000 0.000000 1079:uname='uname' 0 0.000000 0.000000 1080:uniq='uniq' 0 0.000000 0.000000 1081:uquadtype='unsigned long' 0 0.000000 0.000000 1082:use5005threads='undef' 0 0.000000 0.000000 1083:use64bitall='define' 0 0.000000 0.000000 1084:use64bitint='define' 0 0.000000 0.000000 1085:usecrosscompile='undef' 0 0.000000 0.000000 1086:usedl='define' 0 0.000000 0.000000 1087:usefaststdio='define' 0 0.000000 0.000000 1088:useithreads='define' 0 0.000000 0.000000 1089:uselargefiles='define' 0 0.000000 0.000000 1090:uselongdouble='undef' 0 0.000000 0.000000 1091:usemallocwrap='define' 0 0.000000 0.000000 1092:usemorebits='undef' 0 0.000000 0.000000 1093:usemultiplicity='define' 0 0.000000 0.000000 1094:usemymalloc='n' 0 0.000000 0.000000 1095:usenm='false' 0 0.000000 0.000000 1096:useopcode='true' 0 0.000000 0.000000 1097:useperlio='define' 0 0.000000 0.000000 1098:useposix='true' 0 0.000000 0.000000 1099:usereentrant='undef' 0 0.000000 0.000000 1100:usesfio='false' 0 0.000000 0.000000 1101:useshrplib='true' 0 0.000000 0.000000 1102:usesocks='undef' 0 0.000000 0.000000 1103:usethreads='define' 0 0.000000 0.000000 1104:usevendorprefix='define' 0 0.000000 0.000000 1105:usevfork='false' 0 0.000000 0.000000 1106:usrinc='/usr/include' 0 0.000000 0.000000 1107:uuname='' 0 0.000000 0.000000 1108:uvXUformat='"lX"' 0 0.000000 0.000000 1109:uvoformat='"lo"' 0 0.000000 0.000000 1110:uvsize='8' 0 0.000000 0.000000 1111:uvtype='unsigned long' 0 0.000000 0.000000 1112:uvuformat='"lu"' 0 0.000000 0.000000 1113:uvxformat='"lx"' 0 0.000000 0.000000 1114:vendorarch='/usr/lib64/perl5/vendor_perl/5.8. 0 0.000000 0.000000 1115:vendorarchexp='/usr/lib64/perl5/vendor_perl/5 0 0.000000 0.000000 1116:vendorbin='/usr/bin' 0 0.000000 0.000000 1117:vendorbinexp='/usr/bin' 0 0.000000 0.000000 1118:vendorhtml1dir=' ' 0 0.000000 0.000000 1119:vendorhtml1direxp='' 0 0.000000 0.000000 1120:vendorhtml3dir=' ' ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 164 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1121:vendorhtml3direxp='' 0 0.000000 0.000000 1122:vendorlib='/usr/lib/perl5/vendor_perl/5.8.5' 0 0.000000 0.000000 1123:vendorlib_stem='/usr/lib/perl5/vendor_perl' 0 0.000000 0.000000 1124:vendorlibexp='/usr/lib/perl5/vendor_perl/5.8. 0 0.000000 0.000000 1125:vendorman1dir='/usr/share/man/man1' 0 0.000000 0.000000 1126:vendorman1direxp='/usr/share/man/man1' 0 0.000000 0.000000 1127:vendorman3dir='/usr/share/man/man3' 0 0.000000 0.000000 1128:vendorman3direxp='/usr/share/man/man3' 0 0.000000 0.000000 1129:vendorprefix='/usr' 0 0.000000 0.000000 1130:vendorprefixexp='/usr' 0 0.000000 0.000000 1131:vendorscript='/usr/bin' 0 0.000000 0.000000 1132:vendorscriptexp='/usr/bin' 0 0.000000 0.000000 1133:version='5.8.5' 0 0.000000 0.000000 1134:version_patchlevel_string='version 8 0 0.000000 0.000000 1135:versiononly='undef' 0 0.000000 0.000000 1136:vi='' 0 0.000000 0.000000 1137:voidflags='15' 0 0.000000 0.000000 1138:xlibpth='/usr/lib/386 /lib/386' 0 0.000000 0.000000 1139:yacc='/usr/bin/byacc' 0 0.000000 0.000000 1140:yaccflags='' 0 0.000000 0.000000 1141:zcat='' 0 0.000000 0.000000 1142:zip='zip' 0 0.000000 0.000000 1143:!END! 0 0.000000 0.000000 1144: 0 0.000000 0.000000 1145:# Search for it in the big string 1 0.000000 0.000000 1146:sub fetch_string { 0 0.000000 0.000000 1147: my($self, $key) = @_; 0 0.000000 0.000000 1148: 0 0.000000 0.000000 1149: my $quote_type = "'"; 0 0.000000 0.000000 1150: my $marker = "$key="; 0 0.000000 0.000000 1151: 0 0.000000 0.000000 1152: # Check for the common case, ' delimited 0 0.000000 0.000000 1153: my $start = index($Config_SH, 0 0.000000 0.000000 1154: # If that failed, check for " delimited 0 0.000000 0.000000 1155: if ($start == -1) { 0 0.000000 0.000000 1156: $quote_type = '"'; 0 0.000000 0.000000 1157: $start = index($Config_SH, 0 0.000000 0.000000 1158: } 0 0.000000 0.000000 1159: return undef if ( ($start == -1) && # in 0 0.000000 0.000000 1160: (substr($Config_SH, 0, 0 0.000000 0.000000 1161: if ($start == -1) { 0 0.000000 0.000000 1162: # It's the very first thing we found. 0 0.000000 0.000000 1163: # and figure out the quote mark after 0 0.000000 0.000000 1164: $start = length($marker) + 1; 0 0.000000 0.000000 1165: $quote_type = substr($Config_SH, 0 0.000000 0.000000 1166: } 0 0.000000 0.000000 1167: else { 0 0.000000 0.000000 1168: $start += length($marker) + 2; 0 0.000000 0.000000 1169: } 0 0.000000 0.000000 1170: 0 0.000000 0.000000 1171: my $value = substr($Config_SH, $start, 0 0.000000 0.000000 1172: index($Config_SH, 0 0.000000 0.000000 1173: 0 0.000000 0.000000 1174: # If we had a double-quote, we'd better 0 0.000000 0.000000 1175: # sequences and such can be interpolated. 0 0.000000 0.000000 1176: # value is supposed to follow shell rules ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 165 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1177: # we escape any perl variable markers 0 0.000000 0.000000 1178: if ($quote_type eq '"') { 0 0.000000 0.000000 1179: $value =~ s/\$/\\\$/g; 0 0.000000 0.000000 1180: $value =~ s/\@/\\\@/g; 0 0.000000 0.000000 1181: eval "\$value = \"$value\""; 0 0.000000 0.000000 1182: } 0 0.000000 0.000000 1183: 0 0.000000 0.000000 1184: # So we can say "if $Config{'foo'}". 0 0.000000 0.000000 1185: $value = undef if $value eq 'undef'; 0 0.000000 0.000000 1186: $self->{$key} = $value; # cache it 0 0.000000 0.000000 1187:} 0 0.000000 0.000000 1188: 0 0.000000 0.000000 1189:sub fetch_virtual { 0 0.000000 0.000000 1190: my($self, $key) = @_; 0 0.000000 0.000000 1191: 0 0.000000 0.000000 1192: my $value; 0 0.000000 0.000000 1193: 0 0.000000 0.000000 1194: if ($key =~ 0 0.000000 0.000000 1195: # These are purely virtual, they do not 0 0.000000 0.000000 1196: # be computed on demand for largefile- 0 0.000000 0.000000 1197: my $new_key = "${1}_uselargefiles"; 0 0.000000 0.000000 1198: $value = $Config{$1}; 0 0.000000 0.000000 1199: my $withlargefiles = $Config{$new_key}; 0 0.000000 0.000000 1200: if ($new_key =~ /^(?:cc|ld)flags_/) { 0 0.000000 0.000000 1201: $value =~ s/\Q$withlargefiles\E\b//; 0 0.000000 0.000000 1202: } elsif ($new_key =~ /^libs/) { 0 0.000000 0.000000 1203: my @lflibswanted = split(' ', 0 0.000000 0.000000 1204: if (@lflibswanted) { 0 0.000000 0.000000 1205: my %lflibswanted; 0 0.000000 0.000000 1206: @lflibswanted{@lflibswanted} = (); 0 0.000000 0.000000 1207: if ($new_key =~ /^libs_/) { 0 0.000000 0.000000 1208: my @libs = grep { /^-l(.+)/ && 0 0.000000 0.000000 1209: not 0 0.000000 0.000000 1210: split(' ', 0 0.000000 0.000000 1211: $Config{libs} = join(' ', @libs); 0 0.000000 0.000000 1212: } elsif ($new_key =~ /^libswanted_/) { 0 0.000000 0.000000 1213: my @libswanted = grep { not exists 0 0.000000 0.000000 1214: split(' ', 0 0.000000 0.000000 1215: $Config{libswanted} = join(' ', 0 0.000000 0.000000 1216: } 0 0.000000 0.000000 1217: } 0 0.000000 0.000000 1218: } 0 0.000000 0.000000 1219: } 0 0.000000 0.000000 1220: 0 0.000000 0.000000 1221: $self->{$key} = $value; 0 0.000000 0.000000 1222:} 0 0.000000 0.000000 1223: 3 0.000000 0.000000 1224:sub FETCH { 2 0.000008 0.000000 1225: my($self, $key) = @_; 0 0.000000 0.000000 1226: 0 0.000000 0.000000 1227: # check for cached value (which may be 2 0.000018 0.000000 1228: return $self->{$key} if exists $self- 0 0.000000 0.000000 1229: 0 0.000000 0.000000 1230: $self->fetch_string($key); 0 0.000000 0.000000 1231: return $self->{$key} if exists $self- 0 0.000000 0.000000 1232: $self->fetch_virtual($key); ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 166 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1233: 0 0.000000 0.000000 1234: # Might not exist, in which undef is 0 0.000000 0.000000 1235: return $self->{$key}; 0 0.000000 0.000000 1236:} 0 0.000000 0.000000 1237: 0 0.000000 0.000000 1238:my $prevpos = 0; 0 0.000000 0.000000 1239: 0 0.000000 0.000000 1240:sub FIRSTKEY { 0 0.000000 0.000000 1241: $prevpos = 0; 0 0.000000 0.000000 1242: substr($Config_SH, 0, index($Config_SH, 0 0.000000 0.000000 1243:} 0 0.000000 0.000000 1244: 0 0.000000 0.000000 1245:sub NEXTKEY { 0 0.000000 0.000000 1246: # Find out how the current key's quoted 0 0.000000 0.000000 1247: my $quote = substr($Config_SH, 0 0.000000 0.000000 1248: my $pos = index($Config_SH, qq($quote\n), 0 0.000000 0.000000 1249: my $len = index($Config_SH, "=", $pos) - 0 0.000000 0.000000 1250: $prevpos = $pos; 0 0.000000 0.000000 1251: $len > 0 ? substr($Config_SH, $pos, $len) 0 0.000000 0.000000 1252:} 0 0.000000 0.000000 1253: 0 0.000000 0.000000 1254:sub EXISTS { 0 0.000000 0.000000 1255: return 1 if exists($_[0]->{$_[1]}); 0 0.000000 0.000000 1256: 0 0.000000 0.000000 1257: return(index($Config_SH, "\n$_[1]='") != 0 0.000000 0.000000 1258: substr($Config_SH, 0, 0 0.000000 0.000000 1259: index($Config_SH, "\n$_[1]=\"") != 0 0.000000 0.000000 1260: substr($Config_SH, 0, 0 0.000000 0.000000 1261: $_[1] =~ 0 0.000000 0.000000 1262: ); 0 0.000000 0.000000 1263:} 0 0.000000 0.000000 1264: 0 0.000000 0.000000 1265:sub STORE { die "\%Config::Config is read- 0 0.000000 0.000000 1266:*DELETE = \&STORE; 0 0.000000 0.000000 1267:*CLEAR = \&STORE; 0 0.000000 0.000000 1268: 0 0.000000 0.000000 1269: 0 0.000000 0.000000 1270:sub config_sh { 0 0.000000 0.000000 1271: $Config_SH 0 0.000000 0.000000 1272:} 0 0.000000 0.000000 1273: 0 0.000000 0.000000 1274:sub config_re { 0 0.000000 0.000000 1275: my $re = shift; 0 0.000000 0.000000 1276: return map { chomp; $_ } grep eval{ 0 0.000000 0.000000 1277:} 0 0.000000 0.000000 1278: 0 0.000000 0.000000 1279:sub config_vars { 0 0.000000 0.000000 1280: foreach (@_) { 0 0.000000 0.000000 1281: my ($notag,$qry,$lncont) = 0 0.000000 0.000000 1282: my $prfx = $notag ? '': "$qry="; # prefix 0 0.000000 0.000000 1283: my $lnend = $lncont ? ' ' : ";\n"; # ending 0 0.000000 0.000000 1284: 0 0.000000 0.000000 1285: if ($qry =~ /\W/) { 0 0.000000 0.000000 1286: my @matches = config_re($qry); 0 0.000000 0.000000 1287: print map "$_$lnend", @matches ? 0 0.000000 0.000000 1288: print map { s/\w+=//; "$_$lnend" } ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/C Page 167 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1289: } else { 0 0.000000 0.000000 1290: my $v = (exists $Config{$qry}) ? 0 0.000000 0.000000 1291: $v = 'undef' unless defined $v; 0 0.000000 0.000000 1292: print "${prfx}'${v}'$lnend"; 0 0.000000 0.000000 1293: } 0 0.000000 0.000000 1294: } 0 0.000000 0.000000 1295:} 0 0.000000 0.000000 1296: 0 0.000000 0.000000 1297:sub TIEHASH { 0 0.000000 0.000000 1298: bless $_[1], $_[0]; 0 0.000000 0.000000 1299:} 0 0.000000 0.000000 1300: 0 0.000000 0.000000 1301:# avoid Config..Exporter..UNIVERSAL search 0 0.000000 0.000000 1302:sub DESTROY { } 0 0.000000 0.000000 1303: 0 0.000000 0.000000 1304:my $i = 0; 0 0.000000 0.000000 1305:foreach my $c (8,7,6,5,4,3,2) { $i |= 0 0.000000 0.000000 1306:$i |= ord(1); 0 0.000000 0.000000 1307:my $value = join('', unpack('aaaaaaaa', 0 0.000000 0.000000 1308: 0 0.000000 0.000000 1309: 0 0.000000 0.000000 1310:tie %Config, 'Config', { 0 0.000000 0.000000 1311: 'archlibexp' => 0 0.000000 0.000000 1312: 'archname' => 'x86_64-linux-thread- 0 0.000000 0.000000 1313: 'cc' => 'gcc', 0 0.000000 0.000000 1314: 'ccflags' => '-D_REENTRANT -D_GNU_SOURCE 0 0.000000 0.000000 1315: 'cppflags' => '-D_REENTRANT -D_GNU_SOURCE 0 0.000000 0.000000 1316: 'dlsrc' => 'dl_dlopen.xs', 0 0.000000 0.000000 1317: 'dynamic_ext' => 'B ByteLoader Cwd 0 0.000000 0.000000 1318: 'installarchlib' => 0 0.000000 0.000000 1319: 'installprivlib' => 0 0.000000 0.000000 1320: 'libpth' => '/usr/local/lib64 /lib64 0 0.000000 0.000000 1321: 'libs' => '-lresolv -lnsl -lgdbm -ldb - 0 0.000000 0.000000 1322: 'osname' => 'linux', 0 0.000000 0.000000 1323: 'osvers' => '2.6.9-34.0.2.el', 0 0.000000 0.000000 1324: 'prefix' => '/usr', 0 0.000000 0.000000 1325: 'privlibexp' => '/usr/lib/perl5/5.8.5', 0 0.000000 0.000000 1326: 'sharpbang' => '#!', 0 0.000000 0.000000 1327: 'shsharp' => 'true', 0 0.000000 0.000000 1328: 'so' => 'so', 0 0.000000 0.000000 1329: 'startsh' => '#!/bin/sh', 0 0.000000 0.000000 1330: 'static_ext' => ' ', 0 0.000000 0.000000 1331: byteorder => $value, 0 0.000000 0.000000 1332: 0 0.000000 0.000000 1333:}; 0 0.000000 0.000000 1334: 0 0.000000 0.000000 1335:1; ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/D Page 168 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1: 0 0.000000 0.000000 2:# Generated from DynaLoader.pm.PL 0 0.000000 0.000000 3: 0 0.000000 0.000000 4:package DynaLoader; 0 0.000000 0.000000 5: 0 0.000000 0.000000 6:# And Gandalf said: 'Many folk like to know 0 0.000000 0.000000 7:# be set on the table; but those who have 0 0.000000 0.000000 8:# feast like to keep their secret; for 0 0.000000 0.000000 9:# praise louder.' 0 0.000000 0.000000 10: 0 0.000000 0.000000 11:# (Quote from Tolkien suggested by Anno 0 0.000000 0.000000 12:# 0 0.000000 0.000000 13:# See pod text at end of file for 0 0.000000 0.000000 14:# See also ext/DynaLoader/README in source 0 0.000000 0.000000 15:# 0 0.000000 0.000000 16:# Tim.Bunce@ig.co.uk, August 1994 0 0.000000 0.000000 17: 0 0.000000 0.000000 18:use vars qw($VERSION *AUTOLOAD); 0 0.000000 0.000000 19: 0 0.000000 0.000000 20:$VERSION = '1.05'; # avoid typo warning 0 0.000000 0.000000 21: 0 0.000000 0.000000 22:require AutoLoader; 0 0.000000 0.000000 23:*AUTOLOAD = \&AutoLoader::AUTOLOAD; 0 0.000000 0.000000 24: 0 0.000000 0.000000 25:use Config; 0 0.000000 0.000000 26: 0 0.000000 0.000000 27:# The following require can't be removed 0 0.000000 0.000000 28:# releases, sadly, because of the risk of 0 0.000000 0.000000 29:# require Carp; Carp::croak "..."; without 0 0.000000 0.000000 30:# if Carp hasn't been loaded in earlier 0 0.000000 0.000000 31:# We'll let those bugs get found on the 0 0.000000 0.000000 32:require Carp if $] < 5.00450; 0 0.000000 0.000000 33: 0 0.000000 0.000000 34:# enable debug/trace messages from DynaLoader 0 0.000000 0.000000 35:$dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless 0 0.000000 0.000000 36: 0 0.000000 0.000000 37:# 0 0.000000 0.000000 38:# Flags to alter dl_load_file behaviour. 0 0.000000 0.000000 39:# 0x01 make symbols available for linking 0 0.000000 0.000000 40:# (only known to work on Solaris 2 0 0.000000 0.000000 41:# (ignored under VMS; effect is 0 0.000000 0.000000 42:# 0 0.000000 0.000000 43:# This is called as a class method $module- 0 0.000000 0.000000 44:# definition here will be inherited and 0 0.000000 0.000000 45:# behaviour unless a sub-class of DynaLoader 0 0.000000 0.000000 46:# 0 0.000000 0.000000 47: 4 0.001042 0.000000 48:sub dl_load_flags { 0x00 } 0 0.000000 0.000000 49: 0 0.000000 0.000000 50:# ($dl_dlext, $dlsrc) 0 0.000000 0.000000 51:# = @Config::Config{'dlext', 0 0.000000 0.000000 52: ($dl_dlext, $dlsrc) = ('so','dl_dlopen.xs') 0 0.000000 0.000000 53:; 0 0.000000 0.000000 54:# Some systems need special handling to 0 0.000000 0.000000 55:# (VMS support by Charles Bailey 0 0.000000 0.000000 56:# See dl_expandspec() for more details. ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/D Page 169 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57:# inefficient to define on systems that don't 0 0.000000 0.000000 58:$Is_VMS = $^O eq 'VMS'; 0 0.000000 0.000000 59:$do_expand = $Is_VMS; 0 0.000000 0.000000 60:$Is_MacOS = $^O eq 'MacOS'; 0 0.000000 0.000000 61: 0 0.000000 0.000000 62:my $Mac_FS; 0 0.000000 0.000000 63:$Mac_FS = eval { require 0 0.000000 0.000000 64: 0 0.000000 0.000000 65:@dl_require_symbols = (); # names of 0 0.000000 0.000000 66:@dl_resolve_using = (); # names of 0 0.000000 0.000000 67:@dl_library_path = (); # path to 0 0.000000 0.000000 68: 0 0.000000 0.000000 69:#XSLoader.pm may have added elements before 0 0.000000 0.000000 70:#@dl_shared_objects = (); # shared 0 0.000000 0.000000 71:#@dl_librefs = (); # things we 0 0.000000 0.000000 72:#@dl_modules = (); # Modules we 0 0.000000 0.000000 73: 0 0.000000 0.000000 74:# This is a fix to support DLD's unfortunate 0 0.000000 0.000000 75:@dl_resolve_using = dl_findfile('-lc') if 0 0.000000 0.000000 76: 0 0.000000 0.000000 77:# Initialise @dl_library_path with the 0 0.000000 0.000000 78:# for this platform as determined by 0 0.000000 0.000000 79: 0 0.000000 0.000000 80:push(@dl_library_path, split(' ', 0 0.000000 0.000000 81: 0 0.000000 0.000000 82: 0 0.000000 0.000000 83:my $ldlibpthname = 0 0.000000 0.000000 84:my $ldlibpthname_defined = defined 0 0.000000 0.000000 85:my $pthsep = 0 0.000000 0.000000 86: 0 0.000000 0.000000 87:# Add to @dl_library_path any extra 0 0.000000 0.000000 88:# during runtime. 0 0.000000 0.000000 89: 0 0.000000 0.000000 90:if ($ldlibpthname_defined && 0 0.000000 0.000000 91: exists $ENV{$ldlibpthname}) { 0 0.000000 0.000000 92: push(@dl_library_path, split(/$pthsep/, 0 0.000000 0.000000 93:} 0 0.000000 0.000000 94: 0 0.000000 0.000000 95:# E.g. HP-UX supports both its native 0 0.000000 0.000000 96: 0 0.000000 0.000000 97:if ($ldlibpthname_defined && 0 0.000000 0.000000 98: $ldlibpthname ne 'LD_LIBRARY_PATH' && 0 0.000000 0.000000 99: exists $ENV{LD_LIBRARY_PATH}) { 0 0.000000 0.000000 100: push(@dl_library_path, split(/$pthsep/, 0 0.000000 0.000000 101:} 0 0.000000 0.000000 102: 0 0.000000 0.000000 103: 0 0.000000 0.000000 104:# No prizes for guessing why we don't say 0 0.000000 0.000000 105:# NOTE: All dl_*.xs (including dl_none.xs) 0 0.000000 0.000000 106:boot_DynaLoader('DynaLoader') if 0 0.000000 0.000000 107: 0 0.000000 0.000000 108: 0 0.000000 0.000000 109:if ($dl_debug) { 0 0.000000 0.000000 110: print STDERR "DynaLoader.pm loaded (@INC, 0 0.000000 0.000000 111: print STDERR "DynaLoader not linked into 0 0.000000 0.000000 112: unless defined(&boot_DynaLoader); ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/D Page 170 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113:} 0 0.000000 0.000000 114: 0 0.000000 0.000000 115:1; # End of main code 0 0.000000 0.000000 116: 0 0.000000 0.000000 117: 0 0.000000 0.000000 118:sub croak { require Carp; Carp::croak(@_) 0 0.000000 0.000000 119: 0 0.000000 0.000000 120:sub bootstrap_inherit { 0 0.000000 0.000000 121: my $module = $_[0]; 0 0.000000 0.000000 122: local *isa = *{"$module\::ISA"}; 0 0.000000 0.000000 123: local @isa = (@isa, 'DynaLoader'); 0 0.000000 0.000000 124: # Cannot goto due to delocalization. 0 0.000000 0.000000 125: bootstrap(@_); 0 0.000000 0.000000 126:} 0 0.000000 0.000000 127: 0 0.000000 0.000000 128:# The bootstrap function cannot be autoloaded 0 0.000000 0.000000 129:# so we define it here: 0 0.000000 0.000000 130: 3 0.000000 0.000000 131:sub bootstrap { 0 0.000000 0.000000 132: # use local vars to enable $module.bs 1 0.000006 0.000000 133: local(@args) = @_; 1 0.000004 0.000000 134: local($module) = $args[0]; 1 0.000005 0.000000 135: local(@dirs, $file); 0 0.000000 0.000000 136: 1 0.000003 0.000000 137: unless ($module) { 0 0.000000 0.000000 138: require Carp; 0 0.000000 0.000000 139: Carp::confess("Usage: 0 0.000000 0.000000 140: } 0 0.000000 0.000000 141: 0 0.000000 0.000000 142: # A common error on platforms which don't 0 0.000000 0.000000 143: # Since it's fatal and potentially 1 0.000004 0.000000 144: croak("Can't load module $module, dynamic 0 0.000000 0.000000 145: " (You may need to build a new perl 0 0.000000 0.000000 146: " dynamic loading or has the $module module 0 0.000000 0.000000 147: unless defined(&dl_load_file); 0 0.000000 0.000000 148: 1 0.000010 0.000000 149: my @modparts = split(/::/,$module); 1 0.000004 0.000000 150: my $modfname = $modparts[-1]; 0 0.000000 0.000000 151: 0 0.000000 0.000000 152: # Some systems have restrictions on files 0 0.000000 0.000000 153: # mod2fname returns appropriate file base 0 0.000000 0.000000 154: # It may also edit @modparts if required. 1 0.000003 0.000000 155: $modfname = &mod2fname(\@modparts) if 0 0.000000 0.000000 156: 0 0.000000 0.000000 157: # Truncate the module name to 8.3 format 1 0.000005 0.000000 158: if (($^O eq 'NetWare') && (length($modfname) 0 0.000000 0.000000 159: $modfname = substr($modfname, 0, 8); 0 0.000000 0.000000 160: } 0 0.000000 0.000000 161: 1 0.000006 0.000000 162: my $modpname = join(($Is_MacOS ? ':' : 0 0.000000 0.000000 163: 1 0.000003 0.000000 164: print STDERR "DynaLoader::bootstrap for 0 0.000000 0.000000 165: ($Is_MacOS 0 0.000000 0.000000 166: ? 0 0.000000 0.000000 167: 0 0.000000 0.000000 168: if $dl_debug; ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/D Page 171 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169: 1 0.000004 0.000000 170: foreach (@INC) { 16 0.000037 0.000000 171: chop($_ = VMS::Filespec::unixpath($_)) if 16 0.000035 0.000000 172: my $dir; 16 0.000040 0.000000 173: if ($Is_MacOS) { 0 0.000000 0.000000 174: my $path = $_; 0 0.000000 0.000000 175: if ($Mac_FS && ! -d $path) { 0 0.000000 0.000000 176: $path = 0 0.000000 0.000000 177: } 0 0.000000 0.000000 178: $path .= ":" unless /:$/; 0 0.000000 0.000000 179: $dir = "${path}auto:$modpname"; 0 0.000000 0.000000 180: } else { 16 0.000052 0.000000 181: $dir = "$_/auto/$modpname"; 0 0.000000 0.000000 182: } 0 0.000000 0.000000 183: 16 0.000184 0.000000 184: next unless -d $dir; # skip over 0 0.000000 0.000000 185: 0 0.000000 0.000000 186: # check for common cases to avoid autoload 1 0.000006 0.000000 187: my $try = $Is_MacOS ? 1 0.000014 0.000000 188: last if $file = ($do_expand) ? 0 0.000000 0.000000 189: 0 0.000000 0.000000 190: # no luck here, save dir for possible later 0 0.000000 0.000000 191: push @dirs, $dir; 0 0.000000 0.000000 192: } 0 0.000000 0.000000 193: # last resort, let dl_findfile have a go 1 0.000003 0.000000 194: $file = dl_findfile(map("- 0 0.000000 0.000000 195: 1 0.000003 0.000000 196: croak("Can't locate loadable object for 0 0.000000 0.000000 197: unless $file; # wording similar to error 0 0.000000 0.000000 198: 1 0.000002 0.000000 199: $file = uc($file) if $Is_VMS && 1 0.000003 0.000000 200: my $bootname = "boot_$module"; 1 0.000007 0.000000 201: $bootname =~ s/\W/_/g; 1 0.000005 0.000000 202: @dl_require_symbols = ($bootname); 0 0.000000 0.000000 203: 0 0.000000 0.000000 204: # Execute optional '.bootstrap' perl 0 0.000000 0.000000 205: # The .bs file can be used to configure 0 0.000000 0.000000 206: # match the needs of the individual 1 0.000003 0.000000 207: my $bs = $file; 1 0.000095 0.000000 208: $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look 1 0.000013 0.000000 209: if (-s $bs) { # only read file if it's 0 0.000000 0.000000 210: print STDERR "BS: $bs ($^O, 0 0.000000 0.000000 211: eval { do $bs; }; 0 0.000000 0.000000 212: warn "$bs: $@\n" if $@; 0 0.000000 0.000000 213: } 0 0.000000 0.000000 214: 1 0.000002 0.000000 215: my $boot_symbol_ref; 0 0.000000 0.000000 216: 1 0.000004 0.000000 217: if ($^O eq 'darwin') { 0 0.000000 0.000000 218: if ($boot_symbol_ref = 0 0.000000 0.000000 219: goto boot; #extension library has 0 0.000000 0.000000 220: } 0 0.000000 0.000000 221: } 0 0.000000 0.000000 222: 0 0.000000 0.000000 223: # Many dynamic extension loading problems 0 0.000000 0.000000 224: # this section of code: XYZ failed at ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/D Page 172 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 225: # Often these errors are actually 0 0.000000 0.000000 226: # C code of the extension XS file. Perl 0 0.000000 0.000000 227: # in this perl code simply because this 0 0.000000 0.000000 228: # it executed. 0 0.000000 0.000000 229: 1 0.000006 0.000000 230: my $libref = dl_load_file($file, $module- 0 0.000000 0.000000 231: croak("Can't load '$file' for module 0 0.000000 0.000000 232: 1 0.000006 0.000000 233: push(@dl_librefs,$libref); # record 0 0.000000 0.000000 234: 1 0.000007 0.000000 235: my @unresolved = dl_undef_symbols(); 1 0.000003 0.000000 236: if (@unresolved) { 0 0.000000 0.000000 237: require Carp; 0 0.000000 0.000000 238: Carp::carp("Undefined symbols present after 0 0.000000 0.000000 239: } 0 0.000000 0.000000 240: 1 0.000010 0.000000 241: $boot_symbol_ref = 0 0.000000 0.000000 242: croak("Can't find '$bootname' symbol 0 0.000000 0.000000 243: 1 0.000004 0.000000 244: push(@dl_modules, $module); # record 0 0.000000 0.000000 245: 1 0.000018 0.000000 246: boot: 0 0.000000 0.000000 247: my $xs = 0 0.000000 0.000000 248: 0 0.000000 0.000000 249: # See comment block above 0 0.000000 0.000000 250: 1 0.000004 0.000000 251: push(@dl_shared_objects, $file); # record 0 0.000000 0.000000 252: 1 0.000202 0.000000 253: &$xs(@args); 0 0.000000 0.000000 254:} 0 0.000000 0.000000 255: 0 0.000000 0.000000 256: 0 0.000000 0.000000 257:#sub _check_file { # private utility to 0 0.000000 0.000000 258:# my($file) = @_; 0 0.000000 0.000000 259:# return $file if (!$do_expand && -f 0 0.000000 0.000000 260:# return $file if ( $do_expand && 0 0.000000 0.000000 261:# return undef; 0 0.000000 0.000000 262:#} 0 0.000000 0.000000 263: 0 0.000000 0.000000 264: 0 0.000000 0.000000 265:# Let autosplit and the autoloader deal with 0 0.000000 0.000000 266:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/E Page 173 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:# 0 0.000000 0.000000 2:# This file is auto-generated. ***ANY*** 0 0.000000 0.000000 3:# 0 0.000000 0.000000 4: 0 0.000000 0.000000 5:package Errno; 1 0.000004 0.000000 6:our 3 0.000010 0.000000 7:use Exporter (); 3 0.000011 0.000000 8:use Config; 3 0.000009 0.000000 9:use strict; 0 0.000000 0.000000 10: 1 0.000006 0.000000 11:"$Config{'archname'}-$Config{'osvers'}" eq 0 0.000000 0.000000 12:"x86_64-linux-thread-multi-2.6.9-34.0.2.el" 0 0.000000 0.000000 13: die "Errno architecture (x86_64-linux- 0 0.000000 0.000000 14: 1 0.000003 0.000000 15:$VERSION = "1.09_00"; 1 0.000042 0.000000 16:$VERSION = eval $VERSION; 1 0.000007 0.000000 17:@ISA = qw(Exporter); 0 0.000000 0.000000 18: 1 0.000050 0.000000 19:@EXPORT_OK = qw(EBADR ENOMSG ENOTSUP ESTRPIPE 0 0.000000 0.000000 20: ENOTBLK ENAVAIL ECHRNG ENOTNAM ELNRNG ENOKEY 0 0.000000 0.000000 21: ECONNREFUSED ENOSTR ENONET EOVERFLOW EISCONN 0 0.000000 0.000000 22: ECONNRESET EWOULDBLOCK ELIBMAX EREMOTEIO 0 0.000000 0.000000 23: ENOTSOCK EIO EMEDIUMTYPE EINPROGRESS ERANGE 0 0.000000 0.000000 24: EINTR EREMOTE EILSEQ ENOMEM EPIPE 0 0.000000 0.000000 25: EOPNOTSUPP EPROTO EISNAM ESPIPE EALREADY 0 0.000000 0.000000 26: EBADRQC EEXIST EDOTDOT ELIBBAD ESRCH EFAULT 0 0.000000 0.000000 27: ENOPROTOOPT ENETDOWN EPROTOTYPE EL2NSYNC 0 0.000000 0.000000 28: ESHUTDOWN EMULTIHOP EPROTONOSUPPORT ENFILE 0 0.000000 0.000000 29: ECANCELED EDEADLK ESRMNT ENOLINK ETIME 0 0.000000 0.000000 30: ELOOP ENOENT EPFNOSUPPORT EBADMSG ENOMEDIUM 0 0.000000 0.000000 31: EKEYEXPIRED EMSGSIZE ENOCSI EL3RST ENOSPC 0 0.000000 0.000000 32: EHOSTDOWN EBADFD ENOSR ENOTCONN ESTALE 0 0.000000 0.000000 33: EACCES EBUSY E2BIG EPERM ELIBEXEC 0 0.000000 0.000000 34: ERESTART ESOCKTNOSUPPORT EUNATCH ETIMEDOUT 0 0.000000 0.000000 35: ECHILD EHOSTUNREACH EREMCHG ENOTEMPTY); 0 0.000000 0.000000 36: 1 0.000047 0.010000 37:%EXPORT_TAGS = ( 0 0.000000 0.000000 38: POSIX => [qw( 0 0.000000 0.000000 39: E2BIG EACCES EADDRINUSE EADDRNOTAVAIL 0 0.000000 0.000000 40: EBADF EBUSY ECHILD ECONNABORTED ECONNREFUSED 0 0.000000 0.000000 41: EDESTADDRREQ EDOM EDQUOT EEXIST EFAULT EFBIG 0 0.000000 0.000000 42: EINPROGRESS EINTR EINVAL EIO EISCONN EISDIR 0 0.000000 0.000000 43: EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET 0 0.000000 0.000000 44: ENODEV ENOENT ENOEXEC ENOLCK ENOMEM 0 0.000000 0.000000 45: ENOTCONN ENOTDIR ENOTEMPTY ENOTSOCK ENOTTY 0 0.000000 0.000000 46: EPFNOSUPPORT EPIPE EPROTONOSUPPORT 0 0.000000 0.000000 47: EROFS ESHUTDOWN ESOCKTNOSUPPORT ESPIPE ESRCH 0 0.000000 0.000000 48: ETOOMANYREFS ETXTBSY EUSERS EWOULDBLOCK 0 0.000000 0.000000 49: )] 0 0.000000 0.000000 50:); 0 0.000000 0.000000 51: 0 0.000000 0.000000 52:sub EPERM () { 1 } 0 0.000000 0.000000 53:sub ENOENT () { 2 } 0 0.000000 0.000000 54:sub ESRCH () { 3 } 0 0.000000 0.000000 55:sub EINTR () { 4 } 0 0.000000 0.000000 56:sub EIO () { 5 } ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/E Page 174 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57:sub ENXIO () { 6 } 0 0.000000 0.000000 58:sub E2BIG () { 7 } 0 0.000000 0.000000 59:sub ENOEXEC () { 8 } 0 0.000000 0.000000 60:sub EBADF () { 9 } 0 0.000000 0.000000 61:sub ECHILD () { 10 } 0 0.000000 0.000000 62:sub EWOULDBLOCK () { 11 } 0 0.000000 0.000000 63:sub EAGAIN () { 11 } 0 0.000000 0.000000 64:sub ENOMEM () { 12 } 0 0.000000 0.000000 65:sub EACCES () { 13 } 0 0.000000 0.000000 66:sub EFAULT () { 14 } 0 0.000000 0.000000 67:sub ENOTBLK () { 15 } 0 0.000000 0.000000 68:sub EBUSY () { 16 } 0 0.000000 0.000000 69:sub EEXIST () { 17 } 0 0.000000 0.000000 70:sub EXDEV () { 18 } 0 0.000000 0.000000 71:sub ENODEV () { 19 } 0 0.000000 0.000000 72:sub ENOTDIR () { 20 } 0 0.000000 0.000000 73:sub EISDIR () { 21 } 0 0.000000 0.000000 74:sub EINVAL () { 22 } 0 0.000000 0.000000 75:sub ENFILE () { 23 } 0 0.000000 0.000000 76:sub EMFILE () { 24 } 0 0.000000 0.000000 77:sub ENOTTY () { 25 } 0 0.000000 0.000000 78:sub ETXTBSY () { 26 } 0 0.000000 0.000000 79:sub EFBIG () { 27 } 0 0.000000 0.000000 80:sub ENOSPC () { 28 } 0 0.000000 0.000000 81:sub ESPIPE () { 29 } 0 0.000000 0.000000 82:sub EROFS () { 30 } 0 0.000000 0.000000 83:sub EMLINK () { 31 } 0 0.000000 0.000000 84:sub EPIPE () { 32 } 0 0.000000 0.000000 85:sub EDOM () { 33 } 0 0.000000 0.000000 86:sub ERANGE () { 34 } 0 0.000000 0.000000 87:sub EDEADLOCK () { 35 } 0 0.000000 0.000000 88:sub EDEADLK () { 35 } 0 0.000000 0.000000 89:sub ENAMETOOLONG () { 36 } 0 0.000000 0.000000 90:sub ENOLCK () { 37 } 0 0.000000 0.000000 91:sub ENOSYS () { 38 } 0 0.000000 0.000000 92:sub ENOTEMPTY () { 39 } 0 0.000000 0.000000 93:sub ELOOP () { 40 } 0 0.000000 0.000000 94:sub ENOMSG () { 42 } 0 0.000000 0.000000 95:sub EIDRM () { 43 } 0 0.000000 0.000000 96:sub ECHRNG () { 44 } 0 0.000000 0.000000 97:sub EL2NSYNC () { 45 } 0 0.000000 0.000000 98:sub EL3HLT () { 46 } 0 0.000000 0.000000 99:sub EL3RST () { 47 } 0 0.000000 0.000000 100:sub ELNRNG () { 48 } 0 0.000000 0.000000 101:sub EUNATCH () { 49 } 0 0.000000 0.000000 102:sub ENOCSI () { 50 } 0 0.000000 0.000000 103:sub EL2HLT () { 51 } 0 0.000000 0.000000 104:sub EBADE () { 52 } 0 0.000000 0.000000 105:sub EBADR () { 53 } 0 0.000000 0.000000 106:sub EXFULL () { 54 } 0 0.000000 0.000000 107:sub ENOANO () { 55 } 0 0.000000 0.000000 108:sub EBADRQC () { 56 } 0 0.000000 0.000000 109:sub EBADSLT () { 57 } 0 0.000000 0.000000 110:sub EBFONT () { 59 } 0 0.000000 0.000000 111:sub ENOSTR () { 60 } 0 0.000000 0.000000 112:sub ENODATA () { 61 } ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/E Page 175 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113:sub ETIME () { 62 } 0 0.000000 0.000000 114:sub ENOSR () { 63 } 0 0.000000 0.000000 115:sub ENONET () { 64 } 0 0.000000 0.000000 116:sub ENOPKG () { 65 } 0 0.000000 0.000000 117:sub EREMOTE () { 66 } 0 0.000000 0.000000 118:sub ENOLINK () { 67 } 0 0.000000 0.000000 119:sub EADV () { 68 } 0 0.000000 0.000000 120:sub ESRMNT () { 69 } 0 0.000000 0.000000 121:sub ECOMM () { 70 } 0 0.000000 0.000000 122:sub EPROTO () { 71 } 0 0.000000 0.000000 123:sub EMULTIHOP () { 72 } 0 0.000000 0.000000 124:sub EDOTDOT () { 73 } 0 0.000000 0.000000 125:sub EBADMSG () { 74 } 0 0.000000 0.000000 126:sub EOVERFLOW () { 75 } 0 0.000000 0.000000 127:sub ENOTUNIQ () { 76 } 0 0.000000 0.000000 128:sub EBADFD () { 77 } 0 0.000000 0.000000 129:sub EREMCHG () { 78 } 0 0.000000 0.000000 130:sub ELIBACC () { 79 } 0 0.000000 0.000000 131:sub ELIBBAD () { 80 } 0 0.000000 0.000000 132:sub ELIBSCN () { 81 } 0 0.000000 0.000000 133:sub ELIBMAX () { 82 } 0 0.000000 0.000000 134:sub ELIBEXEC () { 83 } 0 0.000000 0.000000 135:sub EILSEQ () { 84 } 0 0.000000 0.000000 136:sub ERESTART () { 85 } 0 0.000000 0.000000 137:sub ESTRPIPE () { 86 } 0 0.000000 0.000000 138:sub EUSERS () { 87 } 0 0.000000 0.000000 139:sub ENOTSOCK () { 88 } 0 0.000000 0.000000 140:sub EDESTADDRREQ () { 89 } 0 0.000000 0.000000 141:sub EMSGSIZE () { 90 } 0 0.000000 0.000000 142:sub EPROTOTYPE () { 91 } 0 0.000000 0.000000 143:sub ENOPROTOOPT () { 92 } 0 0.000000 0.000000 144:sub EPROTONOSUPPORT () { 93 } 0 0.000000 0.000000 145:sub ESOCKTNOSUPPORT () { 94 } 0 0.000000 0.000000 146:sub ENOTSUP () { 95 } 0 0.000000 0.000000 147:sub EOPNOTSUPP () { 95 } 0 0.000000 0.000000 148:sub EPFNOSUPPORT () { 96 } 0 0.000000 0.000000 149:sub EAFNOSUPPORT () { 97 } 0 0.000000 0.000000 150:sub EADDRINUSE () { 98 } 0 0.000000 0.000000 151:sub EADDRNOTAVAIL () { 99 } 0 0.000000 0.000000 152:sub ENETDOWN () { 100 } 0 0.000000 0.000000 153:sub ENETUNREACH () { 101 } 0 0.000000 0.000000 154:sub ENETRESET () { 102 } 0 0.000000 0.000000 155:sub ECONNABORTED () { 103 } 0 0.000000 0.000000 156:sub ECONNRESET () { 104 } 0 0.000000 0.000000 157:sub ENOBUFS () { 105 } 0 0.000000 0.000000 158:sub EISCONN () { 106 } 0 0.000000 0.000000 159:sub ENOTCONN () { 107 } 0 0.000000 0.000000 160:sub ESHUTDOWN () { 108 } 0 0.000000 0.000000 161:sub ETOOMANYREFS () { 109 } 0 0.000000 0.000000 162:sub ETIMEDOUT () { 110 } 0 0.000000 0.000000 163:sub ECONNREFUSED () { 111 } 0 0.000000 0.000000 164:sub EHOSTDOWN () { 112 } 0 0.000000 0.000000 165:sub EHOSTUNREACH () { 113 } 0 0.000000 0.000000 166:sub EALREADY () { 114 } 0 0.000000 0.000000 167:sub EINPROGRESS () { 115 } 0 0.000000 0.000000 168:sub ESTALE () { 116 } ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/E Page 176 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169:sub EUCLEAN () { 117 } 0 0.000000 0.000000 170:sub ENOTNAM () { 118 } 0 0.000000 0.000000 171:sub ENAVAIL () { 119 } 0 0.000000 0.000000 172:sub EISNAM () { 120 } 0 0.000000 0.000000 173:sub EREMOTEIO () { 121 } 0 0.000000 0.000000 174:sub EDQUOT () { 122 } 0 0.000000 0.000000 175:sub ENOMEDIUM () { 123 } 0 0.000000 0.000000 176:sub EMEDIUMTYPE () { 124 } 0 0.000000 0.000000 177:sub ECANCELED () { 125 } 0 0.000000 0.000000 178:sub ENOKEY () { 126 } 0 0.000000 0.000000 179:sub EKEYEXPIRED () { 127 } 0 0.000000 0.000000 180:sub EKEYREVOKED () { 128 } 0 0.000000 0.000000 181:sub EKEYREJECTED () { 129 } 0 0.000000 0.000000 182: 2 0.000027 0.000000 183:sub TIEHASH { bless [] } 0 0.000000 0.000000 184: 362 0.000000 0.000000 185:sub FETCH { 362 0.001518 0.010000 186: my ($self, $errname) = @_; 362 0.002463 0.020000 187: my $proto = prototype("Errno::$errname"); 362 0.001106 0.000000 188: my $errno = ""; 362 0.001302 0.000000 189: if (defined($proto) && $proto eq "") { 3 0.000013 0.000000 190: no strict 'refs'; 362 0.002471 0.000000 191: $errno = &$errname; 362 0.006253 0.010000 192: $errno = 0 unless $! == $errno; 0 0.000000 0.000000 193: } 362 0.002882 0.000000 194: return $errno; 0 0.000000 0.000000 195:} 0 0.000000 0.000000 196: 0 0.000000 0.000000 197:sub STORE { 0 0.000000 0.000000 198: require Carp; 0 0.000000 0.000000 199: Carp::confess("ERRNO hash is read 0 0.000000 0.000000 200:} 0 0.000000 0.000000 201: 1 0.000006 0.000000 202:*CLEAR = \&STORE; 1 0.000005 0.000000 203:*DELETE = \&STORE; 0 0.000000 0.000000 204: 0 0.000000 0.000000 205:sub NEXTKEY { 0 0.000000 0.000000 206: my($k,$v); 0 0.000000 0.000000 207: while(($k,$v) = each %Errno::) { 0 0.000000 0.000000 208: my $proto = prototype("Errno::$k"); 0 0.000000 0.000000 209: last if (defined($proto) && $proto eq ""); 0 0.000000 0.000000 210: } 0 0.000000 0.000000 211: $k 0 0.000000 0.000000 212:} 0 0.000000 0.000000 213: 0 0.000000 0.000000 214:sub FIRSTKEY { 0 0.000000 0.000000 215: my $s = scalar keys %Errno::; # 0 0.000000 0.000000 216: goto &NEXTKEY; 0 0.000000 0.000000 217:} 0 0.000000 0.000000 218: 0 0.000000 0.000000 219:sub EXISTS { 0 0.000000 0.000000 220: my ($self, $errname) = @_; 0 0.000000 0.000000 221: my $proto = prototype($errname); 0 0.000000 0.000000 222: defined($proto) && $proto eq ""; 0 0.000000 0.000000 223:} 0 0.000000 0.000000 224: ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/E Page 177 ================================================================= count wall tm cpu time line 1 0.000005 0.000000 225:tie %!, __PACKAGE__; 0 0.000000 0.000000 226: 1 0.000084 0.000000 227:1; 0 0.000000 0.000000 228:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/I Page 178 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:# 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:package IO; 0 0.000000 0.000000 4: 3 0.001211 0.000000 5:use XSLoader (); 3 0.000011 0.000000 6:use Carp; 3 0.000009 0.000000 7:use strict; 3 0.000016 0.000000 8:use warnings; 0 0.000000 0.000000 9: 1 0.000004 0.000000 10:our $VERSION = "1.21"; 1 0.000005 0.000000 11:XSLoader::load 'IO', $VERSION; 0 0.000000 0.000000 12: 0 0.000000 0.000000 13:sub import { 0 0.000000 0.000000 14: shift; 0 0.000000 0.000000 15: 0 0.000000 0.000000 16: warnings::warnif('deprecated', 0 0.000000 0.000000 17: if @_ == 0 ; 0 0.000000 0.000000 18: 0 0.000000 0.000000 19: my @l = @_ ? @_ : qw(Handle Seekable File 0 0.000000 0.000000 20: 0 0.000000 0.000000 21: eval join("", map { "require IO::" . 0 0.000000 0.000000 22: or croak $@; 0 0.000000 0.000000 23:} 0 0.000000 0.000000 24: 1 0.000013 0.000000 25:1; 0 0.000000 0.000000 26: 0 0.000000 0.000000 27:__END__ ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/I Page 179 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 1:package IO::Handle; 0 0.000000 0.000000 2: 0 0.000000 0.000000 3:=head1 NAME 0 0.000000 0.000000 4: 0 0.000000 0.000000 5: 0 0.000000 0.000000 6: 0 0.000000 0.000000 7: 0 0.000000 0.000000 8: 0 0.000000 0.000000 9: 0 0.000000 0.000000 10: 0 0.000000 0.000000 11: 0 0.000000 0.000000 12: 0 0.000000 0.000000 13: 0 0.000000 0.000000 14: 0 0.000000 0.000000 15: 0 0.000000 0.000000 16: 0 0.000000 0.000000 17: 0 0.000000 0.000000 18: 0 0.000000 0.000000 19: 0 0.000000 0.000000 20: 0 0.000000 0.000000 21: 0 0.000000 0.000000 22: 0 0.000000 0.000000 23: 0 0.000000 0.000000 24: 0 0.000000 0.000000 25: 0 0.000000 0.000000 26: 0 0.000000 0.000000 27: 0 0.000000 0.000000 28: 0 0.000000 0.000000 29: 0 0.000000 0.000000 30: 0 0.000000 0.000000 31: 0 0.000000 0.000000 32: 0 0.000000 0.000000 33: 0 0.000000 0.000000 34: 0 0.000000 0.000000 35: 0 0.000000 0.000000 36: 0 0.000000 0.000000 37: 0 0.000000 0.000000 38: 0 0.000000 0.000000 39: 0 0.000000 0.000000 40: 0 0.000000 0.000000 41: 0 0.000000 0.000000 42: 0 0.000000 0.000000 43: 0 0.000000 0.000000 44: 0 0.000000 0.000000 45: 0 0.000000 0.000000 46: 0 0.000000 0.000000 47: 0 0.000000 0.000000 48: 0 0.000000 0.000000 49: 0 0.000000 0.000000 50: 0 0.000000 0.000000 51: 0 0.000000 0.000000 52: 0 0.000000 0.000000 53: 0 0.000000 0.000000 54: 0 0.000000 0.000000 55: 0 0.000000 0.000000 56: ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/I Page 180 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 57: 0 0.000000 0.000000 58: 0 0.000000 0.000000 59: 0 0.000000 0.000000 60: 0 0.000000 0.000000 61: 0 0.000000 0.000000 62: 0 0.000000 0.000000 63: 0 0.000000 0.000000 64: 0 0.000000 0.000000 65: 0 0.000000 0.000000 66: 0 0.000000 0.000000 67: 0 0.000000 0.000000 68: 0 0.000000 0.000000 69: 0 0.000000 0.000000 70: 0 0.000000 0.000000 71: 0 0.000000 0.000000 72: 0 0.000000 0.000000 73: 0 0.000000 0.000000 74: 0 0.000000 0.000000 75: 0 0.000000 0.000000 76: 0 0.000000 0.000000 77: 0 0.000000 0.000000 78: 0 0.000000 0.000000 79: 0 0.000000 0.000000 80: 0 0.000000 0.000000 81: 0 0.000000 0.000000 82: 0 0.000000 0.000000 83: 0 0.000000 0.000000 84: 0 0.000000 0.000000 85: 0 0.000000 0.000000 86: 0 0.000000 0.000000 87: 0 0.000000 0.000000 88: 0 0.000000 0.000000 89: 0 0.000000 0.000000 90: 0 0.000000 0.000000 91: 0 0.000000 0.000000 92: 0 0.000000 0.000000 93: 0 0.000000 0.000000 94: 0 0.000000 0.000000 95: 0 0.000000 0.000000 96: 0 0.000000 0.000000 97: 0 0.000000 0.000000 98: 0 0.000000 0.000000 99: 0 0.000000 0.000000 100: 0 0.000000 0.000000 101: 0 0.000000 0.000000 102: 0 0.000000 0.000000 103: 0 0.000000 0.000000 104: 0 0.000000 0.000000 105: 0 0.000000 0.000000 106: 0 0.000000 0.000000 107: 0 0.000000 0.000000 108: 0 0.000000 0.000000 109: 0 0.000000 0.000000 110: 0 0.000000 0.000000 111: 0 0.000000 0.000000 112: ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/I Page 181 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 113: 0 0.000000 0.000000 114: 0 0.000000 0.000000 115: 0 0.000000 0.000000 116: 0 0.000000 0.000000 117: 0 0.000000 0.000000 118: 0 0.000000 0.000000 119: 0 0.000000 0.000000 120: 0 0.000000 0.000000 121: 0 0.000000 0.000000 122: 0 0.000000 0.000000 123: 0 0.000000 0.000000 124: 0 0.000000 0.000000 125: 0 0.000000 0.000000 126: 0 0.000000 0.000000 127: 0 0.000000 0.000000 128: 0 0.000000 0.000000 129: 0 0.000000 0.000000 130: 0 0.000000 0.000000 131: 0 0.000000 0.000000 132: 0 0.000000 0.000000 133: 0 0.000000 0.000000 134: 0 0.000000 0.000000 135: 0 0.000000 0.000000 136: 0 0.000000 0.000000 137: 0 0.000000 0.000000 138: 0 0.000000 0.000000 139: 0 0.000000 0.000000 140: 0 0.000000 0.000000 141: 0 0.000000 0.000000 142: 0 0.000000 0.000000 143: 0 0.000000 0.000000 144: 0 0.000000 0.000000 145: 0 0.000000 0.000000 146: 0 0.000000 0.000000 147: 0 0.000000 0.000000 148: 0 0.000000 0.000000 149: 0 0.000000 0.000000 150: 0 0.000000 0.000000 151: 0 0.000000 0.000000 152: 0 0.000000 0.000000 153: 0 0.000000 0.000000 154: 0 0.000000 0.000000 155: 0 0.000000 0.000000 156: 0 0.000000 0.000000 157: 0 0.000000 0.000000 158: 0 0.000000 0.000000 159: 0 0.000000 0.000000 160: 0 0.000000 0.000000 161: 0 0.000000 0.000000 162: 0 0.000000 0.000000 163: 0 0.000000 0.000000 164: 0 0.000000 0.000000 165: 0 0.000000 0.000000 166: 0 0.000000 0.000000 167: 0 0.000000 0.000000 168: ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/I Page 182 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 169: 0 0.000000 0.000000 170: 0 0.000000 0.000000 171: 0 0.000000 0.000000 172: 0 0.000000 0.000000 173: 0 0.000000 0.000000 174: 0 0.000000 0.000000 175: 0 0.000000 0.000000 176: 0 0.000000 0.000000 177: 0 0.000000 0.000000 178: 0 0.000000 0.000000 179: 0 0.000000 0.000000 180: 0 0.000000 0.000000 181: 0 0.000000 0.000000 182: 0 0.000000 0.000000 183: 0 0.000000 0.000000 184: 0 0.000000 0.000000 185: 0 0.000000 0.000000 186: 0 0.000000 0.000000 187: 0 0.000000 0.000000 188: 0 0.000000 0.000000 189: 0 0.000000 0.000000 190: 0 0.000000 0.000000 191: 0 0.000000 0.000000 192: 0 0.000000 0.000000 193: 0 0.000000 0.000000 194: 0 0.000000 0.000000 195: 0 0.000000 0.000000 196: 0 0.000000 0.000000 197: 0 0.000000 0.000000 198: 0 0.000000 0.000000 199: 0 0.000000 0.000000 200: 0 0.000000 0.000000 201: 0 0.000000 0.000000 202: 0 0.000000 0.000000 203: 0 0.000000 0.000000 204: 0 0.000000 0.000000 205: 0 0.000000 0.000000 206: 0 0.000000 0.000000 207: 0 0.000000 0.000000 208: 0 0.000000 0.000000 209: 0 0.000000 0.000000 210: 0 0.000000 0.000000 211: 0 0.000000 0.000000 212: 0 0.000000 0.000000 213: 0 0.000000 0.000000 214: 0 0.000000 0.000000 215: 0 0.000000 0.000000 216: 0 0.000000 0.000000 217: 0 0.000000 0.000000 218: 0 0.000000 0.000000 219: 0 0.000000 0.000000 220: 0 0.000000 0.000000 221: 0 0.000000 0.000000 222: 0 0.000000 0.000000 223: 0 0.000000 0.000000 224: ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/I Page 183 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 225: 0 0.000000 0.000000 226: 0 0.000000 0.000000 227: 0 0.000000 0.000000 228: 0 0.000000 0.000000 229: 0 0.000000 0.000000 230: 0 0.000000 0.000000 231: 0 0.000000 0.000000 232: 0 0.000000 0.000000 233: 0 0.000000 0.000000 234: 0 0.000000 0.000000 235: 0 0.000000 0.000000 236: 0 0.000000 0.000000 237: 0 0.000000 0.000000 238: 0 0.000000 0.000000 239: 0 0.000000 0.000000 240: 0 0.000000 0.000000 241: 0 0.000000 0.000000 242: 0 0.000000 0.000000 243: 0 0.000000 0.000000 244: 0 0.000000 0.000000 245: 0 0.000000 0.000000 246: 0 0.000000 0.000000 247: 0 0.000000 0.000000 248: 0 0.000000 0.000000 249: 0 0.000000 0.000000 250: 0 0.000000 0.000000 251: 0 0.000000 0.000000 252: 0 0.000000 0.000000 253: 3 0.000008 0.000000 254:use 5.006_001; 3 0.000012 0.000000 255:use strict; 1 0.000004 0.000000 256:our($VERSION, @EXPORT_OK, @ISA); 3 0.000010 0.000000 257:use Carp; 3 0.000011 0.000000 258:use Symbol; 3 0.000010 0.000000 259:use SelectSaver; 3 0.000013 0.000000 260:use IO (); # Load the XS module 0 0.000000 0.000000 261: 1 0.000004 0.000000 262:require Exporter; 1 0.000007 0.000000 263:@ISA = qw(Exporter); 0 0.000000 0.000000 264: 1 0.000004 0.000000 265:$VERSION = "1.24"; 1 0.000042 0.000000 266:$VERSION = eval $VERSION; 0 0.000000 0.000000 267: 1 0.000015 0.000000 268:@EXPORT_OK = qw( 0 0.000000 0.000000 269: autoflush 0 0.000000 0.000000 270: output_field_separator 0 0.000000 0.000000 271: output_record_separator 0 0.000000 0.000000 272: input_record_separator 0 0.000000 0.000000 273: input_line_number 0 0.000000 0.000000 274: format_page_number 0 0.000000 0.000000 275: format_lines_per_page 0 0.000000 0.000000 276: format_lines_left 0 0.000000 0.000000 277: format_name 0 0.000000 0.000000 278: format_top_name 0 0.000000 0.000000 279: format_line_break_characters 0 0.000000 0.000000 280: format_formfeed ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/I Page 184 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 281: format_write 0 0.000000 0.000000 282: 0 0.000000 0.000000 283: print 0 0.000000 0.000000 284: printf 0 0.000000 0.000000 285: getline 0 0.000000 0.000000 286: getlines 0 0.000000 0.000000 287: 0 0.000000 0.000000 288: printflush 0 0.000000 0.000000 289: flush 0 0.000000 0.000000 290: 0 0.000000 0.000000 291: SEEK_SET 0 0.000000 0.000000 292: SEEK_CUR 0 0.000000 0.000000 293: SEEK_END 0 0.000000 0.000000 294: _IOFBF 0 0.000000 0.000000 295: _IOLBF 0 0.000000 0.000000 296: _IONBF 0 0.000000 0.000000 297:); 0 0.000000 0.000000 298: 0 0.000000 0.000000 299:############################################# 0 0.000000 0.000000 300:## Constructors, destructors. 0 0.000000 0.000000 301:## 0 0.000000 0.000000 302: 387 0.000000 0.000000 303:sub new { 387 0.001636 0.000000 304: my $class = ref($_[0]) || $_[0] || 387 0.001281 0.000000 305: @_ == 1 or croak "usage: new $class"; 387 0.002186 0.000000 306: my $io = gensym; 387 0.003373 0.010000 307: bless $io, $class; 0 0.000000 0.000000 308:} 0 0.000000 0.000000 309: 0 0.000000 0.000000 310:sub new_from_fd { 0 0.000000 0.000000 311: my $class = ref($_[0]) || $_[0] || 0 0.000000 0.000000 312: @_ == 3 or croak "usage: new_from_fd 0 0.000000 0.000000 313: my $io = gensym; 0 0.000000 0.000000 314: shift; 0 0.000000 0.000000 315: IO::Handle::fdopen($io, @_) 0 0.000000 0.000000 316: or return undef; 0 0.000000 0.000000 317: bless $io, $class; 0 0.000000 0.000000 318:} 0 0.000000 0.000000 319: 0 0.000000 0.000000 320:# 0 0.000000 0.000000 321:# There is no need for DESTROY to do 0 0.000000 0.000000 322:# last reference to an IO object is gone, 0 0.000000 0.000000 323:# closes its associated files (if any). 0 0.000000 0.000000 324:# attempts to autoload DESTROY, we here 0 0.000000 0.000000 325:# 1548 0.020770 0.050000 326:sub DESTROY {} 0 0.000000 0.000000 327: 0 0.000000 0.000000 328: 0 0.000000 0.000000 329:############################################# 0 0.000000 0.000000 330:## Open and close. 0 0.000000 0.000000 331:## 0 0.000000 0.000000 332: 0 0.000000 0.000000 333:sub _open_mode_string { 0 0.000000 0.000000 334: my ($mode) = @_; 0 0.000000 0.000000 335: $mode =~ /^\+?(<|>>?)$/ 0 0.000000 0.000000 336: or $mode =~ s/^r(\+?)$/$1/ 0 0.000000 0.000000 338: or $mode =~ s/^a(\+?)$/$1>>/ 0 0.000000 0.000000 339: or croak "IO::Handle: bad open mode: 0 0.000000 0.000000 340: $mode; 0 0.000000 0.000000 341:} 0 0.000000 0.000000 342: 0 0.000000 0.000000 343:sub fdopen { 0 0.000000 0.000000 344: @_ == 3 or croak 'usage: $io->fdopen(FD, 0 0.000000 0.000000 345: my ($io, $fd, $mode) = @_; 0 0.000000 0.000000 346: local(*GLOB); 0 0.000000 0.000000 347: 0 0.000000 0.000000 348: if (ref($fd) && "".$fd =~ /GLOB\(/o) { 0 0.000000 0.000000 349: # It's a glob reference; Alias it as we 0 0.000000 0.000000 350: my $n = qualify(*GLOB); 0 0.000000 0.000000 351: *GLOB = *{*$fd}; 0 0.000000 0.000000 352: $fd = $n; 0 0.000000 0.000000 353: } elsif ($fd =~ m#^\d+$#) { 0 0.000000 0.000000 354: # It's an FD number; prefix with "=". 0 0.000000 0.000000 355: $fd = "=$fd"; 0 0.000000 0.000000 356: } 0 0.000000 0.000000 357: 0 0.000000 0.000000 358: open($io, _open_mode_string($mode) . '&' 0 0.000000 0.000000 359: ? $io : undef; 0 0.000000 0.000000 360:} 0 0.000000 0.000000 361: 0 0.000000 0.000000 362:sub close { 0 0.000000 0.000000 363: @_ == 1 or croak 'usage: $io->close()'; 0 0.000000 0.000000 364: my($io) = @_; 0 0.000000 0.000000 365: 0 0.000000 0.000000 366: close($io); 0 0.000000 0.000000 367:} 0 0.000000 0.000000 368: 0 0.000000 0.000000 369:############################################# 0 0.000000 0.000000 370:## Normal I/O functions. 0 0.000000 0.000000 371:## 0 0.000000 0.000000 372: 0 0.000000 0.000000 373:# flock 0 0.000000 0.000000 374:# select 0 0.000000 0.000000 375: 0 0.000000 0.000000 376:sub opened { 0 0.000000 0.000000 377: @_ == 1 or croak 'usage: $io->opened()'; 0 0.000000 0.000000 378: defined fileno($_[0]); 0 0.000000 0.000000 379:} 0 0.000000 0.000000 380: 0 0.000000 0.000000 381:sub fileno { 0 0.000000 0.000000 382: @_ == 1 or croak 'usage: $io->fileno()'; 0 0.000000 0.000000 383: fileno($_[0]); 0 0.000000 0.000000 384:} 0 0.000000 0.000000 385: 0 0.000000 0.000000 386:sub getc { 0 0.000000 0.000000 387: @_ == 1 or croak 'usage: $io->getc()'; 0 0.000000 0.000000 388: getc($_[0]); 0 0.000000 0.000000 389:} 0 0.000000 0.000000 390: 0 0.000000 0.000000 391:sub eof { 0 0.000000 0.000000 392: @_ == 1 or croak 'usage: $io->eof()'; ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/I Page 186 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 393: eof($_[0]); 0 0.000000 0.000000 394:} 0 0.000000 0.000000 395: 0 0.000000 0.000000 396:sub print { 0 0.000000 0.000000 397: @_ or croak 'usage: $io->print(ARGS)'; 0 0.000000 0.000000 398: my $this = shift; 0 0.000000 0.000000 399: print $this @_; 0 0.000000 0.000000 400:} 0 0.000000 0.000000 401: 0 0.000000 0.000000 402:sub printf { 0 0.000000 0.000000 403: @_ >= 2 or croak 'usage: $io- 0 0.000000 0.000000 404: my $this = shift; 0 0.000000 0.000000 405: printf $this @_; 0 0.000000 0.000000 406:} 0 0.000000 0.000000 407: 0 0.000000 0.000000 408:sub getline { 0 0.000000 0.000000 409: @_ == 1 or croak 'usage: $io->getline()'; 0 0.000000 0.000000 410: my $this = shift; 0 0.000000 0.000000 411: return scalar <$this>; 0 0.000000 0.000000 412:} 0 0.000000 0.000000 413: 1 0.000006 0.000000 414:*gets = \&getline; # deprecated 0 0.000000 0.000000 415: 0 0.000000 0.000000 416:sub getlines { 0 0.000000 0.000000 417: @_ == 1 or croak 'usage: $io- 0 0.000000 0.000000 418: wantarray or 0 0.000000 0.000000 419: croak 'Can\'t call $io->getlines in a scalar 0 0.000000 0.000000 420: my $this = shift; 0 0.000000 0.000000 421: return <$this>; 0 0.000000 0.000000 422:} 0 0.000000 0.000000 423: 0 0.000000 0.000000 424:sub truncate { 0 0.000000 0.000000 425: @_ == 2 or croak 'usage: $io- 0 0.000000 0.000000 426: truncate($_[0], $_[1]); 0 0.000000 0.000000 427:} 0 0.000000 0.000000 428: 0 0.000000 0.000000 429:sub read { 0 0.000000 0.000000 430: @_ == 3 || @_ == 4 or croak 'usage: $io- 0 0.000000 0.000000 431: read($_[0], $_[1], $_[2], $_[3] || 0); 0 0.000000 0.000000 432:} 0 0.000000 0.000000 433: 0 0.000000 0.000000 434:sub sysread { 0 0.000000 0.000000 435: @_ == 3 || @_ == 4 or croak 'usage: $io- 0 0.000000 0.000000 436: sysread($_[0], $_[1], $_[2], $_[3] || 0); 0 0.000000 0.000000 437:} 0 0.000000 0.000000 438: 0 0.000000 0.000000 439:sub write { 0 0.000000 0.000000 440: @_ >= 2 && @_ <= 4 or croak 'usage: $io- 0 0.000000 0.000000 441: local($\) = ""; 0 0.000000 0.000000 442: $_[2] = length($_[1]) unless defined 0 0.000000 0.000000 443: print { $_[0] } substr($_[1], $_[3] || 0, 0 0.000000 0.000000 444:} 0 0.000000 0.000000 445: 355 0.000000 0.000000 446:sub syswrite { 355 0.001639 0.000000 447: @_ >= 2 && @_ <= 4 or croak 'usage: $io- 355 0.001253 0.000000 448: if (defined($_[2])) { ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/I Page 187 ================================================================= count wall tm cpu time line 355 0.010638 0.010000 449: syswrite($_[0], $_[1], $_[2], $_[3] || 0); 0 0.000000 0.000000 450: } else { 0 0.000000 0.000000 451: syswrite($_[0], $_[1]); 0 0.000000 0.000000 452: } 0 0.000000 0.000000 453:} 0 0.000000 0.000000 454: 0 0.000000 0.000000 455:sub stat { 0 0.000000 0.000000 456: @_ == 1 or croak 'usage: $io->stat()'; 0 0.000000 0.000000 457: stat($_[0]); 0 0.000000 0.000000 458:} 0 0.000000 0.000000 459: 0 0.000000 0.000000 460:############################################# 0 0.000000 0.000000 461:## State modification functions. 0 0.000000 0.000000 462:## 0 0.000000 0.000000 463: 387 0.000000 0.000000 464:sub autoflush { 387 0.002266 0.010000 465: my $old = new SelectSaver qualify($_[0], 387 0.001847 0.000000 466: my $prev = $|; 387 0.001935 0.000000 467: $| = @_ > 1 ? $_[1] : 1; 387 0.002181 0.000000 468: $prev; 0 0.000000 0.000000 469:} 0 0.000000 0.000000 470: 0 0.000000 0.000000 471:sub output_field_separator { 0 0.000000 0.000000 472: carp "output_field_separator is not 0 0.000000 0.000000 473: if ref($_[0]); 0 0.000000 0.000000 474: my $prev = $,; 0 0.000000 0.000000 475: $, = $_[1] if @_ > 1; 0 0.000000 0.000000 476: $prev; 0 0.000000 0.000000 477:} 0 0.000000 0.000000 478: 0 0.000000 0.000000 479:sub output_record_separator { 0 0.000000 0.000000 480: carp "output_record_separator is not 0 0.000000 0.000000 481: if ref($_[0]); 0 0.000000 0.000000 482: my $prev = $\; 0 0.000000 0.000000 483: $\ = $_[1] if @_ > 1; 0 0.000000 0.000000 484: $prev; 0 0.000000 0.000000 485:} 0 0.000000 0.000000 486: 0 0.000000 0.000000 487:sub input_record_separator { 0 0.000000 0.000000 488: carp "input_record_separator is not 0 0.000000 0.000000 489: if ref($_[0]); 0 0.000000 0.000000 490: my $prev = $/; 0 0.000000 0.000000 491: $/ = $_[1] if @_ > 1; 0 0.000000 0.000000 492: $prev; 0 0.000000 0.000000 493:} 0 0.000000 0.000000 494: 0 0.000000 0.000000 495:sub input_line_number { 0 0.000000 0.000000 496: local $.; 0 0.000000 0.000000 497: () = tell qualify($_[0], caller) if 0 0.000000 0.000000 498: my $prev = $.; 0 0.000000 0.000000 499: $. = $_[1] if @_ > 1; 0 0.000000 0.000000 500: $prev; 0 0.000000 0.000000 501:} 0 0.000000 0.000000 502: 0 0.000000 0.000000 503:sub format_page_number { 0 0.000000 0.000000 504: my $old; ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_64-linux-thread-multi/I Page 188 ================================================================= count wall tm cpu time line 0 0.000000 0.000000 505: $old = new SelectSaver qualify($_[0], 0 0.000000 0.000000 506: my $prev = $%; 0 0.000000 0.000000 507: $% = $_[1] if @_ > 1; 0 0.000000 0.000000 508: $prev; 0 0.000000 0.000000 509:} 0 0.000000 0.000000 510: 0 0.000000 0.000000 511:sub format_lines_per_page { 0 0.000000 0.000000 512: my $old; 0 0.000000 0.000000 513: $old = new SelectSaver qualify($_[0], 0 0.000000 0.000000 514: my $prev = $=; 0 0.000000 0.000000 515: $= = $_[1] if @_ > 1; 0 0.000000 0.000000 516: $prev; 0 0.000000 0.000000 517:} 0 0.000000 0.000000 518: 0 0.000000 0.000000 519:sub format_lines_left { 0 0.000000 0.000000 520: my $old; 0 0.000000 0.000000 521: $old = new SelectSaver qualify($_[0], 0 0.000000 0.000000 522: my $prev = $-; 0 0.000000 0.000000 523: $- = $_[1] if @_ > 1; 0 0.000000 0.000000 524: $prev; 0 0.000000 0.000000 525:} 0 0.000000 0.000000 526: 0 0.000000 0.000000 527:sub format_name { 0 0.000000 0.000000 528: my $old; 0 0.000000 0.000000 529: $old = new SelectSaver qualify($_[0], 0 0.000000 0.000000 530: my $prev = $~; 0 0.000000 0.000000 531: $~ = qualify($_[1], caller) if @_ > 1; 0 0.000000 0.000000 532: $prev; 0 0.000000 0.000000 533:} 0 0.000000 0.000000 534: 0 0.000000 0.000000 535:sub format_top_name { 0 0.000000 0.000000 536: my $old; 0 0.000000 0.000000 537: $old = new SelectSaver qualify($_[0], 0 0.000000 0.000000 538: my $prev = $^; 0 0.000000 0.000000 539: $^ = qualify($_[1], caller) if @_ > 1; 0 0.000000 0.000000 540: $prev; 0 0.000000 0.000000 541:} 0 0.000000 0.000000 542: 0 0.000000 0.000000 543:sub format_line_break_characters { 0 0.000000 0.000000 544: carp "format_line_break_characters is not 0 0.000000 0.000000 545: if ref($_[0]); 0 0.000000 0.000000 546: my $prev = $:; 0 0.000000 0.000000 547: $: = $_[1] if @_ > 1; 0 0.000000 0.000000 548: $prev; 0 0.000000 0.000000 549:} 0 0.000000 0.000000 550: 0 0.000000 0.000000 551:sub format_formfeed { 0 0.000000 0.000000 552: carp "format_formfeed is not supported on 0 0.000000 0.000000 553: if ref($_[0]); 0 0.000000 0.000000 554: my $prev = $^L; 0 0.000000 0.000000 555: $^L = $_[1] if @_ > 1; 0 0.000000 0.000000 556: $prev; 0 0.000000 0.000000 557:} 0 0.000000 0.000000 558: 0 0.000000 0.000000 559:sub formline { 0 0.000000 0.000000 560: my $io = shift; ================ SmallProf version 1.15 ================ Profile of /usr/lib64/perl5/5.8.5/x86_6