[Bps-public-commit] r10434 - in Text-Quoted: bin dists etc scripts shipwright
ruz at bestpractical.com
ruz at bestpractical.com
Tue Jan 22 15:46:04 EST 2008
Author: ruz
Date: Tue Jan 22 15:46:04 2008
New Revision: 10434
Added:
Text-Quoted/bin/
Text-Quoted/bin/shipwright-builder
Text-Quoted/bin/shipwright-utility
Text-Quoted/dists/
Text-Quoted/etc/
Text-Quoted/etc/shipwright-script-wrapper
Text-Quoted/scripts/
Text-Quoted/shipwright/
Text-Quoted/shipwright/order.yml
Text-Quoted/t/
Text-Quoted/t/test
Log:
'created project'
Added: Text-Quoted/bin/shipwright-builder
==============================================================================
--- (empty file)
+++ Text-Quoted/bin/shipwright-builder Tue Jan 22 15:46:04 2008
@@ -0,0 +1,212 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+use File::Spec;
+use File::Temp qw/tempdir/;
+use File::Copy qw/move copy/;
+use File::Find qw/find/;
+use Config;
+use Getopt::Long;
+use Cwd;
+
+my $build_base = getcwd;
+
+my %args;
+GetOptions( \%args, 'install-base=s', 'perl=s', 'skip=s', 'skip-test',
+ 'only-test' );
+
+unlink 'build.log' if -e 'build.log';
+open my $log, '>', 'build.log' or die $!;
+
+unless ( $args{'install-base'} ) {
+ $args{'install-base'} = tempdir;
+ print $log "no default install-base, will set it to $args{'install-base'}\n";
+}
+
+if ( grep { $_ eq 'perl' } @$order ) {
+ $args{perl} = File::Spec->catfile($args{'install-base'}, 'bin', 'perl');
+}
+else {
+ $args{perl} = $^X;
+}
+
+$args{skip} = [ split /,\s*/, $args{skip} || '' ];
+
+{
+ no warnings 'uninitialized';
+ $ENV{DYLD_LIBRARY_PATH} =
+ File::Spec->catfile( $args{'install-base'}, 'lib' ) . ':'
+ . $ENV{DYLD_LIBRARY_PATH};
+ $ENV{LD_LIBRARY_PATH} =
+ File::Spec->catfile( $args{'install-base'}, 'lib' ) . ':'
+ . $ENV{LD_LIBRARY_PATH};
+ $ENV{PERL5LIB} =
+ File::Spec->catfile( $args{'install-base'}, 'lib', 'perl5' ) . ':'
+ . $ENV{PERL5LIB};
+ $ENV{PATH} =
+ File::Spec->catfile( $args{'install-base'}, 'bin' ) . ':'
+ . File::Spec->catfile( $args{'install-base'}, 'sbin' ) . ':'
+ . $ENV{PATH};
+ $ENV{PERL_MM_USE_DEFAULT} = 1;
+}
+
+if ( $args{'only-test'} ) {
+ test();
+}
+else {
+ mkdir $args{'install-base'} unless -e $args{'install-base'};
+
+ mkdir File::Spec->catfile( $args{'install-base'}, 'etc' )
+ unless -e File::Spec->catfile( $args{'install-base'}, 'etc' );
+
+ copy(
+ File::Spec->catfile( 'etc', 'shipwright-script-wrapper' ),
+ File::Spec->catfile(
+ $args{'install-base'}, 'etc', 'shipwright-script-wrapper'
+ )
+ );
+
+ my $order = parse_order( File::Spec->catfile( 'shipwright', 'order.yml' ) );
+
+ for my $dist (@$order) {
+ unless ( grep { $dist eq $_ } @{ $args{skip} } ) {
+ install($dist);
+ }
+ chdir $build_base;
+ }
+
+ 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";
+}
+
+sub install {
+ my $dir = shift;
+
+ my @cmds;
+ {
+ open my $fh, '<', File::Spec->catfile( 'scripts', $dir, 'build' )
+ or die $!;
+ @cmds = <$fh>;
+ close $fh;
+ chomp @cmds;
+ @cmds = map { substitute($_) } @cmds;
+ }
+
+ chdir File::Spec->catfile( 'dists', $dir );
+
+ for (@cmds) {
+ my ( $type, $cmd );
+ next unless /\S/;
+
+ if (/^(\S+):\s*(.*)/) {
+ $type = $1;
+ $cmd = $2;
+ }
+ else {
+ $type = '';
+ $cmd = $_;
+ }
+
+ if ( $args{'skip-test'} && $type eq 'test' ) {
+ print $log "skip build $type part in $dir\n";
+ next;
+ }
+
+ print $log "build $type part in $dir with cmd: $cmd\n";
+
+ print "we'll run the cmd: $cmd\n";
+ if ( system($cmd) ) {
+ print $log "build $dir with failure when run $type: $!\n";
+ die "build $dir with failure when run $type: $!\n";
+ }
+ }
+
+ print $log "build $dir with success!\n";
+}
+
+sub wrap_bin {
+ my $self = shift;
+
+ my %seen;
+
+ my $sub = sub {
+ my $file = $_;
+ return unless $file and -f $file;
+ return if $seen{$File::Find::name}++;
+ my $dir = ( File::Spec->splitdir($File::Find::dir) )[-1];
+ mkdir File::Spec->catfile( $args{'install-base'}, "$dir-wrapped" )
+ unless -d File::Spec->catfile( $args{'install-base'},
+ "$dir-wrapped" );
+ move( $file =>
+ File::Spec->catfile( $args{'install-base'}, "$dir-wrapped" ) )
+ or die $!;
+ symlink File::Spec->catfile( '..', 'etc',
+ 'shipwright-script-wrapper' ) => $file
+ or die $!;
+ chmod 0755, $file;
+ };
+
+ my @dirs =
+ grep { -d $_ }
+ map { File::Spec->catfile( $args{'install-base'}, $_ ) }
+ qw/bin sbin libexec/;
+ find( $sub, @dirs ) if @dirs;
+
+}
+
+sub substitute {
+ my $text = shift;
+ return unless $text;
+
+ my $perl = $args{'perl'};
+ my $install_base = $args{'install-base'};
+ $text =~ s/%%PERL%%/$perl/g;
+ $text =~ s/%%INSTALL_BASE%%/$install_base/g;
+ return $text;
+}
+
+sub parse_order {
+ my $file = shift;
+ my $order = [];
+ open my $fh, '<', $file or die $!;
+ while (<$fh>) {
+ if (/^- (\S+)/) {
+ push @$order, $1;
+ }
+ }
+ return $order;
+}
+
+sub test {
+
+ my @cmds;
+ {
+ open my $fh, '<', File::Spec->catfile( 't', 'test' )
+ or die $!;
+ @cmds = <$fh>;
+ close $fh;
+ chomp @cmds;
+ @cmds = map { substitute($_) } @cmds;
+ }
+
+ for (@cmds) {
+ my ( $type, $cmd );
+ next unless /\S/;
+
+ if (/^(\S+):\s*(.*)/) {
+ $type = $1;
+ $cmd = $2;
+ }
+ else {
+ $type = '';
+ $cmd = $_;
+ }
+
+ print "run tests $type with cmd: $cmd\n";
+ system($cmd) && die "something wrong when execute $cmd: $?";
+ }
+
+}
+
Added: Text-Quoted/bin/shipwright-utility
==============================================================================
--- (empty file)
+++ Text-Quoted/bin/shipwright-utility Tue Jan 22 15:46:04 2008
@@ -0,0 +1,70 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Getopt::Long;
+use YAML::Syck;
+
+my %args;
+GetOptions( \%args, 'update-order', 'keep-requires=s', 'keep-recommends=s',
+ 'keep-build-requires=s', 'for-dists=s' );
+
+if ( $args{'update-order'} ) {
+ for ( 'keep-requires', 'keep-recommends', 'keep-build-requires' ) {
+ $args{$_} = 1 unless defined $args{$_};
+ }
+
+ my @dists = split /,\s*/, $args{'for-dists'};
+ unless (@dists) {
+ my $out = `ls scripts`;
+ my $sep = $/;
+ @dists = split /$sep/, $out;
+ chomp @dists;
+ s{/$}{} for @dists;
+ }
+
+ my $require = {};
+
+ for (@dists) {
+ fill_deps( %args, require => $require, dist => $_ );
+ }
+
+ require Algorithm::Dependency::Ordered;
+ require Algorithm::Dependency::Source::HoA;
+
+ my $source = Algorithm::Dependency::Source::HoA->new($require);
+ $source->load();
+ my $dep = Algorithm::Dependency::Ordered->new( source => $source, )
+ or die $@;
+ my $order = $dep->schedule_all();
+ DumpFile( 'shipwright/order.yml', $order );
+}
+
+sub fill_deps {
+ my %args = @_;
+ my $require = $args{require};
+ my $dist = $args{dist};
+
+ my $string;
+ my $req = LoadFile("scripts/$dist/require.yml");
+
+ if ( $req->{requires} ) {
+ for (qw/requires recommends build_requires/) {
+ my $arg = "keep-$_";
+ $arg =~ s/_/-/g;
+ push @{ $require->{$dist} }, keys %{ $req->{$_} }
+ if $args{$arg};
+ }
+ }
+ else {
+
+ #for back compatbility
+ push @{ $require->{$dist} }, keys %$req;
+ }
+
+ for my $dep ( @{ $require->{$dist} } ) {
+ next if $require->{$dep};
+ fill_deps( %args, dist => $dep );
+ }
+}
+
Added: Text-Quoted/etc/shipwright-script-wrapper
==============================================================================
--- (empty file)
+++ Text-Quoted/etc/shipwright-script-wrapper Tue Jan 22 15:46:04 2008
@@ -0,0 +1,22 @@
+#!/bin/sh
+if [ -z `which readlink` ]; then
+ # if we don't have readlink, we're on some pitiful platform like solaris
+ test -h $0 && LINK=`ls -l $0 | awk -F\> '{print $NF}'`
+else
+ LINK=`readlink $0`
+fi
+
+if [ $LINK = '../etc/shipwright-script-wrapper' ]; then
+ BASE=$0
+ BASE_DIR=`dirname "$BASE"`
+ BASE_DIR=` (cd "$BASE_DIR"; pwd) `
+ FILENAME=`basename "$BASE"`
+ WRAPPED_DIR=`basename "$BASE_DIR"`
+ ARCHNAME=`perl -MConfig -e 'print $Config{archname}'`
+ PERL5LIB=${BASE_DIR}/../lib/perl5/site_perl:${BASE_DIR}/../lib/perl5:${PERL5LIB}\
+ LD_LIBRARY_PATH=${BASE_DIR}/../lib:${LD_LIBRARY_PATH}\
+ DYLD_LIBRARY_PATH=${BASE_DIR}/../lib:${DYLD_LIBRARY_PATH}\
+ exec ${BASE_DIR}/../${WRAPPED_DIR}-wrapped/${FILENAME} "$@"
+else
+ exec $LINK "$@"
+fi
Added: Text-Quoted/shipwright/order.yml
==============================================================================
Added: Text-Quoted/t/test
==============================================================================
More information about the Bps-public-commit
mailing list