home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Non-RPC / !Perl / riscos / RISCOS / Clone.pm < prev    next >
Text File  |  1998-07-31  |  3KB  |  113 lines
  1. package RISCOS::Clone;
  2.  
  3.  
  4. require Exporter;
  5. use strict;
  6. use vars qw (@ISA @EXPORT_OK $VERSION);
  7.  
  8. @ISA = qw(Exporter);
  9. @EXPORT_OK = qw(Clone clone);
  10. $VERSION = 0.01;
  11.  
  12. sub Clone {    # aka clone-hash
  13.     my ($new, $old) = ({}, $_[0]);
  14.     # This is where we break if someone makes a class which doesn't
  15.     # store stuff in a hash
  16.     while (my ($key, $value) = each %$old) {
  17.     # This is where we break if key is supposed to be
  18.     # stringifed version of value (where value is a hash)
  19.     $$new{$key} = clone ($value);
  20.     }
  21.     ref ($old) eq 'HASH' ? $new : bless ($new, ref $old)
  22. }
  23. sub clone {
  24.     # Beware:
  25.     # 0    Will loop on structures that refer to themselves
  26.     # 1    Will copy things that may not want duplication (eg RISCOS::Font objects
  27.     #    have a dummy clone method to stop this)
  28.     # 2    Will screw up if hashes are supposed to be keyed with a stringified
  29.     #    reference.
  30.     # 3    Will screw up if blessed references are not hash references.
  31.     #
  32.     # For all of the above define a more clever cloner.
  33.  
  34.     my @result = @_;    # Copy it so as not to scribble all over it
  35.     foreach my $thing (@result) {
  36.     if ((not ref $thing) or ref ($thing) eq 'CODE'
  37.           or ref ($thing) eq 'GLOB')
  38.     {
  39.         # undef, scalars, code refs and globs are unchanged
  40.         # hum. globs.
  41.     } elsif (ref ($thing) eq 'SCALAR' or ref ($thing) eq 'LVALUE') {
  42.         $thing = $$thing;
  43.         $thing = \$thing;
  44.     } elsif (ref ($thing) eq 'ARRAY') {
  45.         $thing = [clone (@$thing)];
  46.     } else {
  47.         # Assume its a hash
  48.         if (ref ($thing) ne 'HASH' and $thing->can('Clone')) {
  49.         $thing = $thing->Clone();
  50.         } else {
  51.         $thing = Clone ($thing);
  52.         }
  53.     }
  54.     }
  55.     wantarray ? @result : $result[0];
  56. }
  57. __END__
  58.  
  59. =head1 NAME
  60.  
  61. RISCOS::Clone -- copy nested structures.
  62.  
  63. =head1 SYNOPSIS
  64.  
  65.     use RISCOS::Clone qw(clone);
  66.     @copy = clone (@original);
  67.  
  68.     $copy = $original->Clone();
  69.  
  70. =head1 DESCRIPTION
  71.  
  72. This module provides functions to copy structures.
  73.  
  74. =over 4
  75.  
  76. =item Clone <hash_ref>
  77.  
  78. copies a hash reference, C<bless>ing the returned hash with the class (if any)
  79. of the original. C<Clone> uses <clone> to copy each hash value.
  80.  
  81. =item clone <object> ...
  82.  
  83. recursively copies the objects passed in. In list contest returns the copied
  84. objects, in scalar context returns the first object. C<clone> copies C<undef>,
  85. scalars, code referencess and globs unchanged, scalar references are copied as
  86. a reference to scalar containing the identical value. Array references are
  87. passed recursively to C<clone>, hash references to C<Clone>. Blessed references
  88. that posses a C<Clone> method have this method called, else C<Clone> is called
  89. to make a copy.
  90.  
  91. C<clone> is simpleminded and will go wrong as follows.
  92.  
  93.     clone will loop on structures that refer to themselves
  94.     clone will copy things that may not want duplication
  95.       (eg RISCOS::Font objects have a dummy Clone method to stop this)
  96.     clone will not work correctly if hashes are supposed to be keyed with a
  97.       stringified reference.
  98.     Clone will C<die> if blessed references are not hash references.
  99.  
  100. For objects these problems can be overcome by writing a custom C<Clone> method.
  101.  
  102. =back
  103.  
  104. =head1 BUGS
  105.  
  106. Caveats as noted above. Not tested enough yet.
  107.  
  108. =head1 AUTHOR
  109.  
  110. Nicholas Clark <F<nick@unfortu.net>>
  111.  
  112. =cut
  113.