From: David Leadbeater <dgl@dgl.cx>
Date: Thu, 23 Dec 2010 00:14:30 +0000 (+0000)
Subject: Data experiment
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=279ff374a227b7cfc9c91e47b4bf86ad2e2f9b91;p=p5sagit%2FApp-FatPacker.git

Data experiment
---

diff --git a/lib/App/FatPacker.pm b/lib/App/FatPacker.pm
index aa3caef..dc2ad35 100644
--- a/lib/App/FatPacker.pm
+++ b/lib/App/FatPacker.pm
@@ -147,6 +147,12 @@ sub packlists_to_tree {
 
 sub script_command_file {
   my ($self, $args) = @_;
+
+  $args = call_parser $args => [
+    'data-pack' => \my $data_pack,
+    'main=s'    => \my $main_file,
+  ];
+
   my $file = shift @$args;
   my $cwd = cwd;
   my @dirs = map rel2abs($_, $cwd), ('lib','fatlib');
@@ -160,6 +166,17 @@ sub script_command_file {
       };
     }, $dir);
   }
+
+  if($data_pack) {
+    generate_file_data_style(\%files, $main_file);
+  } else {
+    generate_file_hash_style(\%files);
+  }
+}
+
+sub generate_file_hash_style {
+  my($files) = @_;
+
   my $start = stripspace <<'  END_START';
     # This chunk of stuff was generated by App::FatPacker. To find the original
     # file's code, look for the end of this BEGIN block or the string 'FATPACK'
@@ -183,13 +200,58 @@ sub script_command_file {
   my @segments = map {
     (my $stub = $_) =~ s/\.pm$//;
     my $name = uc join '_', split '/', $stub;
-    my $data = $files{$_}; $data =~ s/^/  /mg; $data =~ s/(?<!\n)\z/\n/;
+    my $data = $files->{$_}; $data =~ s/^/  /mg; $data =~ s/(?<!\n)\z/\n/;
     '$fatpacked{'.perlstring($_).qq!} = <<'${name}';\n!
     .qq!${data}${name}\n!;
-  } sort keys %files;
+  } sort keys %$files;
   print join "\n", $start, @segments, $end;
 }
 
+sub generate_file_data_style {
+  my($files, $main) = @_;
+
+  my $start = stripspace <<'  END_START';
+  # This chunk of stuff was generated by App::FatPacker. Do not edit.
+  my %fatpacked = (
+  END_START
+
+  my @segments = map {
+    (my $stub = $_) =~ s/\.pm$//;
+    my $data = $files->{$_};
+    $data =~ s/(?<!\n)\z/\n/;
+    [$_, length $data, \$data];
+  } sort keys %$files;
+
+  my $fatpack_data;
+  my $start_idx = 0;
+  for my $segment (@segments) {
+    $fatpack_data .= "  ".perlstring($segment->[0])." => [$start_idx, $segment->[1]],\n";
+    $start_idx += $segment->[1];
+  }
+
+  my $end = stripspace <<'  END_END';
+  );
+
+  my $data_pos = tell DATA;
+  unshift @INC, sub {
+    if(my $fat = $fatpacked{$_[1]}) {
+      seek DATA, $data_pos + $fat->[0], 0;
+      local $/ = \$fat->[1];
+      open my $fh, '<', \scalar <DATA>;
+      return $fh;
+    }
+  };
+
+  # END OF FATPACK CODE
+  END_END
+
+  open my $main_fh, '<', $main or die "Can't open '$main': $!";
+
+  print join "\n", $start, $fatpack_data, $end;
+  print join "", <$main_fh>, "\n";
+  print join "\n", "__DATA__", join "", map ${$_->[2]}, @segments;
+}
+
 =head1 NAME
 
 App::FatPacker - pack your dependencies onto your script file