t/lib/PAML.pm

   1 package PAML;
   2 use strict;
   3 use warnings;
   4
   5 # "PAML Ain't Markup Language"!!!
   6
   7 use Carp         qw[croak];
   8 use Data::Dumper qw[];
   9 use IO::File     qw[];
  10
  11 BEGIN {
  12     our @EXPORT_OK = qw(
  13         DumpFile
  14         LoadFile
  15     );
  16
  17     require Exporter;
  18     *import = \&Exporter::import;
  19 }
  20
  21 sub DumpFile ($$) {
  22     my ($path, $struct) = @_;
  23
  24     my $data = do {
  25         local $Data::Dumper::Indent = 1;
  26         local $Data::Dumper::Purity = 1;
  27         local $Data::Dumper::Terse  = 1;
  28         local $Data::Dumper::Useqq  = 1;
  29         Data::Dumper->Dump([$struct], ['PAML']);
  30     };
  31
  32     my $io = IO::File->new($path, '>')
  33       || croak(qq[Couldn't open path '$path' in write mode: $!]);
  34
  35     $io->binmode
  36       || croak(qq[Couldn't binmode filehandle: $!]);
  37
  38     $io->print($data)
  39       || croak(qq[Couldn't write filehandle: $!]);
  40
  41     $io->close
  42       || croak(qq[Couldn't close filehandle: $!]);
  43
  44     1;
  45 }
  46
  47 sub LoadFile ($) {
  48     my ($path) = @_;
  49
  50     my $data = do {
  51
  52         my $io = IO::File->new($path, '<')
  53           || croak(qq[Couldn't open path '$path' in read mode: $!]);
  54
  55         $io->binmode
  56           || croak(qq[Couldn't binmode filehandle: $!]);
  57
  58         my $exp = -s $path;
  59         my $buf = do { local $/; <$io> };
  60         my $got = length $buf;
  61
  62         $io->close
  63           || croak(qq[Couldn't close filehandle: $!]);
  64
  65         ($exp == $got)
  66           || croak(qq[I/O read mismatch, expexted: $exp got: $got]);
  67
  68         $buf;
  69     };
  70
  71     if (substr($data, 0, 1) eq '{') {
  72         substr($data, 0, 0, '+');
  73     }
  74
  75     my $struct = eval($data);
  76
  77     (!$@)
  78       || croak(qq[LoadFile couldn't eval data: $@]);
  79
  80     $struct;
  81 }
  82
  83 1;
  84