Profile of Tie/Array.pm

Filename	/Users/ether/perl5/perlbrew/perls/36.0/lib/5.36.0/Tie/Array.pm
Statements	Executed 9 statements in 705µs

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	31µs	31µs	Tie::Array::::BEGIN@3 Tie::Array::BEGIN@3
1	1	1	8µs	11µs	Tie::Array::::BEGIN@4 Tie::Array::BEGIN@4
1	1	1	6µs	36µs	Tie::Array::::BEGIN@5 Tie::Array::BEGIN@5
0	0	0	0s	0s	Tie::Array::::CLEAR Tie::Array::CLEAR
0	0	0	0s	0s	Tie::Array::::DELETE Tie::Array::DELETE
0	0	0	0s	0s	Tie::Array::::DESTROY Tie::Array::DESTROY
0	0	0	0s	0s	Tie::Array::::EXISTS Tie::Array::EXISTS
0	0	0	0s	0s	Tie::Array::::EXTEND Tie::Array::EXTEND
0	0	0	0s	0s	Tie::Array::::POP Tie::Array::POP
0	0	0	0s	0s	Tie::Array::::PUSH Tie::Array::PUSH
0	0	0	0s	0s	Tie::Array::::SHIFT Tie::Array::SHIFT
0	0	0	0s	0s	Tie::Array::::SPLICE Tie::Array::SPLICE
0	0	0	0s	0s	Tie::Array::::UNSHIFT Tie::Array::UNSHIFT
0	0	0	0s	0s	Tie::StdArray::::CLEARTie::StdArray::CLEAR
0	0	0	0s	0s	Tie::StdArray::::DELETETie::StdArray::DELETE
0	0	0	0s	0s	Tie::StdArray::::EXISTSTie::StdArray::EXISTS
0	0	0	0s	0s	Tie::StdArray::::FETCHTie::StdArray::FETCH
0	0	0	0s	0s	Tie::StdArray::::FETCHSIZETie::StdArray::FETCHSIZE
0	0	0	0s	0s	Tie::StdArray::::POPTie::StdArray::POP
0	0	0	0s	0s	Tie::StdArray::::PUSHTie::StdArray::PUSH
0	0	0	0s	0s	Tie::StdArray::::SHIFTTie::StdArray::SHIFT
0	0	0	0s	0s	Tie::StdArray::::SPLICETie::StdArray::SPLICE
0	0	0	0s	0s	Tie::StdArray::::STORETie::StdArray::STORE
0	0	0	0s	0s	Tie::StdArray::::STORESIZETie::StdArray::STORESIZE
0	0	0	0s	0s	Tie::StdArray::::TIEARRAYTie::StdArray::TIEARRAY
0	0	0	0s	0s	Tie::StdArray::::UNSHIFTTie::StdArray::UNSHIFT

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package Tie::Array;
2
3	2	39µs	1	31µs	# spent 31µs within Tie::Array::BEGIN@3 which was called: # once (31µs+0s) by YAML::PP::Preserve::Array::BEGIN@300 at line 3 use 5.006_001; # spent 31µs making 1 call to Tie::Array::BEGIN@3
4	2	25µs	2	14µs	# spent 11µs (8+3) within Tie::Array::BEGIN@4 which was called: # once (8µs+3µs) by YAML::PP::Preserve::Array::BEGIN@300 at line 4 use strict; # spent 11µs making 1 call to Tie::Array::BEGIN@4 # spent 3µs making 1 call to strict::import
5	2	629µs	2	66µs	# spent 36µs (6+30) within Tie::Array::BEGIN@5 which was called: # once (6µs+30µs) by YAML::PP::Preserve::Array::BEGIN@300 at line 5 use Carp; # spent 36µs making 1 call to Tie::Array::BEGIN@5 # spent 30µs making 1 call to Exporter::import
6	1	0s			our $VERSION = '1.07';
7
8					# Pod documentation after __END__ below.
9
10					sub DESTROY { }
11					sub EXTEND { }
12					sub UNSHIFT { scalar shift->SPLICE(0,0,@_) }
13					sub SHIFT { shift->SPLICE(0,1) }
14					sub CLEAR { shift->STORESIZE(0) }
15
16					sub PUSH
17					{
18					my $obj = shift;
19					my $i = $obj->FETCHSIZE;
20					$obj->STORE($i++, shift) while (@_);
21					}
22
23					sub POP
24					{
25					my $obj = shift;
26					my $newsize = $obj->FETCHSIZE - 1;
27					my $val;
28					if ($newsize >= 0)
29					{
30					$val = $obj->FETCH($newsize);
31					$obj->STORESIZE($newsize);
32					}
33					$val;
34					}
35
36					sub SPLICE {
37					my $obj = shift;
38					my $sz = $obj->FETCHSIZE;
39					my $off = (@_) ? shift : 0;
40					$off += $sz if ($off < 0);
41					my $len = (@_) ? shift : $sz - $off;
42					$len += $sz - $off if $len < 0;
43					my @result;
44					for (my $i = 0; $i < $len; $i++) {
45					push(@result,$obj->FETCH($off+$i));
46					}
47					$off = $sz if $off > $sz;
48					$len -= $off + $len - $sz if $off + $len > $sz;
49					if (@_ > $len) {
50					# Move items up to make room
51					my $d = @_ - $len;
52					my $e = $off+$len;
53					$obj->EXTEND($sz+$d);
54					for (my $i=$sz-1; $i >= $e; $i--) {
55					my $val = $obj->FETCH($i);
56					$obj->STORE($i+$d,$val);
57					}
58					}
59					elsif (@_ < $len) {
60					# Move items down to close the gap
61					my $d = $len - @_;
62					my $e = $off+$len;
63					for (my $i=$off+$len; $i < $sz; $i++) {
64					my $val = $obj->FETCH($i);
65					$obj->STORE($i-$d,$val);
66					}
67					$obj->STORESIZE($sz-$d);
68					}
69					for (my $i=0; $i < @_; $i++) {
70					$obj->STORE($off+$i,$_[$i]);
71					}
72					return wantarray ? @result : pop @result;
73					}
74
75					sub EXISTS {
76					my $pkg = ref $_[0];
77					croak "$pkg doesn't define an EXISTS method";
78					}
79
80					sub DELETE {
81					my $pkg = ref $_[0];
82					croak "$pkg doesn't define a DELETE method";
83					}
84
85					package Tie::StdArray;
86	1	8µs			our @ISA = 'Tie::Array';
87
88					sub TIEARRAY { bless [], $_[0] }
89					sub FETCHSIZE { scalar @{$_[0]} }
90					sub STORESIZE { $#{$_[0]} = $_[1]-1 }
91					sub STORE { $_[0]->[$_[1]] = $_[2] }
92					sub FETCH { $_[0]->[$_[1]] }
93					sub CLEAR { @{$_[0]} = () }
94					sub POP { pop(@{$_[0]}) }
95					sub PUSH { my $o = shift; push(@$o,@_) }
96					sub SHIFT { shift(@{$_[0]}) }
97					sub UNSHIFT { my $o = shift; unshift(@$o,@_) }
98					sub EXISTS { exists $_[0]->[$_[1]] }
99					sub DELETE { delete $_[0]->[$_[1]] }
100
101					sub SPLICE
102					{
103					my $ob = shift;
104					my $sz = $ob->FETCHSIZE;
105					my $off = @_ ? shift : 0;
106					$off += $sz if $off < 0;
107					my $len = @_ ? shift : $sz-$off;
108					return splice(@$ob,$off,$len,@_);
109					}
110
111	1	4µs			1;
112
113					__END__