package MFreezer;
use strict;
use vars qw(
  $USE
  %AVAIL
  %Markers
);

use MCoreTools;
use Carp;

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

sub freeze {
  my ($struct) = @_;
  
  if (!$USE) {
    croak "MFreezer 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 {
  my ($data) = @_;

  defined $data or croak "Undef passed to MFreezer::thaw";
  length $data >= 5 or croak "Data '$data' too short in MFreezer::thaw";
  my $marker = substr($data, 0, 5);
               substr($data, 0, 5) = '';
  if ($marker eq $Markers{'Storable'}) {
    _reqmod('Storable');
    return Storable::thaw($data);
  } 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" =>/;
      mudlog "ERROR/CORE: warning while thawing saved code structure: $wt";
    };
    try {
      eval $data;
    } catch {
      /Insecure dependency in eval/ and croak "Couldn't thaw: Must be untainted";
      /thaw.al/ and croak "Couldn't thaw: Corrupted data";
    };
    return $VAR1;
  } else {
    croak "Couldn't thaw: Bad data type marker '$marker' in MFreezer::thaw";
  }
}

sub clone {
  my ($struct) = @_;
  if ($AVAIL{'Storable'}) {
    return Storable::dclone($struct);
  } elsif ($AVAIL{'FreezeThaw'}) {
    return FreezeThaw::thaw(FreezeThaw::freeze($struct));
  } elsif ($AVAIL{'Data::Dumper'}) {
    my $VAR1;
    eval Data::Dumper::DumperX($struct);
    return $VAR1;
  } 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";
}

sub initialize {
  #mudlog "Initializing freezer...";
  _initmod('Storable') unless $::Config{freeze_compatible};
  _initmod('FreezeThaw') unless $::Config{freeze_compatible};
  _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;
  }
}

1;
