DBIx::SQLEngine::Utility::CloneWithParams - Nifty Cloner


DBIx-SQLEngine documentation Contained in the DBIx-SQLEngine distribution.

Index


Code Index:

NAME

Top

DBIx::SQLEngine::Utility::CloneWithParams - Nifty Cloner

SYNOPSIS

Top

  use DBIx::SQLEngine::Utility::CloneWithParams;

  $clone = clone_with_parameters( $string, @replacements );
  $clone = clone_with_parameters( \@array, @replacements );
  $clone = clone_with_parameters( \%hash, @replacements );

DESCRIPTION

Top

This package provides a function named clone_with_parameters() that makes deep copies of nested data structures, while making replacements in key places.

clone_with_parameters

  $clone = clone_with_parameters( $reference, @replacements );

This function makes deep copies of nested data structures, with object reblessing and loop detection to avoid endless cycles. (The internals are based on clone() from Clone::PP.)

It's one distinctive behavior is that if a data structure contains references to the special numeric Perl variables $1, $2, $3, and so forth, when it is cloned they are replaced with a set of provided parameter values. It also replaces stringified versions of those references embedded in scalar values.

An exception is thrown if the number of parameters provided does not match the number of special variables referred to.

Limitations:

Examples:

safe_eval_with_parameters

  @results = safe_eval_with_parameters( $perl_code_string );

Uses the Safe package to eval the provided code string. Uses a compartment which shares the same numeric variables, so that values evaluated this way can then be cloned with clone_with_parameters.

SEE ALSO

Top

See DBIx::SQLEngine for the overall interface and developer documentation.

See DBIx::SQLEngine::Docs::ReadMe for general information about this distribution, including installation and license information.


DBIx-SQLEngine documentation Contained in the DBIx-SQLEngine distribution.
########################################################################

package DBIx::SQLEngine::Utility::CloneWithParams;

use Exporter;
sub import { goto &Exporter::import } 
@EXPORT = @EXPORT_OK = qw( clone_with_parameters safe_eval_with_parameters );
%EXPORT_TAGS = ( all => \@EXPORT_OK );

use strict;
use Carp;

########################################################################

my @num_refs = map { \$_ } ( $1, $2, $3, $4, $5, $6, $7, $8, $9 );
my $num_refs = join "|", map { "\Q$_" } @num_refs;
my %num_refs = map { $num_refs[ $_ -1 ] => $_ } ( 1 .. 9 );

########################################################################

use vars qw( %CopiedItems @Parameters @ParametersUsed );

# $deep_copy = clone_with_parameters( $value_or_ref );
sub clone_with_parameters {
  my $item = shift;
  local @Parameters = @_;
  local %CopiedItems = ();
  local @ParametersUsed = ();
  my $clone = __clone_with_parameters( $item );
  if ( scalar @ParametersUsed < scalar @Parameters ) { 
    confess( "Too many arguments:  " . scalar(@Parameters) . 
		    " instead of " . scalar(@ParametersUsed));
  }
  return $clone;
}

sub __get_parameter {
  my $placeholder = shift;
  
  if ( $placeholder > scalar @Parameters ) {
    confess( "Too few arguments:  " . scalar(@Parameters) . 
		    " instead of $placeholder");
  }
  $ParametersUsed[ $placeholder -1 ] ++;
  return $Parameters[ $placeholder -1 ];
}

# $copy = __clone_with_parameters( $value_or_ref );
sub __clone_with_parameters {
  my $source = shift;
  
  return $CopiedItems{ $source } if ( exists $CopiedItems{ $source } );

  if ( my $placeholder = $num_refs{ $source } ) {
    return __get_parameter( $placeholder );
  }
  
  my $ref_type = ref $source;
  if (! $ref_type) {
    $source =~ s/($num_refs)/ __get_parameter( $num_refs{ $1 } ) /geo;
    return $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') {
    $CopiedItems{ $source } = $copy = \( my $var = "" );;
    $$copy = __clone_with_parameters($$source);
  } elsif ($ref_type eq 'REF') {
    $CopiedItems{ $source } = $copy = \( my $var = "" );;
    $$copy = __clone_with_parameters($$source);
  } elsif ($ref_type eq 'HASH') {
    $CopiedItems{ $source } = $copy = {};
    %$copy = map { __clone_with_parameters($_) } %$source;
  } elsif ($ref_type eq 'ARRAY') {
    $CopiedItems{ $source } = $copy = [];
    @$copy = map { __clone_with_parameters($_) } @$source;
  } else {
    $copy = $source;
  }
  
  bless $copy, $class_name if $class_name;
  
  return $copy;
}

########################################################################

my $safe_compartment;
sub safe_eval_with_parameters {
  $safe_compartment or $safe_compartment = do {
    require Safe;
    my $compartment = Safe->new();
    $compartment->share_from( 'main', [ map { '$' . $_ } ( 1 .. 9 ) ] );
    $compartment;
  };

  $safe_compartment->reval( shift );
}

########################################################################

########################################################################

1;