package Alien::Build::Plugin::Test::Mock;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Carp ();
use Path::Tiny ();
use File::chdir;
# ABSTRACT: Mock plugin for testing
our $VERSION = '2.84'; # VERSION
has 'probe';
has 'download';
has 'extract';
has 'build';
has 'gather';
has check_digest => 1;
sub init
{
my($self, $meta) = @_;
if(my $probe = $self->probe)
{
if($probe =~ /^(share|system)$/)
{
$meta->register_hook(
probe => sub {
$probe;
},
);
}
elsif($probe eq 'die')
{
$meta->register_hook(
probe => sub {
die "fail";
},
);
}
else
{
Carp::croak("usage: plugin 'Test::Mock' => ( probe => $probe ); where $probe is one of share, system or die");
}
}
if(my $download = $self->download)
{
$download = { 'foo-1.00.tar.gz' => _tarball() } unless ref $download eq 'HASH';
$meta->register_hook(
download => sub {
my($build) = @_;
_fs($build, $download, 1);
},
);
}
if(my $extract = $self->extract)
{
$extract = {
'foo-1.00' => {
'configure' => _tarball_configure(),
'foo.c' => _tarball_foo_c(),
},
} unless ref $extract eq 'HASH';
$meta->register_hook(
extract => sub {
my($build) = @_;
_fs($build, $extract);
},
);
}
if(my $build = $self->build)
{
$build = [
{
'foo.o', => _build_foo_o(),
'libfoo.a' => _build_libfoo_a(),
},
{
'lib' => {
'libfoo.a' => _build_libfoo_a(),
'pkgconfig' => {
'foo.pc' => sub {
my($build) = @_;
"prefix=$CWD\n" .
"exec_prefix=\${prefix}\n" .
"libdir=\${prefix}/lib\n" .
"includedir=\${prefix}/include\n" .
"\n" .
"Name: libfoo\n" .
"Description: libfoo\n" .
"Version: 1.0.0\n" .
"Cflags: -I\${includedir}\n" .
"Libs: -L\${libdir} -lfoo\n";
},
},
},
},
] unless ref $build eq 'ARRAY';
my($build_dir, $install_dir) = @$build;
$meta->register_hook(
build => sub {
my($build) = @_;
_fs($build, $build_dir);
local $CWD = $build->install_prop->{prefix};
_fs($build, $install_dir);
},
);
}
if(my $gather = $self->gather)
{
$meta->register_hook(
$_ => sub {
my($build) = @_;
if(ref $gather eq 'HASH')
{
foreach my $key (keys %$gather)
{
$build->runtime_prop->{$key} = $gather->{$key};
}
}
else
{
my $prefix = $build->runtime_prop->{prefix};
$build->runtime_prop->{cflags} = "-I$prefix/include";
$build->runtime_prop->{libs} = "-L$prefix/lib -lfoo";
}
},
) for qw( gather_share gather_system );
}
if(my $cd = $self->check_digest)
{
$meta->register_hook(
check_digest => ref($cd) eq 'CODE' ? $cd : sub {
my($build, $file, $algorithm, $digest) = @_;
if($algorithm ne 'FOO92')
{
return 'FAKE';
}
if($digest eq 'deadbeaf')
{
return 1;
}
else
{
die "Digest FAKE does not match: got deadbeaf, expected $digest";
}
}
);
$meta->register_hook(
check_download => sub {
my($build) = @_;
my $path = $build->install_prop->{download};
if(defined $path)
{
$build->check_digest($path);
}
},
);
}
}
sub _fs
{
my($build, $hash, $download) = @_;
foreach my $key (sort keys %$hash)
{
my $val = $hash->{$key};
if(ref $val eq 'HASH')
{
mkdir $key;
local $CWD = $key;
_fs($build,$val);
}
elsif(ref $val eq 'CODE')
{
my $path = Path::Tiny->new($key)->absolute;
$path->spew_raw($val->($build));
if($download)
{
$build->install_prop->{download_detail}->{"$path"}->{protocol} = 'file';
$build->install_prop->{download_detail}->{"$path"}->{digest} = [ FAKE => 'deadbeaf' ];
}
}
elsif(defined $val)
{
my $path = Path::Tiny->new($key)->absolute;
$path->spew_raw($val);
if($download)
{
$build->install_prop->{download_detail}->{"$path"}->{protocol} = 'file';
$build->install_prop->{download_detail}->{"$path"}->{digest} = [ FAKE => 'deadbeaf' ];
}
}
}
}
sub _tarball
{
return unpack 'u', <<'EOF';
M'XL(`+DM@5@``^V4P4K$,!"&>YZGF-V]J*SM9#=)#RN^B'BHV;0)U`32U(OX
M[D;0*LJREZVRF.\R?TA@)OS\TWI_S4JBJI@/(JJ%P%19+>AKG4"V)4Z;C922
M(;T=6(%BQIDFQB$V(8WB^]X.W>%WQ^[?_S'5,Z']\%]YU]IN#/KT/8[ZO^6?
M_B=-C-=<%$BG'^4G_]S_U:)ZL*X:#(!6QN/26(Q&![W
M'BD/DO/#^6W@)2^*3":3.3]>`:%LBYL`#@``
`
EOF
}
sub _tarball_configure
{
return unpack 'u', <<'EOF';
<(R$O8FEN+W-H"@IE8VAO(")H:2!T:&5R92(["@``
`
EOF
}
sub _tarball_foo_c
{
return unpack 'u', <<'EOF';
M(VEN8VQU9&4@/'-T9&EO+F@^"@II;G0*;6%I;BAI;G0@87)G8RP@8VAA'0`````````````7U]415A4````````````
M````````````"`````````#0`0``!`````````````````0`@```````````
M`````%]?8V]M<&%C=%]U;G=I;F1?7TQ$````````````````"``````````@
M`````````-@!```#````.`(```$````````"````````````````7U]E:%]F
ME(``7@0`1`,!PB0`0``)````!P```"X____
M_____P@``````````$$.$(8"0PT&```````````````!```&`0````\!````
/``````````!?;6%I;@``
`
EOF
}
sub _build_libfoo_a
{
return unpack 'u', <<'EOF';
M(3QA (
probe => 'share',
download => 1,
extract => 1,
build => 1,
gather => 1,
);
=head1 DESCRIPTION
This plugin is used for testing L plugins. Usually you only want to test
one or two phases in an L for your plugin, but you still have to have a fully
formed L that contains all required phases. This plugin lets you fill in the
other phases with the appropriate hooks. This is usually better than using real plugins
which may pull in additional dynamic requirements that you do not want to rely on at
test time.
=head1 PROPERTIES
=head2 probe
plugin 'Test::Mock' => (
probe => $probe,
);
Override the probe behavior by one of the following:
=over
=item share
For a C build.
=item system
For a C build.
=item die
To throw an exception in the probe hook. This will usually cause L
to try the next probe hook, if available, or to assume a C install.
=back
=head2 download
plugin 'Test::Mock' => (
download => \%fs_spec,
);
plugin 'Test::Mock' => (
download => 1,
);
Mock out a download. The C<%fs_spec> is a hash where the hash values are directories
and the string values are files. This a spec like this:
plugin 'Test::Mock' => (
download => {
'foo-1.00' => {
'README.txt' => "something to read",
'foo.c' => "#include \n",
"int main() {\n",
" printf(\"hello world\\n\");\n",
"}\n",
}
},
);
Would generate two files in the directory 'foo-1.00', a C and a C file named C.
The default, if you provide a true non-hash value is to generate a single tarball with the name
C.
=head2 extract
plugin 'Test::Mock' => (
extract => \%fs_spec,
);
plugin 'Test::Mock' => (
extract => 1,
);
Similar to C above, but for the C phase.
=head2 build
plugin 'Test::Mock' => (
build => [ \%fs_spec_build, \%fs_spec_install ],
);
plugin 'Test::Mock' => (
build => 1,
);
=head2 gather
plugin 'Test::Mock' => (
gather => \%runtime_prop,
);
plugin 'Test::Mock' => (
gather => 1,
);
This adds a gather hook (for both C and C) that adds the given runtime properties, or
if a true non-hash value is provided, some reasonable runtime properties for testing.
=head2 check_digest
plugin 'Test::Mock' => (
check_digest => 1, # the default
);
This adds a check_digest hook that uses fake algorithm FAKE that hashes everything to C.
The mock download above will set the digest for download_details so that this will pass the
signature check.
plugin 'Test::Mock' => (
check_digest => sub {
my($build, $file, $algo, $digest) = @_;
...
},
);
If you give it a code reference then you can write your own faux digest. See the
L in
L for details.
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut