Filename | /usr/share/perl/5.14/File/Compare.pm |
Statements | Executed 47 statements in 841µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 74µs | 158µs | compare | File::Compare::
2 | 2 | 1 | 32µs | 32µs | CORE:open (opcode) | File::Compare::
1 | 1 | 1 | 19µs | 19µs | BEGIN@3 | File::Compare::
2 | 2 | 1 | 19µs | 19µs | CORE:close (opcode) | File::Compare::
2 | 2 | 1 | 16µs | 16µs | CORE:binmode (opcode) | File::Compare::
4 | 3 | 1 | 16µs | 16µs | CORE:read (opcode) | File::Compare::
1 | 1 | 1 | 7µs | 10µs | BEGIN@4 | File::Compare::
1 | 1 | 1 | 6µs | 12µs | BEGIN@5 | File::Compare::
2 | 2 | 1 | 2µs | 2µs | CORE:ftsize (opcode) | File::Compare::
0 | 0 | 0 | 0s | 0s | compare_text | File::Compare::
0 | 0 | 0 | 0s | 0s | croak | File::Compare::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package File::Compare; | ||||
2 | |||||
3 | 2 | 43µs | 1 | 19µs | # spent 19µs within File::Compare::BEGIN@3 which was called:
# once (19µs+0s) by DateTime::TimeZone::Local::Unix::_FindMatchingZoneinfoFile at line 3 # spent 19µs making 1 call to File::Compare::BEGIN@3 |
4 | 2 | 21µs | 2 | 13µs | # spent 10µs (7+3) within File::Compare::BEGIN@4 which was called:
# once (7µs+3µs) by DateTime::TimeZone::Local::Unix::_FindMatchingZoneinfoFile at line 4 # spent 10µs making 1 call to File::Compare::BEGIN@4
# spent 3µs making 1 call to strict::import |
5 | 2 | 602µs | 2 | 17µs | # spent 12µs (6+5) within File::Compare::BEGIN@5 which was called:
# once (6µs+5µs) by DateTime::TimeZone::Local::Unix::_FindMatchingZoneinfoFile at line 5 # spent 12µs making 1 call to File::Compare::BEGIN@5
# spent 5µs making 1 call to warnings::import |
6 | 1 | 500ns | our($VERSION, @ISA, @EXPORT, @EXPORT_OK, $Too_Big); | ||
7 | |||||
8 | 1 | 500ns | require Exporter; | ||
9 | |||||
10 | 1 | 600ns | $VERSION = '1.1006'; | ||
11 | 1 | 5µs | @ISA = qw(Exporter); | ||
12 | 1 | 400ns | @EXPORT = qw(compare); | ||
13 | 1 | 400ns | @EXPORT_OK = qw(cmp compare_text); | ||
14 | |||||
15 | 1 | 200ns | $Too_Big = 1024 * 1024 * 2; | ||
16 | |||||
17 | sub croak { | ||||
18 | require Carp; | ||||
19 | goto &Carp::croak; | ||||
20 | } | ||||
21 | |||||
22 | # spent 158µs (74+84) within File::Compare::compare which was called:
# once (74µs+84µs) by DateTime::TimeZone::Local::Unix::__ANON__[/usr/local/share/perl/5.14.2/DateTime/TimeZone/Local/Unix.pm:116] at line 98 of DateTime/TimeZone/Local/Unix.pm | ||||
23 | 32 | 160µs | croak("Usage: compare( file1, file2 [, buffersize]) ") | ||
24 | unless(@_ == 2 || @_ == 3); | ||||
25 | |||||
26 | my ($from,$to,$size) = @_; | ||||
27 | my $text_mode = defined($size) && (ref($size) eq 'CODE' || $size < 0); | ||||
28 | |||||
29 | my ($fromsize,$closefrom,$closeto); | ||||
30 | local (*FROM, *TO); | ||||
31 | |||||
32 | croak("from undefined") unless (defined $from); | ||||
33 | croak("to undefined") unless (defined $to); | ||||
34 | |||||
35 | if (ref($from) && | ||||
36 | (UNIVERSAL::isa($from,'GLOB') || UNIVERSAL::isa($from,'IO::Handle'))) { | ||||
37 | *FROM = *$from; | ||||
38 | } elsif (ref(\$from) eq 'GLOB') { | ||||
39 | *FROM = $from; | ||||
40 | } else { | ||||
41 | 1 | 25µs | open(FROM,"<",$from) or goto fail_open1; # spent 25µs making 1 call to File::Compare::CORE:open | ||
42 | unless ($text_mode) { | ||||
43 | 1 | 15µs | binmode FROM; # spent 15µs making 1 call to File::Compare::CORE:binmode | ||
44 | 1 | 1µs | $fromsize = -s FROM; # spent 1µs making 1 call to File::Compare::CORE:ftsize | ||
45 | } | ||||
46 | $closefrom = 1; | ||||
47 | } | ||||
48 | |||||
49 | if (ref($to) && | ||||
50 | (UNIVERSAL::isa($to,'GLOB') || UNIVERSAL::isa($to,'IO::Handle'))) { | ||||
51 | *TO = *$to; | ||||
52 | } elsif (ref(\$to) eq 'GLOB') { | ||||
53 | *TO = $to; | ||||
54 | } else { | ||||
55 | 1 | 7µs | open(TO,"<",$to) or goto fail_open2; # spent 7µs making 1 call to File::Compare::CORE:open | ||
56 | 1 | 600ns | binmode TO unless $text_mode; # spent 600ns making 1 call to File::Compare::CORE:binmode | ||
57 | $closeto = 1; | ||||
58 | } | ||||
59 | |||||
60 | if (!$text_mode && $closefrom && $closeto) { | ||||
61 | # If both are opened files we know they differ if their size differ | ||||
62 | 1 | 700ns | goto fail_inner if $fromsize != -s TO; # spent 700ns making 1 call to File::Compare::CORE:ftsize | ||
63 | } | ||||
64 | |||||
65 | if ($text_mode) { | ||||
66 | local $/ = "\n"; | ||||
67 | my ($fline,$tline); | ||||
68 | while (defined($fline = <FROM>)) { | ||||
69 | goto fail_inner unless defined($tline = <TO>); | ||||
70 | if (ref $size) { | ||||
71 | # $size contains ref to comparison function | ||||
72 | goto fail_inner if &$size($fline, $tline); | ||||
73 | } else { | ||||
74 | goto fail_inner if $fline ne $tline; | ||||
75 | } | ||||
76 | } | ||||
77 | goto fail_inner if defined($tline = <TO>); | ||||
78 | } | ||||
79 | else { | ||||
80 | unless (defined($size) && $size > 0) { | ||||
81 | $size = $fromsize || -s TO || 0; | ||||
82 | $size = 1024 if $size < 512; | ||||
83 | $size = $Too_Big if $size > $Too_Big; | ||||
84 | } | ||||
85 | |||||
86 | my ($fr,$tr,$fbuf,$tbuf); | ||||
87 | $fbuf = $tbuf = ''; | ||||
88 | 1 | 9µs | while(defined($fr = read(FROM,$fbuf,$size)) && $fr > 0) { # spent 9µs making 1 call to File::Compare::CORE:read | ||
89 | 2 | 6µs | unless (defined($tr = read(TO,$tbuf,$fr)) && $tbuf eq $fbuf) { # spent 6µs making 2 calls to File::Compare::CORE:read, avg 3µs/call | ||
90 | goto fail_inner; | ||||
91 | } | ||||
92 | } | ||||
93 | 1 | 1µs | goto fail_inner if defined($tr = read(TO,$tbuf,$size)) && $tr > 0; # spent 1µs making 1 call to File::Compare::CORE:read | ||
94 | } | ||||
95 | |||||
96 | 1 | 18µs | close(TO) || goto fail_open2 if $closeto; # spent 18µs making 1 call to File::Compare::CORE:close | ||
97 | 1 | 1µs | close(FROM) || goto fail_open1 if $closefrom; # spent 1µs making 1 call to File::Compare::CORE:close | ||
98 | |||||
99 | return 0; | ||||
100 | |||||
101 | # All of these contortions try to preserve error messages... | ||||
102 | fail_inner: | ||||
103 | close(TO) || goto fail_open2 if $closeto; | ||||
104 | close(FROM) || goto fail_open1 if $closefrom; | ||||
105 | |||||
106 | return 1; | ||||
107 | |||||
108 | fail_open2: | ||||
109 | if ($closefrom) { | ||||
110 | my $status = $!; | ||||
111 | $! = 0; | ||||
112 | close FROM; | ||||
113 | $! = $status unless $!; | ||||
114 | } | ||||
115 | fail_open1: | ||||
116 | return -1; | ||||
117 | } | ||||
118 | |||||
119 | sub cmp; | ||||
120 | 1 | 2µs | *cmp = \&compare; | ||
121 | |||||
122 | sub compare_text { | ||||
123 | my ($from,$to,$cmp) = @_; | ||||
124 | croak("Usage: compare_text( file1, file2 [, cmp-function])") | ||||
125 | unless @_ == 2 || @_ == 3; | ||||
126 | croak("Third arg to compare_text() function must be a code reference") | ||||
127 | if @_ == 3 && ref($cmp) ne 'CODE'; | ||||
128 | |||||
129 | # Using a negative buffer size puts compare into text_mode too | ||||
130 | $cmp = -1 unless defined $cmp; | ||||
131 | compare($from, $to, $cmp); | ||||
132 | } | ||||
133 | |||||
134 | 1 | 6µs | 1; | ||
135 | |||||
136 | __END__ | ||||
sub File::Compare::CORE:binmode; # opcode | |||||
sub File::Compare::CORE:close; # opcode | |||||
sub File::Compare::CORE:ftsize; # opcode | |||||
sub File::Compare::CORE:open; # opcode | |||||
sub File::Compare::CORE:read; # opcode |