summaryrefslogtreecommitdiff
path: root/lib/Class/MakeMethods/Utility/Ref.pm
diff options
context:
space:
mode:
authorAndreas Brachold <vdr07@deltab.de>2007-11-10 17:53:53 +0000
committerAndreas Brachold <vdr07@deltab.de>2007-11-10 17:53:53 +0000
commitcfdd733c17cfa4f1a43b827a656e9e53cc2524ac (patch)
treeb6f659b1281f77628b36768f0888f67b65f9ca48 /lib/Class/MakeMethods/Utility/Ref.pm
parent9c6c30350161efd74faa3c3705096aecb71c0e81 (diff)
downloadxxv-cfdd733c17cfa4f1a43b827a656e9e53cc2524ac.tar.gz
xxv-cfdd733c17cfa4f1a43b827a656e9e53cc2524ac.tar.bz2
* Remove unsed packages
* Reorder exit routines
Diffstat (limited to 'lib/Class/MakeMethods/Utility/Ref.pm')
-rw-r--r--lib/Class/MakeMethods/Utility/Ref.pm171
1 files changed, 0 insertions, 171 deletions
diff --git a/lib/Class/MakeMethods/Utility/Ref.pm b/lib/Class/MakeMethods/Utility/Ref.pm
deleted file mode 100644
index 9c356f4..0000000
--- a/lib/Class/MakeMethods/Utility/Ref.pm
+++ /dev/null
@@ -1,171 +0,0 @@
-=head1 NAME
-
-Class::MakeMethods::Utility::Ref - Deep copying and comparison
-
-=head1 SYNOPSIS
-
- use Class::MakeMethods::Utility::Ref qw( ref_clone ref_compare );
-
- $deep_copy = ref_clone( $original );
- $positive_zero_or_negative = ref_compare( $item_a, $item_b );
-
-=head1 DESCRIPTION
-
-This module provides utility functions to copy and compare arbitrary references, including full traversal of nested data structures.
-
-=cut
-
-########################################################################
-
-package Class::MakeMethods::Utility::Ref;
-
-$VERSION = 1.000;
-
-@EXPORT_OK = qw( ref_clone ref_compare );
-sub import { require Exporter and goto &Exporter::import } # lazy Exporter
-
-use strict;
-
-######################################################################
-
-=head2 REFERENCE
-
-The following functions are provided:
-
-=head2 ref_clone()
-
-Make a recursive copy of a reference.
-
-=cut
-
-use vars qw( %CopiedItems );
-
-# $deep_copy = ref_clone( $value_or_ref );
-sub ref_clone {
- local %CopiedItems = ();
- _clone( @_ );
-}
-
-# $copy = _clone( $value_or_ref );
-sub _clone {
- my $source = shift;
-
- my $ref_type = ref $source;
- return $source if (! $ref_type);
-
- return $CopiedItems{ $source } if ( exists $CopiedItems{ $source } );
-
- my $class_name;
- if ( "$source" =~ /^\Q$ref_type\E\=([A-Z]+)\(0x[0-9a-f]+\)$/ ) {
- $class_name = $ref_type;
- $ref_type = $1;
- }
-
- my $copy;
- if ($ref_type eq 'SCALAR') {
- $copy = \( $$source );
- } elsif ($ref_type eq 'REF') {
- $copy = \( _clone ($$source) );
- } elsif ($ref_type eq 'HASH') {
- $copy = { map { _clone ($_) } %$source };
- } elsif ($ref_type eq 'ARRAY') {
- $copy = [ map { _clone ($_) } @$source ];
- } else {
- $copy = $source;
- }
-
- bless $copy, $class_name if $class_name;
-
- $CopiedItems{ $source } = $copy;
-
- return $copy;
-}
-
-######################################################################
-
-=head2 ref_compare()
-
-Attempt to recursively compare two references.
-
-If they are not the same, try to be consistent about returning a
-positive or negative number so that it can be used for sorting.
-The sort order is kinda arbitrary.
-
-=cut
-
-use vars qw( %ComparedItems );
-
-# $positive_zero_or_negative = ref_compare( $A, $B );
-sub ref_compare {
- local %ComparedItems = ();
- _compare( @_ );
-}
-
-# $positive_zero_or_negative = _compare( $A, $B );
-sub _compare {
- my($A, $B, $ignore_class) = @_;
-
- # If they're both simple scalars, use string comparison
- return $A cmp $B unless ( ref($A) or ref($B) );
-
- # If either one's not a reference, put that one first
- return 1 unless ( ref($A) );
- return - 1 unless ( ref($B) );
-
- # Check to see if we've got two references to the same structure
- return 0 if ("$A" eq "$B");
-
- # If we've already seen these items repeatedly, we may be running in circles
- return undef if ($ComparedItems{ $A } ++ > 2 and $ComparedItems{ $B } ++ > 2);
-
- # Check the ref values, which may be data types or class names
- my $ref_A = ref($A);
- my $ref_B = ref($B);
- return $ref_A cmp $ref_B if ( ! $ignore_class and $ref_A ne $ref_B );
-
- # Extract underlying data types
- my $type_A = ("$A" =~ /^\Q$ref_A\E\=([A-Z]+)\(0x[0-9a-f]+\)$/) ? $1 : $ref_A;
- my $type_B = ("$B" =~ /^\Q$ref_B\E\=([A-Z]+)\(0x[0-9a-f]+\)$/) ? $1 : $ref_B;
- return $type_A cmp $type_B if ( $type_A ne $type_B );
-
- if ($type_A eq 'HASH') {
- my @kA = sort keys %$A;
- my @kB = sort keys %$B;
- return ( $#kA <=> $#kB ) if ( $#kA != $#kB );
- foreach ( 0 .. $#kA ) {
- return ( _compare($kA[$_], $kB[$_]) or
- _compare($A->{$kA[$_]}, $B->{$kB[$_]}) or next );
- }
- return 0;
- } elsif ($type_A eq 'ARRAY') {
- return ( $#$A <=> $#$B ) if ( $#$A != $#$B );
- foreach ( 0 .. $#$A ) {
- return ( _compare($A->[$_], $B->[$_]) or next );
- }
- return 0;
- } elsif ($type_A eq 'SCALAR' or $type_A eq 'REF') {
- return _compare($$A, $$B);
- } else {
- return ("$A" cmp "$B")
- }
-}
-
-########################################################################
-
-=head1 SEE ALSO
-
-See L<Class::MakeMethods> for general information about this distribution.
-
-See L<Ref> for the original version of the clone and compare functions used above.
-
-See L<Clone> (v0.09 on CPAN as of 2000-09-21) for a clone method with an XS implementation.
-
-The Perl6 RFP #67 proposes including clone functionality in the core.
-
-See L<Data::Compare> (v0.01 on CPAN as of 1999-04-24) for a Compare method which checks two references for similarity, but it does not provide positive/negative values for ordering purposes.
-
-=cut
-
-######################################################################
-
-1;