From: Olivier Mengué <dolmen@cpan.org>
Date: Wed, 26 Jun 2013 21:27:28 +0000 (+0200)
Subject: Refactor: split App::FatPacker->fatpack_file in multiple methods
X-Git-Tag: v0.010000~16
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=30c647248c7eaac7f0051f3fd3cf3734b296ba44;p=p5sagit%2FApp-FatPacker.git

Refactor: split App::FatPacker->fatpack_file in multiple methods

This will allow to build subclasses of App::FatPacker that overload only
some parts of the fatpacking process.
The ultimate goal is to be able to reuse bin/fatpack with pluggable
implementations of the App::FatPacker class.
---

diff --git a/lib/App/FatPacker.pm b/lib/App/FatPacker.pm
index 8ddc267..ec006a4 100644
--- a/lib/App/FatPacker.pm
+++ b/lib/App/FatPacker.pm
@@ -200,26 +200,72 @@ sub script_command_file {
 
 sub fatpack_file {
   my ($self, $file) = @_;
-  my $cwd = cwd;
-  my @dirs = grep -d, map rel2abs($_, $cwd), ('lib','fatlib');
+
+  my $shebang = "";
+  my $script = "";
+  if ( defined $file and -r $file ) {
+    ($shebang, $script) = $self->load_main_script($file);
+  }
+
+  my @dirs = $self->collect_dirs();
   my %files;
-  foreach my $dir (@dirs) {
-    find(sub {
-      return unless -f $_;
-      !/\.pm$/ and warn "File ${File::Find::name} isn't a .pm file - can't pack this -- if you hoped we were going to, things may not be what you expected later\n" and return;
-      $files{File::Spec::Unix->abs2rel($File::Find::name,$dir)} = do {
-        local (@ARGV, $/) = ($File::Find::name); <>
-      };
-      close ARGV;
-    }, $dir);
+  $self->collect_files($_, \%files) for @dirs;
+
+  return join "\n", $shebang, $self->fatpack_code(\%files), $script;
+}
+
+# This method can be overload in sub classes
+# For example to skip POD
+sub load_file {
+  my ($self, $file) = @_;
+  my $content = do {
+    local (@ARGV, $/) = ($file);
+    <>
+  };
+  close ARGV;
+  return $content;
+}
+
+sub collect_dirs {
+  my ($self) = @_;
+  my $cwd = cwd;
+  return grep -d, map rel2abs($_, $cwd), ('lib','fatlib');
+}
+
+sub collect_files {
+  my ($self, $dir, $files) = @_;
+  find(sub {
+    return unless -f $_;
+    !/\.pm$/ and warn "File ${File::Find::name} isn't a .pm file - can't pack this -- if you hoped we were going to, things may not be what you expected later\n" and return;
+    $files->{File::Spec::Unix->abs2rel($File::Find::name,$dir)} =
+      $self->load_file($File::Find::name);
+  }, $dir);
+}
+
+sub load_main_script {
+  my ($self, $file) = @_;
+  open my $fh, "<", $file or die("Can't read $file: $!");
+  my $shebang = <$fh>;
+  my $script = join "", <$fh>;
+  close $fh;
+  unless ( index($shebang, '#!') == 0 ) {
+    $script = $shebang . $script;
+    $shebang = "";
   }
-  my $start = stripspace <<'  END_START';
+  return ($shebang, $script);
+}
+
+sub fatpack_start {
+  return 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'
     BEGIN {
     my %fatpacked;
   END_START
-  my $end = stripspace <<'  END_END';
+}
+
+sub fatpack_end {
+  return stripspace <<'  END_END';
     s/^  //mg for values %fatpacked;
 
     unshift @INC, sub {
@@ -241,26 +287,19 @@ sub fatpack_file {
 
     } # END OF FATPACK CODE
   END_END
+}
+
+sub fatpack_code {
+  my ($self, $files) = @_;
   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;
-  my $shebang = "";
-  my $script = "";
-  if ( defined $file and -r $file ) {
-    open my $fh, "<", $file or die("Can't read $file: $!");
-    $shebang = <$fh>;
-    $script = join "", <$fh>;
-    close $fh;
-    unless ( index($shebang, '#!') == 0 ) {
-      $script = $shebang . $script;
-      $shebang = "";
-    }
-  }
-  return join "\n", $shebang, $start, @segments, $end, $script;
+  } sort keys %$files;
+
+  return join "\n", $self->fatpack_start, @segments, $self->fatpack_end;
 }
 
 =encoding UTF-8