
package Text::Wigwam::Globals::Snapshot;

    use strict;
    use warnings;
    our $VERSION = '0.01';

    use Scalar::Util( qw/reftype refaddr blessed/ );

sub freeze {
    my ($class, $globals, $depth) = @_;
    my $self = bless {
        REFDONE  => {},
        GLOBALS  => $globals,
        MAXDEPTH => $depth =~ /^\d+$/ ? $depth : 4,
    }, ref($class) || $class;
    return $self->_freeze($self->{GLOBALS}, 0);
}

sub _freeze {
    my ($self, $ref, $depth) = @_;
    my $id = refaddr $ref
      or return $ref;
    return $self->{REFDONE}{$id}
        if ref $self->{REFDONE}{$id};
    return $self->{REFDONE}{$id} =
      reftype $ref eq 'ARRAY'  ? $self->_traverse_array($ref, $depth+1)
    : reftype $ref eq 'HASH'   ? $self->_traverse_hash($ref, $depth+1)
    : reftype $ref eq 'REF'    ? $self->_traverse_ref($ref, $depth+1)
    : reftype $ref eq 'SCALAR' ? \do { my $s = $$ref }
                               : $ref;
}

sub _traverse_ref {
    my ($self, $ref, $depth) = @_;

    my $id = refaddr $ref;
    return $self->{REFDONE}{$id} = \$$ref
      if $id == refaddr $$ref;

    return '(too deep)'
      if $self->_too_deep($depth);

    return $self->{REFDONE}{$id} ||=
      \$self->_freeze($$ref, $depth);
}

sub _traverse_array {
    my($self, $ref, $depth) = @_;
    $self->{REFDONE}{refaddr $ref} = my $copy = [];
    bless $copy, "VOID::".ref($ref) if blessed $ref;
    return $copy unless scalar @$ref;
    if( $self->_too_deep($depth) ){
        @$copy = ( '(too deep)' );
    }
    else {
        for my $element (0..$#$ref) {
            $copy->[$element] = $self->_freeze($ref->[$element], $depth);
        }
    }
    return $copy;
}

sub _traverse_hash {
    my($self, $ref, $depth) = @_;
    $self->{REFDONE}{refaddr $ref} = my $copy = {};
    bless $copy, "VOID::".ref($ref) if blessed $ref;
    if( $self->_too_deep($depth) ){
        %$copy = ( '(too deep)' => '(too deep)' );
    }
    else {
        for my $key (keys %$ref) {
            $copy->{$key} = $self->_freeze($ref->{$key}, $depth);
        }
    }
    return $copy;
}

sub _too_deep {
    my ($self, $depth) = @_;
    return $self->{MAXDEPTH} ? $self->{MAXDEPTH} < $depth : 0;
}

1;

__END__

=head1 Name

Text::Wigwam::Globals::Snaphot - Returns a copy of a Globals structure.

=head1 Synopsis

 Text::Wigwam::Globals::Snapshot->freeze($globals, $depth)

=head1 Description

Snapshot returns a deep copy of a data structure while preserving aliased
references. That is, any duplicated references in the original structure are
mirrored in the new structure. As intended, snapshot does not attempt to
preserve class information. The copy is made up of unblessed references,
only.

=cut
