view release on metacpan or  search on metacpan

lib/Data/Rebuilder.pm  view on Meta::CPAN

                    );
               }
               else {
                 push( @vars,
                       sprintf ( "  my \%s = undef;\n".
                                 '  Lexical::Alias::alias_r( %s , \%s );',
                                 $key,
                                 $self->freeze($val),
                                 $key ) );
               }

             }

             my %info = $dp->coderef2textX($cv);

             foreach my $stash ( $b->STASH->NAME , @{$info{stashes}} ){
               $self->_stashes->{$stash} = 1;
             }

             join( "\n",
                   "do{",
                   '  # CodeRef',
                   (map{ sprintf('  %s = %s;',$_,$_) }@{$info{globals}}),
                   ( @vars ? '  require Lexical::Alias;' : () ),
                   @vars,
                   sprintf('  sub %s', _indent $info{code}),
                   "}",
                 );
           },

           #################################
           'ArrayRef' => sub{

             my $ref    = shift;
             my $target = shift || $ref;
             my $var    = $self->ref_to_var($target);

             my @body = ();
             my @tied = ();
             my @weak = ();
             local $_;

             for( my $i = 0; $i < @{$ref} ; $i++ ) {
               my $v = $ref->[$i];
               my $tied = tied ( $ref->[$i] );
               push @body, sprintf('    # %s', refaddr( \$ref->[$i] ));
               if( $tied ){

                 push @body, "    undef,";
                 push @tied , [$i => $tied];

               }
               elsif( $self->_is_cycled($v) ) {

                 push @body, "    undef,";
                 my $lazy = $self->_lazy->{ refaddr $v } ||= [];
                 push( @$lazy ,
                       sprintf('%s->[%s] = %s;',
                               $var, $i, $self->freeze($v)));
                 push( @$lazy ,
                       sprintf('Scalar::Util::weaken(%s->[%s]);',
                               $var, $i))
                   if isweak($ref->[$i]);

               }
               elsif( $self->poly->type($v) eq 'RefRef'  and
                      $self->_is_cycled($$v)){
                 push @body, "    undef, #cycled RefRef ";
                 my $lazy = $self->_lazy->{refaddr $$v} ||= [];
                 push @{$lazy}, sprintf('%s->[%s] = %s;',
                                        $var,
                                        $i,
                                        $self->poly->apply( $v => 'freeze'));
                 push( @$lazy ,
                       sprintf('Scalar::Util::weaken(%s->[%s]);',
                               $var, $i))
                   if isweak($ref->[$i]);
               }
               else {

                 push @body , "    ". $self->freeze($v).",";
                 push @weak , $i , if isweak( $ref->[$i] );

               }
             }

             join
               (
                "\n" ,
                "do{ ",
                '  # ArrayRef',
                "  my \$__tmp = [",
                @body ,
                "  ];",
                "  "._indent( join "\n",
                              map{ $self->tier('$__tmp->['.$_->[0].']',
                                               'TIESCALAR',
                                               $_->[1]) } @tied ),
                "  "._indent( join "\n",
                              map{ sprintf(' Scalar::Util::weaken('.
                                           '  $__tmp->[%s] );' ,
                                           $_) } @weak ),
                '  $__tmp;',
                "}"
               );
           },

           #################################
           'HashRef' => sub{
             my $ref    = shift;
             my $target = shift || $ref;
             my $var    = $self->ref_to_var($target);
             my @body = ();
             my @tied = ();
             my @weak = ();

             foreach my $key ( sort keys %{$ref} ){
               my $v = $ref->{$key};
               my $tied = tied ( $ref->{$key} );
               if( $tied ){
                 push @body ,
                   sprintf('      %s => undef,',  $self->freeze($key)),
                 push @tied , [$key => $tied];
               }
               elsif( $self->_is_cycled($v) ) {

                 push @body ,
                   sprintf('      %s => undef, # cycled', $self->freeze($key));

                 my $lazy = $self->_lazy->{ refaddr $v } ||= [];

                 push( @$lazy , sprintf('%s->{%s} = %s;',
                                         $var,
                                         $self->freeze($key),
                                         $self->freeze($v)));

                 push( @$lazy ,
                       sprintf('Scalar::Util::weaken(%s->{%s});',
                               $var,
                               $self->freeze($key)
                              )) if isweak($ref->{$key});

               }
               elsif( $self->poly->type($v) eq 'RefRef'  and
                      $self->_is_cycled($$v)){

                 push @body, sprintf('      %s => undef, # cycled RefRef',
                                    $self->freeze($key));

                 my $lazy = $self->_lazy->{refaddr $$v} ||= [];

                 push @{$lazy}, sprintf('%s->{%s} = %s;',
                                        $var,
                                        $self->freeze($key),
                                        $self->freeze($v));

                 push( @$lazy ,
                       sprintf('Scalar::Util::weaken(%s->{%s});',
                               $var,
                               $self->freeze($key),
                              )) if isweak($ref->{$key});

               }
               else {
                 push @body ,
                   sprintf('      %s => %s,',
                           $self->freeze($key), $self->freeze($v));
                 push @weak , $key, if isweak( $ref->{$key} );
               }
             }

             join
               (
                "\n" ,
                "do{ ",
                '  # HashRef',
                "  my \$__tmp = {",
                @body ,
                "  };",
                ( map{ $self->tier('$__tmp->{'.$self->freeze($_->[0]).'}',
                                   'TIESCALAR',
                                   $_->[1]) } @tied ),
                ( map{ sprintf(' Scalar::Util::weaken( \ $__tmp->{%s} );' ,
                               $self->freeze($_)) }
                  @weak ),
                '  $__tmp;',
                "}"
               );
           },

           #################################
           'GlobRef' => sub{
             my $glob   = shift;
             my $target = shift;
             my $var    = $self->ref_to_var($target);
             my $name = "".$$glob;

             return '\\ '.$name
               if( $name =~ /\*main::(STD(?:IN|OUT|ERR)|ARGV)/ &&
                   refaddr( $glob ) == refaddr( \$main::{$1} ) );

             my @slots = ();
             foreach my $slot ( qw(SCALAR HASH ARRAY CODE)) {

               next unless my $ref = *{$glob}{$slot};

               if( $self->poly->type($slot) eq 'RefRef' &&
                   $self->_is_cycled($$slot) ) {
                 my $lazy = ($self->_lazy->{refaddr $$slot} ||= []);
                 push @$lazy,
                   sprintf('  *{%s} = %s;',
                           $var,
                           $self->freeze(*{$glob}{$slot}) );
               }
               else {
                 push @slots,
                   sprintf('  *{$__tmp} = %s;',
                           $self->freeze(*{$glob}{$slot}) );
               }

             }
             join ("\n",
                   'do {',
                   '  require Symbol;',
                   sprintf('  my $__tmp = Symbol::gensym();', $name),
                   @slots,
                   '  $__tmp;',
                   '}',
                  );
           },

           ###
           'RefRef' => sub{
             my $ref    = shift;
             my $target = shift || $ref;
             "\\ ". $self->freeze( ${$ref} , ${$target} );
           },

           ###
           UNIVERSAL => sub {
             my $obj    = shift;
             my $target = shift || $obj;
             $self->_stashes->{blessed $obj} = 1;