Profile of Data/Compare.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For xt/tapper-mcp-scheduler-with-db-longrun.t
Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:49 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Data/Compare.pm
Statements | Executed 27 statements in 1.50ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 2.78ms | 3.22ms | Data::Compare::::BEGIN@24Data::Compare::BEGIN@24
1 | 1 | 1 | 13µs | 16µs | Data::Compare::::BEGIN@9Data::Compare::BEGIN@9
1 | 1 | 1 | 10µs | 81µs | Data::Compare::::BEGIN@12Data::Compare::BEGIN@12
1 | 1 | 1 | 10µs | 26µs | Data::Compare::::BEGIN@13Data::Compare::BEGIN@13
1 | 1 | 1 | 8µs | 19µs | Data::Compare::::BEGIN@10Data::Compare::BEGIN@10
1 | 1 | 1 | 8µs | 39µs | Data::Compare::::BEGIN@14Data::Compare::BEGIN@14
1 | 1 | 1 | 7µs | 18µs | Data::Compare::::BEGIN@15Data::Compare::BEGIN@15
0 | 0 | 0 | 0s | 0s | Data::Compare::::CmpData::Compare::Cmp
0 | 0 | 0 | 0s | 0s | Data::Compare::::CompareData::Compare::Compare
0 | 0 | 0 | 0s | 0s | Data::Compare::::importData::Compare::import
0 | 0 | 0 | 0s | 0s | Data::Compare::::newData::Compare::new
0 | 0 | 0 | 0s | 0s | Data::Compare::::pluginsData::Compare::plugins
0 | 0 | 0 | 0s | 0s | Data::Compare::::plugins_printableData::Compare::plugins_printable
0 | 0 | 0 | 0s | 0s | Data::Compare::::register_pluginsData::Compare::register_plugins

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

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | # Data::Compare - compare perl data structures
2 |  |  |  |  | # Author: Fabien Tassin <fta@sofaraway.org>
3 |  |  |  |  | # updated by David Cantrell <david@cantrell.org.uk>
4 |  |  |  |  | # Copyright 1999-2001 Fabien Tassin <fta@sofaraway.org>
5 |  |  |  |  | # portions Copyright 2003 - 2010 David Cantrell
6 |  |  |  |  |
7 |  |  |  |  | package Data::Compare;
8 |  |  |  |  |
9 | 3 | 18µs | 2 | 18µs | # spent 16µs (13+3) within Data::Compare::BEGIN@9 which was called: # once (13µs+3µs) by DBIx::Class::ResultSet::BEGIN@11 at line 9 use strict; # spent 16µs making 1 call to Data::Compare::BEGIN@9 # spent 3µs making 1 call to strict::import
10 | 3 | 23µs | 2 | 30µs | # spent 19µs (8+11) within Data::Compare::BEGIN@10 which was called: # once (8µs+11µs) by DBIx::Class::ResultSet::BEGIN@11 at line 10 use warnings; # spent 19µs making 1 call to Data::Compare::BEGIN@10 # spent 11µs making 1 call to warnings::import
11 |  |  |  |  |
12 | 3 | 20µs | 2 | 153µs | # spent 81µs (10+71) within Data::Compare::BEGIN@12 which was called: # once (10µs+71µs) by DBIx::Class::ResultSet::BEGIN@11 at line 12 use vars qw(@ISA @EXPORT $VERSION $DEBUG %been_there); # spent 81µs making 1 call to Data::Compare::BEGIN@12 # spent 71µs making 1 call to vars::import
13 | 3 | 19µs | 2 | 42µs | # spent 26µs (10+16) within Data::Compare::BEGIN@13 which was called: # once (10µs+16µs) by DBIx::Class::ResultSet::BEGIN@11 at line 13 use Exporter; # spent 26µs making 1 call to Data::Compare::BEGIN@13 # spent 16µs making 1 call to Exporter::import
14 | 3 | 18µs | 2 | 71µs | # spent 39µs (8+32) within Data::Compare::BEGIN@14 which was called: # once (8µs+32µs) by DBIx::Class::ResultSet::BEGIN@11 at line 14 use Carp; # spent 39µs making 1 call to Data::Compare::BEGIN@14 # spent 32µs making 1 call to Exporter::import
15 | 3 | 52µs | 2 | 28µs | # spent 18µs (7+11) within Data::Compare::BEGIN@15 which was called: # once (7µs+11µs) by DBIx::Class::ResultSet::BEGIN@11 at line 15 use Scalar::Util; # spent 18µs making 1 call to Data::Compare::BEGIN@15 # spent 11µs making 1 call to Exporter::import
16 |  |  |  |  |
17 | 1 | 9µs |  |  | @ISA = qw(Exporter);
18 | 1 | 600ns |  |  | @EXPORT = qw(Compare);
19 | 1 | 400ns |  |  | $VERSION = 1.22;
20 | 1 | 700ns |  |  | $DEBUG = $ENV{PERL_DATA_COMPARE_DEBUG} || 0;
21 |  |  |  |  |
22 | 1 | 200ns |  |  | my %handler;
23 |  |  |  |  |
24 | 3 | 1.33ms | 2 | 3.27ms | # spent 3.22ms (2.78+442µs) within Data::Compare::BEGIN@24 which was called: # once (2.78ms+442µs) by DBIx::Class::ResultSet::BEGIN@11 at line 24 use Cwd; # spent 3.22ms making 1 call to Data::Compare::BEGIN@24 # spent 49µs making 1 call to Exporter::import
25 |  |  |  |  |
26 |  |  |  |  | sub import {
27 |  |  |  |  | if(eval { chdir(getcwd()) }) { # chdir(getcwd()) isn't taint-safe
28 |  |  |  |  | register_plugins();
29 |  |  |  |  | }
30 |  |  |  |  | __PACKAGE__->export_to_level(1, @EXPORT);
31 |  |  |  |  | }
32 |  |  |  |  |
33 |  |  |  |  | # finds and registers plugins
34 |  |  |  |  | sub register_plugins {
35 |  |  |  |  | eval 'use File::Find::Rule';
36 |  |  |  |  | foreach my $file (
37 |  |  |  |  | File::Find::Rule->file()->name('*.pm')->in(
38 |  |  |  |  | map { "$_/Data/Compare/Plugins" }
39 |  |  |  |  | grep { -d "$_/Data/Compare/Plugins" }
40 |  |  |  |  | @INC
41 |  |  |  |  | )
42 |  |  |  |  | ) {
43 |  |  |  |  | # all of this just to avoid loading the same plugin twice and
44 |  |  |  |  | # generating a pile of warnings. Grargh!
45 |  |  |  |  | $file =~ s!.*(Data/Compare/Plugins/.*)\.pm$!$1!;
46 |  |  |  |  | $file =~ s!/!::!g;
47 |  |  |  |  | # ignore badly named example from earlier version, oops
48 |  |  |  |  | next if($file eq 'Data::Compare::Plugins::Scalar-Properties');
49 |  |  |  |  | my $requires = eval "require $file";
50 |  |  |  |  | next if($requires eq '1'); # already loaded this plugin?
51 |  |  |  |  |
52 |  |  |  |  | # not an arrayref? bail
53 |  |  |  |  | if(ref($requires) ne 'ARRAY') {
54 |  |  |  |  | warn("$file isn't a valid Data::Compare plugin (didn't return arrayref)\n");
55 |  |  |  |  | return;
56 |  |  |  |  | }
57 |  |  |  |  | # coerce into arrayref of arrayrefs if necessary
58 |  |  |  |  | if(ref((@{$requires})[0]) ne 'ARRAY') { $requires = [$requires] }
59 |  |  |  |  |
60 |  |  |  |  | # register all the handlers
61 |  |  |  |  | foreach my $require (@{$requires}) {
62 |  |  |  |  | my($handler, $type1, $type2, $cruft) = reverse @{$require};
63 |  |  |  |  | $type2 = $type1 unless(defined($type2));
64 |  |  |  |  | ($type1, $type2) = sort($type1, $type2);
65 |  |  |  |  | if(!defined($type1) || ref($type1) ne '' || !defined($type2) || ref($type2) ne '') {
66 |  |  |  |  | warn("$file isn't a valid Data::Compare plugin (invalid type)\n");
67 |  |  |  |  | } elsif(defined($cruft)) {
68 |  |  |  |  | warn("$file isn't a valid Data::Compare plugin (extra data)\n");
69 |  |  |  |  | } elsif(ref($handler) ne 'CODE') {
70 |  |  |  |  | warn("$file isn't a valid Data::Compare plugin (no coderef)\n");
71 |  |  |  |  | } else {
72 |  |  |  |  | $handler{$type1}{$type2} = $handler;
73 |  |  |  |  | }
74 |  |  |  |  | }
75 |  |  |  |  | }
76 |  |  |  |  | }
77 |  |  |  |  |
78 |  |  |  |  | sub new {
79 |  |  |  |  | my $this = shift;
80 |  |  |  |  | my $class = ref($this) || $this;
81 |  |  |  |  | my $self = {};
82 |  |  |  |  | bless $self, $class;
83 |  |  |  |  | $self->{'x'} = shift;
84 |  |  |  |  | $self->{'y'} = shift;
85 |  |  |  |  | return $self;
86 |  |  |  |  | }
87 |  |  |  |  |
88 |  |  |  |  | sub Cmp {
89 |  |  |  |  | my $self = shift;
90 |  |  |  |  |
91 |  |  |  |  | croak "Usage: DataCompareObj->Cmp(x, y)" unless $#_ == 1 || $#_ == -1;
92 |  |  |  |  | my $x = shift || $self->{'x'};
93 |  |  |  |  | my $y = shift || $self->{'y'};
94 |  |  |  |  |
95 |  |  |  |  | return Compare($x, $y);
96 |  |  |  |  | }
97 |  |  |  |  |
98 |  |  |  |  | sub Compare {
99 |  |  |  |  | croak "Usage: Data::Compare::Compare(x, y, [opts])\n" unless $#_ == 1 || $#_ == 2;
100 |  |  |  |  |
101 |  |  |  |  | my $x = shift;
102 |  |  |  |  | my $y = shift;
103 |  |  |  |  | my $opts = shift || {};
104 |  |  |  |  | my($xparent, $xpos, $yparent, $ypos) = map {
105 |  |  |  |  | $opts->{$_} || ''
106 |  |  |  |  | } qw(xparent xpos yparent ypos);
107 |  |  |  |  |
108 |  |  |  |  | my $rval = '';
109 |  |  |  |  |
110 |  |  |  |  | if(!exists($opts->{recursion_detector})) {
111 |  |  |  |  | %been_there = ();
112 |  |  |  |  | $opts->{recursion_detector} = 0;
113 |  |  |  |  | }
114 |  |  |  |  | $opts->{recursion_detector}++;
115 |  |  |  |  |
116 |  |  |  |  | warn "Yaroo! deep recursion!\n" if($opts->{recursion_detector} == 99);
117 |  |  |  |  |
118 |  |  |  |  | if(
119 |  |  |  |  | (ref($x) && exists($been_there{"$x-$xpos-$xparent"}) && $been_there{"$x-$xpos-$xparent"} > 1) ||
120 |  |  |  |  | (ref($y) && exists($been_there{"$y-$ypos-$yparent"}) && $been_there{"$y-$ypos-$yparent"} > 1)
121 |  |  |  |  | ) {
122 |  |  |  |  | return 1; # we bail as soon as possible, so if we've *not* bailed and have got here, say we're OK and go to the next sub-structure
123 |  |  |  |  | } else {
124 |  |  |  |  | $been_there{"$x-$xpos-$xparent"}++ if(ref($x));
125 |  |  |  |  | $been_there{"$y-$ypos-$yparent"}++ if(ref($y));
126 |  |  |  |  |
127 |  |  |  |  | $opts->{ignore_hash_keys} = { map {
128 |  |  |  |  | ($_, 1)
129 |  |  |  |  | } @{$opts->{ignore_hash_keys}} } if(ref($opts->{ignore_hash_keys}) eq 'ARRAY');
130 |  |  |  |  |
131 |  |  |  |  | my $refx = ref $x;
132 |  |  |  |  | my $refy = ref $y;
133 |  |  |  |  |
134 |  |  |  |  | if(exists($handler{$refx}) && exists($handler{$refx}{$refy})) {
135 |  |  |  |  | $rval = &{$handler{$refx}{$refy}}($x, $y, $opts);
136 |  |  |  |  | } elsif(exists($handler{$refy}) && exists($handler{$refy}{$refx})) {
137 |  |  |  |  | $rval = &{$handler{$refy}{$refx}}($x, $y, $opts);
138 |  |  |  |  | }
139 |  |  |  |  |
140 |  |  |  |  | elsif(!$refx && !$refy) { # both are scalars
141 |  |  |  |  | if(defined $x && defined $y) { # both are defined
142 |  |  |  |  | $rval = $x eq $y;
143 |  |  |  |  | } else { $rval = !(defined $x || defined $y); }
144 |  |  |  |  | }
145 |  |  |  |  | elsif ($refx ne $refy) { # not the same type
146 |  |  |  |  | $rval = 0;
147 |  |  |  |  | }
148 |  |  |  |  | elsif ($x == $y) { # exactly the same reference
149 |  |  |  |  | $rval = 1;
150 |  |  |  |  | }
151 |  |  |  |  | elsif ($refx eq 'SCALAR' || $refx eq 'REF') {
152 |  |  |  |  | $rval = Compare(${$x}, ${$y}, $opts);
153 |  |  |  |  | }
154 |  |  |  |  | elsif ($refx eq 'ARRAY') {
155 |  |  |  |  | if ($#{$x} == $#{$y}) { # same length
156 |  |  |  |  | my $i = -1;
157 |  |  |  |  | $rval = 1;
158 |  |  |  |  | for (@$x) {
159 |  |  |  |  | $i++;
160 |  |  |  |  | $rval = 0 unless Compare($x->[$i], $y->[$i], { %{$opts}, xparent => $x, xpos => $i, yparent => $y, ypos => $i});
161 |  |  |  |  | }
162 |  |  |  |  | }
163 |  |  |  |  | else {
164 |  |  |  |  | $rval = 0;
165 |  |  |  |  | }
166 |  |  |  |  | }
167 |  |  |  |  | elsif ($refx eq 'HASH') {
168 |  |  |  |  | my @kx = grep { !$opts->{ignore_hash_keys}->{$_} } keys %$x;
169 |  |  |  |  | my @ky = grep { !$opts->{ignore_hash_keys}->{$_} } keys %$y; # heh, KY
170 |  |  |  |  | $rval = 1;
171 |  |  |  |  | $rval = 0 unless scalar @kx == scalar @ky;
172 |  |  |  |  |
173 |  |  |  |  | for (@kx) {
174 |  |  |  |  | next unless defined $x->{$_} || defined $y->{$_};
175 |  |  |  |  | $rval = 0 unless defined $y->{$_} && Compare($x->{$_}, $y->{$_}, { %{$opts}, xparent => $x, xpos => $_, yparent => $y, ypos => $_});
176 |  |  |  |  | }
177 |  |  |  |  | }
178 |  |  |  |  | elsif($refx eq 'Regexp') {
179 |  |  |  |  | $rval = Compare($x.'', $y.'', $opts);
180 |  |  |  |  | }
181 |  |  |  |  | elsif ($refx eq 'CODE') {
182 |  |  |  |  | $rval = 0;
183 |  |  |  |  | }
184 |  |  |  |  | elsif ($refx eq 'GLOB') {
185 |  |  |  |  | $rval = 0;
186 |  |  |  |  | }
187 |  |  |  |  | else { # a package name (object blessed)
188 |  |  |  |  | my ($type) = "$x" =~ m/^$refx=(\S+)\(/;
189 |  |  |  |  | if ($type eq 'HASH') {
190 |  |  |  |  | my %x = %$x;
191 |  |  |  |  | my %y = %$y;
192 |  |  |  |  | $rval = Compare(\%x, \%y, { %{$opts}, xparent => $xparent, xpos => $xpos, yparent => $yparent, ypos => $ypos});
193 |  |  |  |  | $been_there{\%x."-$xpos-$xparent"}--; # decrement count for temp structures
194 |  |  |  |  | $been_there{\%y."-$ypos-$yparent"}--;
195 |  |  |  |  | }
196 |  |  |  |  | elsif ($type eq 'ARRAY') {
197 |  |  |  |  | my @x = @$x;
198 |  |  |  |  | my @y = @$y;
199 |  |  |  |  | $rval = Compare(\@x, \@y, { %{$opts}, xparent => $xparent, xpos => $xpos, yparent => $yparent, ypos => $ypos});
200 |  |  |  |  | $been_there{\@x."-$xpos-$xparent"}--;
201 |  |  |  |  | $been_there{\@y."-$ypos-$yparent"}--;
202 |  |  |  |  | }
203 |  |  |  |  | elsif ($type eq 'SCALAR' || $type eq 'REF') {
204 |  |  |  |  | my $x = ${$x};
205 |  |  |  |  | my $y = ${$y};
206 |  |  |  |  | $rval = Compare($x, $y, $opts);
207 |  |  |  |  | # $been_there{\$x}--;
208 |  |  |  |  | # $been_there{\$y}--;
209 |  |  |  |  | }
210 |  |  |  |  | elsif ($type eq 'GLOB') {
211 |  |  |  |  | $rval = 0;
212 |  |  |  |  | }
213 |  |  |  |  | elsif ($type eq 'CODE') {
214 |  |  |  |  | $rval = 0;
215 |  |  |  |  | }
216 |  |  |  |  | else {
217 |  |  |  |  | croak "Can't handle $type type.";
218 |  |  |  |  | $rval = 0;
219 |  |  |  |  | }
220 |  |  |  |  | }
221 |  |  |  |  | }
222 |  |  |  |  | $opts->{recursion_detector}--;
223 |  |  |  |  | return $rval;
224 |  |  |  |  | }
225 |  |  |  |  |
226 |  |  |  |  | sub plugins {
227 |  |  |  |  | return { map { (($_ eq '') ? '[scalar]' : $_, [map { $_ eq '' ? '[scalar]' : $_ } keys %{$handler{$_}}]) } keys %handler };
228 |  |  |  |  | }
229 |  |  |  |  |
230 |  |  |  |  | sub plugins_printable {
231 |  |  |  |  | my $r = "The following comparisons are available through plugins\n\n";
232 |  |  |  |  | foreach my $key (sort keys %handler) {
233 |  |  |  |  | foreach(sort keys %{$handler{$key}}) {
234 |  |  |  |  | $r .= join(":\t", map { $_ eq '' ? '[scalar]' : $_ } ($key, $_))."\n";
235 |  |  |  |  | }
236 |  |  |  |  | }
237 |  |  |  |  | return $r;
238 |  |  |  |  | }
239 |  |  |  |  |
240 | 1 | 6µs |  |  | 1;
241 |  |  |  |  |
242 |  |  |  |  | =head1 NAME
243 |  |  |  |  |
244 |  |  |  |  | Data::Compare - compare perl data structures
245 |  |  |  |  |
246 |  |  |  |  | =head1 SYNOPSIS
247 |  |  |  |  |
248 |  |  |  |  | use Data::Compare;
249 |  |  |  |  |
250 |  |  |  |  | my $h1 = { 'foo' => [ 'bar', 'baz' ], 'FOO' => [ 'one', 'two' ] };
251 |  |  |  |  | my $h2 = { 'foo' => [ 'bar', 'barf' ], 'FOO' => [ 'one', 'two' ] };
252 |  |  |  |  | my @a1 = ('one', 'two');
253 |  |  |  |  | my @a2 = ('bar', 'baz');
254 |  |  |  |  | my %v = ( 'FOO', \@a1, 'foo', \@a2 );
255 |  |  |  |  |
256 |  |  |  |  | # simple procedural interface
257 |  |  |  |  | print 'structures of $h1 and \%v are ',
258 |  |  |  |  | Compare($h1, \%v) ? "" : "not ", "identical.\n";
259 |  |  |  |  |
260 |  |  |  |  | print 'structures of $h1 and $h2 are ',
261 |  |  |  |  | Compare($h1, $h2, { ignore_hash_keys => [qw(foo)] }) ? '' : 'not ',
262 |  |  |  |  | "close enough to identical.\n";
263 |  |  |  |  |
264 |  |  |  |  | # OO usage
265 |  |  |  |  | my $c = new Data::Compare($h1, \%v);
266 |  |  |  |  | print 'structures of $h1 and \%v are ',
267 |  |  |  |  | $c->Cmp ? "" : "not ", "identical.\n";
268 |  |  |  |  | # or
269 |  |  |  |  | my $c = new Data::Compare;
270 |  |  |  |  | print 'structures of $h and \%v are ',
271 |  |  |  |  | $c->Cmp($h1, \%v) ? "" : "not ", "identical.\n";
272 |  |  |  |  |
273 |  |  |  |  | =head1 DESCRIPTION
274 |  |  |  |  |
275 |  |  |  |  | Compare two perl data structures recursively. Returns 0 if the
276 |  |  |  |  | structures differ, else returns 1.
277 |  |  |  |  |
278 |  |  |  |  | A few data types are treated as special cases:
279 |  |  |  |  |
280 |  |  |  |  | =over 4
281 |  |  |  |  |
282 |  |  |  |  | =item Scalar::Properties objects
283 |  |  |  |  |
284 |  |  |  |  | This has been moved into a plugin, although functionality remains the
285 |  |  |  |  | same as with the previous version. Full documentation is in
286 |  |  |  |  | L<Data::Compare::Plugins::Scalar::Properties>.
287 |  |  |  |  |
288 |  |  |  |  | =item Compiled regular expressions, eg qr/foo/
289 |  |  |  |  |
290 |  |  |  |  | These are stringified before comparison, so the following will match:
291 |  |  |  |  |
292 |  |  |  |  | $r = qr/abc/i;
293 |  |  |  |  | $s = qr/abc/i;
294 |  |  |  |  | Compare($r, $s);
295 |  |  |  |  |
296 |  |  |  |  | and the following won't, despite them matching *exactly* the same text:
297 |  |  |  |  |
298 |  |  |  |  | $r = qr/abc/i;
299 |  |  |  |  | $s = qr/[aA][bB][cC]/;
300 |  |  |  |  | Compare($r, $s);
301 |  |  |  |  |
302 |  |  |  |  | Sorry, that's the best we can do.
303 |  |  |  |  |
304 |  |  |  |  | =item CODE and GLOB references
305 |  |  |  |  |
306 |  |  |  |  | These are assumed not to match unless the references are identical - ie,
307 |  |  |  |  | both are references to the same thing.
308 |  |  |  |  |
309 |  |  |  |  | =back
310 |  |  |  |  |
311 |  |  |  |  | You may also customise how we compare structures by supplying options in
312 |  |  |  |  | a hashref as a third parameter to the C<Compare()> function. This is not
313 |  |  |  |  | yet available through the OO-ish interface. These options will be in
314 |  |  |  |  | force for the *whole* of your comparison, so will apply to structures
315 |  |  |  |  | that are lurking deep down in your data as well as at the top level, so
316 |  |  |  |  | beware!
317 |  |  |  |  |
318 |  |  |  |  | =over 4
319 |  |  |  |  |
320 |  |  |  |  | =item ignore_hash_keys
321 |  |  |  |  |
322 |  |  |  |  | an arrayref of strings. When comparing two hashes, any keys mentioned in
323 |  |  |  |  | this list will be ignored.
324 |  |  |  |  |
325 |  |  |  |  | =back
326 |  |  |  |  |
327 |  |  |  |  | =head1 CIRCULAR STRUCTURES
328 |  |  |  |  |
329 |  |  |  |  | Comparing a circular structure to itself returns true:
330 |  |  |  |  |
331 |  |  |  |  | $x = \$y;
332 |  |  |  |  | $y = \$x;
333 |  |  |  |  | Compare([$x, $y], [$x, $y]);
334 |  |  |  |  |
335 |  |  |  |  | And on a sort-of-related note, if you try to compare insanely deeply nested
336 |  |  |  |  | structures, the module will spit a warning. For this to affect you, you need to go
337 |  |  |  |  | around a hundred levels deep though, and if you do that you have bigger
338 |  |  |  |  | problems which I can't help you with ;-)
339 |  |  |  |  |
340 |  |  |  |  | =head1 PLUGINS
341 |  |  |  |  |
342 |  |  |  |  | The module takes plug-ins so you can provide specialised routines for
343 |  |  |  |  | comparing your own objects and data-types. For details see
344 |  |  |  |  | L<Data::Compare::Plugins>.
345 |  |  |  |  |
346 |  |  |  |  | Plugins are *not* available when running in "taint" mode. You may
347 |  |  |  |  | also make it not load plugins by providing an empty list as the
348 |  |  |  |  | argument to import() - ie, by doing this:
349 |  |  |  |  |
350 |  |  |  |  | use Data::Compare ();
351 |  |  |  |  |
352 |  |  |  |  | A couple of functions are provided to examine what goodies have been
353 |  |  |  |  | made available through plugins:
354 |  |  |  |  |
355 |  |  |  |  | =over 4
356 |  |  |  |  |
357 |  |  |  |  | =item plugins
358 |  |  |  |  |
359 |  |  |  |  | Returns a structure (a hash ref) describing all the comparisons made
360 |  |  |  |  | available through plugins.
361 |  |  |  |  | This function is *not* exported, so should be called as Data::Compare::plugins().
362 |  |  |  |  | It takes no parameters.
363 |  |  |  |  |
364 |  |  |  |  | =item plugins_printable
365 |  |  |  |  |
366 |  |  |  |  | Returns formatted text
367 |  |  |  |  |
368 |  |  |  |  | =back
369 |  |  |  |  |
370 |  |  |  |  | =head1 EXPORTS
371 |  |  |  |  |
372 |  |  |  |  | For historical reasons, the Compare() function is exported. If you
373 |  |  |  |  | don't want this, then pass an empty list to import() as explained
374 |  |  |  |  | under PLUGINS. If you want no export but do want plugins, then pass
375 |  |  |  |  | the empty list, and then call the register_plugins class method:
376 |  |  |  |  |
377 |  |  |  |  | use Data::Compare ();
378 |  |  |  |  | Data::Compare->register_plugins;
379 |  |  |  |  |
380 |  |  |  |  | or you could call it as a function if that floats your boat.
381 |  |  |  |  |
382 |  |  |  |  | =head1 CODE REPOSITORY
383 |  |  |  |  |
384 |  |  |  |  | L<http://www.cantrell.org.uk/cgit/cgit.cgi/perlmodules/>
385 |  |  |  |  |
386 |  |  |  |  | =head1 BUGS
387 |  |  |  |  |
388 |  |  |  |  | Plugin support is not quite finished (see the TODO file for details) but
389 |  |  |  |  | is usable. The missing bits are bells and whistles rather than core
390 |  |  |  |  | functionality.
391 |  |  |  |  |
392 |  |  |  |  | Plugins are unavailable if you can't change to the current directory. This
393 |  |  |  |  | might happen if you started your process as a priveleged user and then
394 |  |  |  |  | dropped priveleges. This is due to how we check for Taintedness. If this
395 |  |  |  |  | affects you, please supply a portable patch.
396 |  |  |  |  |
397 |  |  |  |  | Please report any other bugs either by email to David Cantrell (see below
398 |  |  |  |  | for address) or using rt.cpan.org:
399 |  |  |  |  |
400 |  |  |  |  | L<https://rt.cpan.org/Ticket/Create.html?Queue=Data-Compare>
401 |  |  |  |  |
402 |  |  |  |  | =head1 AUTHOR
403 |  |  |  |  |
404 |  |  |  |  | Fabien Tassin E<lt>fta@sofaraway.orgE<gt>
405 |  |  |  |  |
406 |  |  |  |  | Portions by David Cantrell E<lt>david@cantrell.org.ukE<gt>
407 |  |  |  |  |
408 |  |  |  |  | =head1 COPYRIGHT and LICENCE
409 |  |  |  |  |
410 |  |  |  |  | Copyright (c) 1999-2001 Fabien Tassin. All rights reserved.
411 |  |  |  |  | This program is free software; you can redistribute it and/or
412 |  |  |  |  | modify it under the same terms as Perl itself.
413 |  |  |  |  |
414 |  |  |  |  | Some parts copyright 2003 - 2010 David Cantrell.
415 |  |  |  |  |
416 |  |  |  |  | Seeing that Fabien seems to have disappeared, David Cantrell has become
417 |  |  |  |  | a co-maintainer so he can apply needed patches. The licence, of course,
418 |  |  |  |  | remains the same. As the "perl licence" is "Artistic or GPL, your choice",
419 |  |  |  |  | you can find them as the files ARTISTIC.txt and GPL2.txt in the
420 |  |  |  |  | distribution.
421 |  |  |  |  |
422 |  |  |  |  | =head1 SEE ALSO
423 |  |  |  |  |
424 |  |  |  |  | perl(1), perlref(1)
425 |  |  |  |  |
426 |  |  |  |  | =cut