[Bps-public-commit] r10389 - in bpsbuilder/BPB/lib/BPB: .

[sunnavy at bestpractical.com]

Author: sunnavy
Date: Fri Jan 18 09:37:13 2008
New Revision: 10389

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

Log:
added bpb-utility script, mainly for regenerate order stuff, also refactor a bit

Modified: bpsbuilder/BPB/lib/BPB/Backend.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Backend.pm	(original)
+++ bpsbuilder/BPB/lib/BPB/Backend.pm	Fri Jan 18 09:37:13 2008
@@ -52,6 +52,80 @@
 EOF
   ;
 
+our $UTILITY = <<'EOF'
+#!/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( 'bpb/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 );
+    }
+}
+
+EOF
+  ;
+
 our $BUILDER = <<'EOF'
 #!/usr/bin/env perl
 use warnings;
@@ -266,6 +340,8 @@
 
 EOF
   ;
+
+our $NULL = ''; # just for convience
 1;
 
 __END__

Modified: bpsbuilder/BPB/lib/BPB/Backend/SVK.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Backend/SVK.pm	(original)
+++ bpsbuilder/BPB/lib/BPB/Backend/SVK.pm	Fri Jan 18 09:37:13 2008
@@ -41,20 +41,22 @@
     for (qw/bpb dists etc bin scripts t/) {
         mkdir File::Spec->catfile( $dir, $_ );
     }
-    open my $order, '>', File::Spec->catfile( $dir, 'bpb', 'order.yml' );
-    close $order;
 
-    open my $wrapper, '>',
-      File::Spec->catfile( $dir, 'etc', 'bpb-script-wrapper' );
-    print $wrapper $BPB::Backend::WRAPPER;
-    close $wrapper;
-
-    open my $builder, '>', File::Spec->catfile( $dir, 'bin', 'bpb-builder' );
-    print $builder $BPB::Backend::BUILDER;
-    close $builder;
+    my %map = (
+        File::Spec->catfile( $dir, 'etc', 'bpb-script-wrapper' ) => 'WRAPPER',
+        File::Spec->catfile( $dir, 'bin', 'bpb-builder' )        => 'BUILDER',
+        File::Spec->catfile( $dir, 'bin', 'bpb-utility' )        => 'UTILITY',
+        File::Spec->catfile( $dir, 't',   'test' )               => 'NULL',
+        File::Spec->catfile( $dir, 'bpb', 'order.yml' )          => 'NULL',
+    );
 
-    open my $t, '>', File::Spec->catfile( $dir, 't', 'test' );
-    close $t;
+    for ( keys %map ) {
+        no strict 'refs';
+        open my $fh, '>', $_ or die "can't open file $_: $!";
+        my $name = "BPB::Backend::$map{$_}";
+        print $fh $$name;
+        close $fh;
+    }
 
     $self->delete;    # clean repository in case it exists
     $self->log->info( 'initialize ' . $self->repository );
@@ -63,7 +65,11 @@
         _initialize => 1,
         comment     => 'created project',
     );
-    for ( 'bin/bpb-builder', 'etc/bpb-script-wrapper', 't/test' ) {
+    for (
+        'bin/bpb-builder',        'bin/bpb-utility',
+        'etc/bpb-script-wrapper', 't/test'
+      )
+    {
         $self->propset(
             path  => $_,
             type  => 'svn:executable',

Modified: bpsbuilder/BPB/lib/BPB/Backend/SVN.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Backend/SVN.pm	(original)
+++ bpsbuilder/BPB/lib/BPB/Backend/SVN.pm	Fri Jan 18 09:37:13 2008
@@ -41,20 +41,22 @@
     for (qw/bpb dists etc bin scripts t/) {
         mkdir File::Spec->catfile( $dir, $_ );
     }
-    open my $order, '>', File::Spec->catfile( $dir, 'bpb', 'order.yml' );
-    close $order;
 
-    open my $wrapper, '>',
-      File::Spec->catfile( $dir, 'etc', 'bpb-script-wrapper' );
-    print $wrapper $BPB::Backend::WRAPPER;
-    close $wrapper;
-
-    open my $builder, '>', File::Spec->catfile( $dir, 'bin', 'bpb-builder' );
-    print $builder $BPB::Backend::BUILDER;
-    close $builder;
+    my %map = (
+        File::Spec->catfile( $dir, 'etc', 'bpb-script-wrapper' ) => 'WRAPPER',
+        File::Spec->catfile( $dir, 'bin', 'bpb-builder' )        => 'BUILDER',
+        File::Spec->catfile( $dir, 'bin', 'bpb-utility' )        => 'UTILITY',
+        File::Spec->catfile( $dir, 't',   'test' )               => 'NULL',
+        File::Spec->catfile( $dir, 'bpb', 'order.yml' )          => 'NULL',
+    );
 
-    open my $t, '>', File::Spec->catfile( $dir, 't', 'test' );
-    close $t;
+    for ( keys %map ) {
+        no strict 'refs';
+        open my $fh, '>', $_ or die "can't open file $_: $!";
+        my $name = "BPB::Backend::$map{$_}";
+        print $fh $$name;
+        close $fh;
+    }
 
     $self->delete;    # clean repository in case it exists
     $self->log->info( 'initialize ' . $self->repository );
@@ -64,7 +66,11 @@
         _initialize => 1,
     );
 
-    for ( 'bin/bpb-builder', 'etc/bpb-script-wrapper', 't/test' ) {
+    for (
+        'bin/bpb-builder',        'bin/bpb-utility',
+        'etc/bpb-script-wrapper', 't/test'
+      )
+    {
         $self->propset(
             path  => $_,
             type  => 'svn:executable',