Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Added register methods to L::B::P

  • Loading branch information...
commit 3fbcb8ff0e279188651609a699c77fb3f59da7ff 1 parent c579c71
@Leont authored
Showing with 58 additions and 35 deletions.
  1. +1 −1  Build.PL
  2. +57 −34 inc/Library/Build/PL.pm
View
2  Build.PL
@@ -7,7 +7,7 @@ use Library::Build::PL;
my $VERSION = 0.003;
-my $buildpl = Library::Build::PL->new(name => 'libperl++', version => $VERSION, mixin => [ 'Perlpp::Build' ], inc => [ qw/inc lib/ ]);
+my $buildpl = Library::Build::PL->new(name => 'libperl++', version => $VERSION, mixin => [ 'Perlpp::Build' ], inc => [ qw/inc/ ]);
$buildpl->check_cplusplus;
$buildpl->write_build;
$buildpl->write_mymeta;
View
91 inc/Library/Build/PL.pm
@@ -5,57 +5,56 @@ use warnings FATAL => 'all';
our $VERSION = '0.003';
+use B::Deparse;
use Carp qw/croak/;
use Data::Dumper;
use File::Copy qw/copy/;
-use File::Spec::Functions 'catfile';
+use File::Spec::Functions qw/catfile/;
use FindBin;
+my %registries = (
+ dirty_files => 'register_dirty',
+ install_paths => 'register_paths',
+);
+
sub new {
my ($class, @args) = @_;
my %args = (
- mixin => [],
- argv => \@ARGV,
- inc => [ 'inc' ],
- version => '0.001',
- extra => '',
+ argv => \@ARGV,
@args
);
- $args{filename} ||= do {
- my $filename = $FindBin::Script;
- $filename =~ s/\.PL$// or croak "Can't parse filefilename '$filename'";
- $filename;
- };
return bless \%args, $class;
}
sub write_build {
- my ($self, @args) = @_;
+ my $self = shift;
+ my $filename = shift || "$FindBin::Bin/Build";
- open my $fh, '>', $self->{filename} or die "Can't open file '$self->{filename}': $!\n";
+ open my $fh, '>', $filename or die "Can't open file '$filename': $!\n";
- my $arguments = Dumper($self->{argv});
local $Data::Dumper::Terse = 1;
local $Data::Dumper::Indent = 0;
- my $inc = join ', ', Dumper(@{$self->{inc}});
- my $mixin = join ', ', Dumper(@{$self->{mixin}});
- print {$fh} <<"EOF";# or croak 'Can\'t write Build: $!';
-#! $^X
-
-use strict;
-use warnings;
-
-use lib $inc;
-use Library::Build;
-my \$module = '$self->{name}';
-my \$version = '$self->{version}';
-
-my \$builder = Library::Build->new(\$module, \$version, { argv => \\\@ARGV, cached => $arguments });
-\$builder->mixin($mixin);
-\$builder->dispatch_default();
-$self->{extra}
-EOF
-
+ print {$fh} "$_\n" for ("#! $^X", '', 'use strict;', 'use warnings;');
+ printf {$fh} "use lib %s;\n", join ', ', Dumper(@{$self->{inc}}) if $self->{inc};
+ print {$fh} "use Library::Build;\n";
+ print {$fh} "use $_;\n" for @{$self->{use}};
+ print {$fh} "\n";
+
+ printf {$fh} "my \$builder = Library::Build->new('$self->{name}', '$self->{version}', { argv => \\\@ARGV, cached => %s });\n", Dumper($self->{argv});
+ printf {$fh} "\$builder->mixin(%s);\n", join ', ', Dumper(@{$self->{mixin}}) if $self->{mixin};
+ if (defined $self->{action_map}) {
+ my $deparser = B::Deparse->new;
+ while (my ($key, $subs) = each %{$self->{action_map}}) {
+ for my $sub (@{$subs}) {
+ printf {$fh} "\$builder->register_actions(%s => sub %s);\n", $key, $deparser->coderef2text($sub);
+ }
+ }
+ }
+ while (my ($key, $method) = each %registries) {
+ printf {$fh} "\$builder->$method(%%{ %s });\n", Dumper($self->{$key}) if defined $self->{$key};
+ }
+ print {$fh} "$self->{extra}\n" if $self->{extra};
+ print {$fh} "\$builder->dispatch_default();\n";
my $current_mode = (stat $fh)[2] or croak "Can't stat '$self->{filename}': $!\n";
chmod $current_mode | oct(111), $fh or croak "Can't make '$self->{filename}' executable: $!\n";
close $fh or die "Can't close filehandle: $!\n";
@@ -66,7 +65,7 @@ EOF
sub write_mymeta {
my $self = shift;
my $base = shift || $FindBin::Bin;
- copy(catfile($FindBin::Bin, 'META.yml'), catfile($FindBin::Bin, 'MYMETA.yml'));
+ copy(catfile($FindBin::Bin, 'META.yml'), catfile($base, 'MYMETA.yml'));
return;
}
@@ -86,4 +85,28 @@ sub check_cplusplus {
return;
}
+sub register_dirty {
+ my ($self, %files_map) = @_;
+ while (my ($category, $files) = each %files_map) {
+ push @{ $self->{dirty_files}{$category} }, @{$files};
+ }
+ return;
+}
+
+sub register_actions {
+ my ($self, %action_map) = @_;
+ while (my ($name, $sub) = each %action_map) {
+ push @{ $self->{action_map}{$name} }, $sub;
+ }
+ return;
+}
+
+sub register_paths {
+ my ($self, %paths) = @_;
+ while (my ($source, $destination) = each %paths) {
+ $self->{install_paths}{$source} = $destination;
+ }
+ return;
+}
+
1;
Please sign in to comment.
Something went wrong with that request. Please try again.