view release on metacpan or  search on metacpan

lib/Acme/ReturnValue.pm  view on Meta::CPAN

            say $@;
        }
        rmtree($dir);
    }

    # remove old data files
    foreach my $del (keys %old_files) {
        unlink($out->file($del)) || die $!;
    }

}


sub in_INC {
    my $self=shift;
    foreach my $dir (@INC) {
        $self->in_dir($dir,"INC_$dir");
    }
}


sub in_dir {
    my ($self,$dir,$dumpname)=@_;
    $dumpname ||= $dir;
    $dumpname=~s/\//_/g;

    say $dumpname unless $self->quiet;

    $self->interesting([]);
    $self->bad([]);
    my @pms;
    find(sub {
        return unless /\.pm\z/;
        return if $File::Find::name=~/\/x?t\//;
        return if $File::Find::name=~/\/inc\//;
        push(@pms,$File::Find::name);
    },$dir);

    foreach my $pm (@pms) {
        $self->in_file($pm);
    }

    my $dump=Path::Class::Dir->new($self->dump_to)->file($dumpname.".json");
    if ($self->interesting && @{$self->interesting}) {
        $dump->spew(iomode => '>:encoding(UTF-8)', $self->json_encoder->encode($self->interesting));
    }
    elsif ($self->bad && @{$self->bad}) {
        $dump->spew(iomode => '>:encoding(UTF-8)', $self->json_encoder->encode($self->bad));
    }
    else {
        $dump->spew('{"is_boring":"1"}');
    }
}


sub in_file {
    my ($self,$file)=@_;

    eval { $self->waste_some_cycles($file) };
    if ($@) {
        push (@{$self->failed},{file=>$file,error=>$@});
    }
}

"let's return a strange value from Riga";

__END__

=pod

=encoding UTF-8

=head1 NAME

Acme::ReturnValue - report interesting return values

=head1 VERSION

version 1.004

=head1 SYNOPSIS

    use Acme::ReturnValue;
    my $rvs = Acme::ReturnValue->new;
    $rvs->in_INC;
    foreach (@{$rvs->interesting}) {
        say $_->{package} . ' returns ' . $_->{value};
    }

=head1 DESCRIPTION

C<Acme::ReturnValue> will list 'interesting' return values of modules.
'Interesting' means something other than '1'.

See L<https://returnvalues.plix.at|https://returnvalues.plix.at> for the results of running Acme::ReturnValue on the whole CPAN.

=head2 METHODS

=head3 run

run from the commandline (via F<acme_returnvalue.pl>

=head3 waste_some_cycles

    my $data = $arv->waste_some_cycles( '/some/module.pm' );

C<waste_some_cycles> parses the passed in file using PPI. It tries to
get the last statement and extract it's value.

C<waste_some_cycles> returns a hash with following keys

=over

=item * file

The file

=item * package

The package defintion (the first one encountered in the file

=item * value

The return value of that file

=back

C<waste_some_cycles> will also put this data structure into
L<interesting> or L<boring>.

You might want to pack calls to C<waste_some_cycles> into an C<eval>
because PPI dies on parse errors.

=head4 _is_code

Stolen directly from Perl::Critic::Policy::Modules::RequireEndWithOne
as suggested by Chris Dolan.

Thanks!

=head3 in_CPAN

Analyse CPAN. Needs a local CPAN mirror

=head3 in_INC

    $arv->in_INC;

Collect return values from all F<*.pm> files in C<< @INC >>.

=head3 in_dir

    $arv->in_dir( $some_dir );

Collect return values from all F<*.pm> files in C<< $dir >>.

=head3 in_file

    $arv->in_file( $some_file );

Collect return value from the passed in file.

If L<waste_some_cycles> failed, puts information on the failing file into L<failed>.

=head3 interesting

Returns an ARRAYREF containing 'interesting' modules.

=head3 boring

Returns an ARRAYREF containing 'boring' modules.

=head3 failed

Returns an ARRAYREF containing unparsable modules.

=head1 BUGS

Probably many, because I'm not sure I master PPI yet.

=head1 AUTHOR

Thomas Klausner <domm@plix.at>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 - 2021 by Thomas Klausner.

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