# MARTINIC Marshall/Serialize 0.03
# (c) MARTINIC Computers 2006

package Marshall;

require 5.008001;

use strict;
use warnings;

use vars qw($VERSION @ISA @EXPORT);

BEGIN{
  use Exporter ();
  @ISA = qw(Exporter);
  @EXPORT = qw(marshall unmarshall);  # Export marshall and unmarshall
}

$VERSION = '0.03';

END{}

# Create jump table for perlme sub

my %encode_all = ("_scalar" => \&encode_scalar,
                   "SCALAR" => \&encode_ref,
                    "ARRAY" => \&encode_list_ref,
                     "HASH" => \&encode_hash_ref,
                      "REF" => \&encode_ref,);
# perlme($ref)

sub perlme {
  my($thing) = @_;
  my($type);
  $type = ref($thing) || "_scalar";
  return(&{$encode_all{$type}}($thing)) if (defined($encode_all{$type}));
  warn("Can't handle $type ref\n");
  return 'undef';
}

# encode_list_ref($list_ref)

sub encode_list_ref {
  my($list_ref) = @_;
  my($string);

  $string = '[';
  for (@$list_ref) {
    $string .= perlme($_).',';
  }
  $string .= ']';
  return($string);
}

# encode_hash_ref($hash_ref)

sub encode_hash_ref {
  my($hash_ref) = @_;
  my($string, $key);

  $string = '{';
  foreach $key (keys(%$hash_ref)) {
    $string .= encode_scalar($key).'=>'.perlme ($$hash_ref{$key}).',';
  }
  $string .= '}';
  return($string);
}

# encode_ref($ref)

sub encode_ref {
  my($ref) = @_;
  return("\\do{my\$r=".perlme ($$ref)."}");                                                # anonymous scalar
}

# encode_scalar($scalar)

sub encode_scalar {
  my($scalar) = @_;
  my $bs = '"';                                                                            # Begin Scalar
  my $es = '"';                                                                            # End Scalar
  if (defined ($scalar)) {
    if (utf8::is_utf8($scalar)) {                                                          # Since Perl 5.8.1
      $scalar =~ s/([\x00-\x27\x3A-\x40\x5B-\x60\x7B-\x7F])/sprintf('\\x%02X',ord($1))/eg; # Also change ,},]
      $scalar =~ s/([^\x00-\x7F])/sprintf('\\x{%X}',ord($1))/eg                            # Any Char \x80 or above
    } else {
      $scalar =~ s/([\x00-\x27\x3A-\x40\x5B-\x60\x7B-\xFF])/sprintf('\\x%02X',ord($1))/eg; # Also change ,},]
    }
  } else {
    $bs = '';                                                                              # undef
    $es = '';
    $scalar = 'undef';
  }
  return("$bs$scalar$es");
}

# $serialized = marshall(\@table);
# $serialized = marshall(\%table);
# $serialized = marshall($string);

sub marshall {
  my($thing) = @_;
  $thing = perlme($thing);
  $thing =~ s/,([}\]])/$1/g;
  return "$thing\;";
}

# @table_clone = @{unmarshall($serialized)};
# %table_clone = %{unmarshall($serialized)};
# $string_clone = unmarshall($serialized);

sub unmarshall {
   eval $_[0];
}


1;
__END__

=head1 NAME

Marshall - marshall/unmarshall Perl data structures.

=head1 SYNOPSIS

  use Marshall;

  my $serialized = marshall(\@table);
  my @table_clone = @{unmarshall($serialized)};

  my $serialized = marshall(\%table);
  my %table_clone = %{unmarshall($serialized)};

  my $serialized = marshall($list);
  my $list_clone = unmarshall($serialized);

  my $serialized = marshall($string);
  my $string_clone = unmarshall($serialized);

=head1 DESCRIPTION

The Marshall package converts from Perl data structures to serialized 7 bit ASCII strings and back.
The serialized strings do not contain enters, tabs or space characters to ensure safe storage in XML or database files.

=head1 AUTHOR

MARTINIC Marshall/Serialize 0.03
(c) MARTINIC Computers 2006

AUTHOR INFORMATION

Martin Broerse <broerse@martinic.nl>, http://www.martinic.nl/.

=head1 CREDITS

Thank you to:

 Hal Pomeranz
 Jan Pieter Cornet
 Juerd
 Mark Overmeer
 Merijn Brand
 Ruud van Tol
 Theo Niessink

= cut