[Bps-public-commit] r10485 - in bpsbuilder/Shipwright/lib/Shipwright: .

[sunnavy at bestpractical.com]

Author: sunnavy
Date: Thu Jan 24 17:25:17 2008
New Revision: 10485

Modified:
   bpsbuilder/Shipwright/lib/Shipwright/Backend.pm
   bpsbuilder/Shipwright/lib/Shipwright/Backend/SVK.pm
   bpsbuilder/Shipwright/lib/Shipwright/Backend/SVN.pm

Log:
added a simple perl script to fix shebang stuff in case we relocate

Modified: bpsbuilder/Shipwright/lib/Shipwright/Backend.pm
==============================================================================
--- bpsbuilder/Shipwright/lib/Shipwright/Backend.pm	(original)
+++ bpsbuilder/Shipwright/lib/Shipwright/Backend.pm	Thu Jan 24 17:25:17 2008
@@ -225,6 +225,16 @@
         chdir $build_base;
     }
 
+    mkdir File::Spec->catfile( $args{'install-base'},       'bin' )
+      unless -e File::Spec->catfile( $args{'install-base'}, 'bin' );
+
+    copy(
+        File::Spec->catfile( 'bin', 'shipwright-installed-utility' ),
+        File::Spec->catfile(
+            $args{'install-base'}, 'bin', 'shipwright-utility'
+        )
+    );
+
     wrap_bin();
     print "install finished, the dists are at $args{'install-base'}\n";
     print $log "install finished, the dists are at $args{'install-base'}\n";
@@ -312,6 +322,7 @@
 
 }
 
+
 sub substitute {
     my $text = shift;
     return unless $text;
@@ -368,6 +379,43 @@
 
 EOF
 , 
+
+'installed-utility' => <<'EOF'
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Getopt::Long;
+use YAML::Syck;
+use File::Find;
+
+my %args;
+GetOptions( \%args, 'fix-shebang', 'old-path=s', 'new-path=s' );
+
+if ( $args{'fix-shebang'} ) {
+
+    die 'we need old-path arg to fix the shebang' unless $args{'old-path'};
+
+    unless ( $args{'new-path'} ) {
+        require Cwd;
+        $args{'new-path'} = Cwd::getcwd();
+    }
+
+    my $fix = sub {
+        return unless -f $_;
+        local $/;
+        open my $fh, '<', $_ or die "can't read $_: $!";
+        my $text = <$fh>;
+        $text =~ s/^#!$args{'old-path'}/#!$args{'new-path'}/;
+        open $fh, '>', $_ or die "can't write $_: $!";
+        print $fh $text;
+    };
+
+    find( $fix, @ARGV );
+}
+
+EOF
+,
 null => '',    
 );
 

Modified: bpsbuilder/Shipwright/lib/Shipwright/Backend/SVK.pm
==============================================================================
--- bpsbuilder/Shipwright/lib/Shipwright/Backend/SVK.pm	(original)
+++ bpsbuilder/Shipwright/lib/Shipwright/Backend/SVK.pm	Thu Jan 24 17:25:17 2008
@@ -47,7 +47,9 @@
           'wrapper',
         File::Spec->catfile( $dir, 'bin', 'shipwright-builder' ) => 'builder',
         File::Spec->catfile( $dir, 'bin', 'shipwright-utility' ) => 'utility',
-        File::Spec->catfile( $dir, 't',   'test' )               => 'null',
+        File::Spec->catfile( $dir, 'bin', 'shipwright-installed-utility' ) =>
+          'installed-utility',
+        File::Spec->catfile( $dir, 't',          'test' )      => 'null',
         File::Spec->catfile( $dir, 'shipwright', 'order.yml' ) => 'null',
     );
 
@@ -65,8 +67,9 @@
         comment     => 'created project',
     );
     for (
-        'bin/shipwright-builder',        'bin/shipwright-utility',
-        'etc/shipwright-script-wrapper', 't/test'
+        'bin/shipwright-builder',           'bin/shipwright-utility',
+        'bin/shipwright-installed-utility', 'etc/shipwright-script-wrapper',
+        't/test'
       )
     {
         $self->propset(
@@ -306,8 +309,9 @@
     my $dist    = $args{dist};
 
     my ($string) = Shipwright::Util->run(
-        [ 'svk', 'cat', $self->repository . "/scripts/$dist/require.yml" ] );
-    my $req = Shipwright::Config::Load($string);
+        [ 'svk', 'cat', $self->repository . "/scripts/$dist/require.yml" ], 1
+        );
+    my $req = Shipwright::Config::Load($string) || {};
 
     if ( $req->{requires} ) {
         for (qw/requires recommends build_requires/) {

Modified: bpsbuilder/Shipwright/lib/Shipwright/Backend/SVN.pm
==============================================================================
--- bpsbuilder/Shipwright/lib/Shipwright/Backend/SVN.pm	(original)
+++ bpsbuilder/Shipwright/lib/Shipwright/Backend/SVN.pm	Thu Jan 24 17:25:17 2008
@@ -47,6 +47,8 @@
           'wrapper',
         File::Spec->catfile( $dir, 'bin', 'shipwright-builder' ) => 'builder',
         File::Spec->catfile( $dir, 'bin', 'shipwright-utility' ) => 'utility',
+        File::Spec->catfile( $dir, 'bin', 'shipwright-installed-utility' ) =>
+          'installed-utility',
         File::Spec->catfile( $dir, 't',   'test' )               => 'null',
         File::Spec->catfile( $dir, 'shipwright', 'order.yml' ) => 'null',
     );
@@ -66,8 +68,9 @@
     );
 
     for (
-        'bin/shipwright-builder',        'bin/shipwright-utility',
-        'etc/shipwright-script-wrapper', 't/test'
+        'bin/shipwright-builder',           'bin/shipwright-utility',
+        'bin/shipwright-installed-utility', 'etc/shipwright-script-wrapper',
+        't/test'
       )
     {
         $self->propset(
@@ -302,9 +305,9 @@
     my $dist    = $args{dist};
 
     my ($string) = Shipwright::Util->run(
-        [ 'svn', 'cat', $self->repository . "/scripts/$_/require.yml" ] );
+        [ 'svn', 'cat', $self->repository . "/scripts/$_/require.yml" ], 1 );
 
-    my $req = Shipwright::Config::Load($string);
+    my $req = Shipwright::Config::Load($string) || {};
 
     if ( $req->{requires} ) {
         for (qw/requires recommends build_requires/) {