view release on metacpan or  search on metacpan

lib/Test/Alien/Diag.pm  view on Meta::CPAN

package Test::Alien::Diag;

use strict;
use warnings;
use 5.008004;
use Test2::API qw( context );
use Exporter qw( import );

our @EXPORT = qw( alien_diag );
our @EXPORT_OK = @EXPORT;

# ABSTRACT: Print out standard diagnostic for Aliens in the test step.
our $VERSION = '2.84'; # VERSION


my @default_scalar_properties = qw(
  cflags cflags_static libs libs_static version install_type
);

my @default_list_properties = qw(
  dynamic_libs bin_dir
);

sub alien_diag ($@)
{
  my $ctx = context();

  my %options = defined $_[-1] && ref($_[-1]) eq 'HASH' ?  %{ pop @_ } : ();

  my @extra_properties      = @{ delete $options{properties}      || [] };
  my @extra_list_properties = @{ delete $options{list_properties} || [] };

  my $max = 0;
  foreach my $alien (@_)
  {
    foreach my $name (@default_scalar_properties, @default_list_properties, @extra_properties, @extra_list_properties)
    {
      if(eval { $alien->can($name) })
      {
        my $str = "$alien->$name";
        if(length($str) > $max)
        {
          $max = length($str);
        }
      }
    }
  }


  $ctx->diag('');

  if(%options)
  {
    my @extra = sort keys %options;
    $ctx->diag("warning: unknown option@{[ @extra > 1 ? 's' : '' ]} for alien_diag: @extra");
    $ctx->diag("(you should check for typos or maybe upgrade to a newer version of Alien::Build)");
  }


  foreach my $alien (@_) {
    $ctx->diag('') for 1..2;

    my $found = 0;

    foreach my $name (sort(@default_scalar_properties, @extra_properties))
    {
      if(eval { $alien->can($name) })
      {
        $found++;
        my $value = $alien->$name;
        $value = '[undef]' unless defined $value;
        $ctx->diag(sprintf "%-${max}s = %s", "$alien->$name", $value);
      }
    }

    foreach my $name (sort(@default_list_properties, @extra_list_properties))
    {
      if(eval { $alien->can($name) })
      {
        $found++;
        my @list = eval { $alien->$name };
        next if $@;
        $ctx->diag(sprintf "%-${max}s = %s", "$alien->$name", $_) for @list;
      }
    }

    $ctx->diag("no diagnostics found for $alien") unless $found;
  }

  $ctx->diag('') for 1..2;

  $ctx->release;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME