package Mud::Freezer;
use strict;
use vars qw(
  @ISA
  $USE
  %AVAIL
  %Markers
);

use Carp;
#use Mud::CoreTools;

%Markers = (
  'Storable'     => 'Stora',
  'FreezeThaw'   => 'FThaw',
  'Data::Dumper' => 'Dumpr',
);

# FIXME: use MFile instead of rfile() when implemented
sub thaw_from_file {
  shift if $_[0] eq __PACKAGE__;
  my ($path) = @_;
  
  my $fh = IO::File->new(rfile($path), '<') or croak "Thaw: Open: $path - $!";
  binmode $fh;
  
  local $/;
  <$fh> =~ /(^.*$)/s; # untaint because of Data::Dumper thawing, ick
  return Mud::Freezer::thaw($1);
}

# FIXME: use MFile instead of rfile() etc when implemented
sub freeze_to_file {
  shift if $_[0] eq __PACKAGE__;
  my ($path, $thingy) = @_;
  
  my $data = Mud::Freezer::freeze($thingy);
  
  rmkpathto($path);
  my $fh = IO::File->new(rfile($path), '>') or croak "Freeze: Open: $path - $!";
  binmode $fh;
  
  $fh->print($data);
}

### 

sub freeze {
  shift if $_[0] eq __PACKAGE__;
  my ($struct) = @_;
  
  if (!$USE) {
    croak __PACKAGE__." not yet initialized!";
  } elsif ($USE eq 'Storable') {
    return 'Stora' . Storable::nfreeze($struct);
  } elsif ($USE eq 'FreezeThaw') {
    return 'FThaw' . FreezeThaw::freeze($struct);
  } elsif ($USE eq 'Data::Dumper') {
    return 'Dumpr' . Data::Dumper::DumperX($struct);
  }
}

sub thaw {
  shift if $_[0] eq __PACKAGE__;
  my ($data) = @_;

  defined $data or croak "Thaw: Undef passed";
  !ref $data or croak "Thaw: Reference passed";
  length $data >= 5 or croak "Thaw: Data '$data' too short";
  my $marker = substr($data, 0, 5);
               substr($data, 0, 5) = '';
  if ($marker eq $Markers{'Storable'}) {
    _reqmod('Storable');
    my $out = eval {
      Storable::thaw($data);
    };
    if ($@) {
      $@ =~ /thaw.al/ and croak "Thaw: Corrupted data";
      die $@;
    }
    return $out;
  } elsif ($marker eq $Markers{'FreezeThaw'}) {
    _reqmod('FreezeThaw');
    return FreezeThaw::thaw($data);
  } elsif ($marker eq $Markers{'Data::Dumper'}) {
    my $VAR1;
    $data =~ s/\r/\n/;
    local $SIG{__WARN__} = sub {
      my ($wt) = @_;
      return if $wt =~ /^(?:# )?Ambiguous use of (\{?)(.+)(\}| =>) resolved to \1"\2"\3/;
      warn "while thawing saved code structure: $wt";
    };
    # we need a layer of eval here because if $data is tainted, it'll
    # throw a exception that isn't caught by the string eval.
    eval {eval $data; die $@ if $@};
    if ($@) {
      $@ =~ /Insecure dependency in eval/ and croak "Thaw: Must be untainted";
      die $@;
    }
    return $VAR1;
  } else {
    croak "Thaw: Bad data type marker '$marker'";
  }
}

sub clone {
  shift if $_[0] eq __PACKAGE__;
  my ($thingy) = @_;
  
  if ($AVAIL{'Storable'}) {
    return ref $thingy ? Storable::dclone($thingy) : $thingy;
    
  } elsif ($AVAIL{'FreezeThaw'}) {
    return FreezeThaw::thaw(FreezeThaw::freeze($thingy));
    
  } elsif ($AVAIL{'Data::Dumper'}) {
    my $VAR1;
    eval Data::Dumper::DumperX($thingy);
    return $VAR1;
    
  } elsif (not scalar keys %AVAIL) {
    croak __PACKAGE__." not yet initialized!";
    
  } else {
    croak "No cloning tool available!";
  }
}

###

sub _initmod {
  my ($mod, $tag) = @_;
  eval "use $mod ()";
  if (!$@) {
    $AVAIL{$mod} = 1;
    $USE ||= $mod;
  }
}

sub _reqmod {
  $AVAIL{$_[0]} or croak "Couldn't thaw: $_[0] not available";
}

BEGIN {
  # Data::Dumper gets priority if compatible freeze is enabled
  # FIXME: need to reenable this in an appropriate way for v4
  #_initmod('Data::Dumper') if $::Config{freeze_compatible};
  _initmod('Storable');
  #_initmod('FreezeThaw'); # buggy
  _initmod('Data::Dumper');
  $USE or die "No freezer available! Please install Storable, FreezeThaw, or Data::Dumper.";
  #mudlog "Freezer: $USE.";
  
  if ($AVAIL{'Data::Dumper'}) {
    $Data::Dumper::Indent = 0;
    $Data::Dumper::Purity = 1;
    $Data::Dumper::Quotekeys = 0;
  }
}

1;
__END__
