view release on metacpan or  search on metacpan

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

    my $self = shift;

    if ($self->inc) {
        $self->in_INC;
    }
    elsif ($self->dir) {
        $self->in_dir($self->dir);
    }
    elsif ($self->file) {
        $self->in_file($self->file);
    }
    elsif ($self->cpan) {
        $self->in_CPAN($self->cpan,$self->dump_to);
        exit;
    }
    else {
        $self->in_dir('.');
    }

    my $interesting=$self->interesting;
    if (@$interesting > 0) {
        foreach my $cool (@$interesting) {
            say $cool->{package} .': '.$cool->{value};
        }
    }
    else {
        say "boring!";
    }
}


sub waste_some_cycles {
    my ($self, $filename) = @_;

    my $doc = PPI::Document->new($filename);

    eval {  # I don't care if that fails...
        $doc->prune('PPI::Token::Comment');
        $doc->prune('PPI::Token::Pod');
    };

    my @packages=$doc->find('PPI::Statement::Package');
    my $this_package;

    foreach my $node ($packages[0][0]->children) {
        if ($node->isa('PPI::Token::Word')) {
            $this_package = $node->content;
        }
    }

    my @significant = grep { _is_code($_) } $doc->schildren();
    my $match = $significant[-1];
    my $rv=$match->content;
    $rv=~s/\s*;$//;
    $rv=~s/^return //gi;

    return if $rv eq 1;
    return if $rv eq '__PACKAGE__';
    return if $rv =~ /^__PACKAGE__->meta->make_immutable/;

    $rv = decode_utf8($rv);

    my $data = {
        'file'    => $filename,
        'package' => $this_package,
        'PPI'     => ref $match,
    };

    my @bad = map { 'PPI::Statement::'.$_} qw(Sub Variable Compound Package Scheduled Include Sub);

    if (any { ref($match) eq $_ } @bad) {
        $data->{'bad'}=$rv;
        push(@{$self->bad},$data);
    }
    elsif ($rv =~ /^('|"|\d|qw|qq|q|!|~)/) {
        $data->{'value'}=$rv;
        push(@{$self->interesting},$data);
    }
    else {
        $data->{'bad'}=$rv;
        $data->{'PPI'}.=" (but very likely crap)";
        push(@{$self->bad},$data);
    }
}


sub _is_code {
    my $elem = shift;
    return ! (    $elem->isa('PPI::Statement::End')
               || $elem->isa('PPI::Statement::Data'));
}


sub in_CPAN {
    my ($self,$cpan,$out)=@_;

    my $p=Parse::CPAN::Packages->new($cpan->file(qw(modules 02packages.details.txt.gz))->stringify);

    if (!-d $out) {
        $out->mkpath || die "cannot make dir $out";
    }

    # get all old data files so we can later delete non-current
    my %old_files;
    while (my $file = $out->next) {
        next unless $file =~ /\.json/;
        $old_files{$file->basename}=1;
    }

    # analyse cpan
    foreach my $dist (sort {$a->dist cmp $b->dist} $p->latest_distributions) {
        delete $old_files{$dist->distvname.'.json'};
        next if (-e $out->file($dist->distvname.'.json'));

        my $data;
        my $distfile = $cpan->file('authors','id',$dist->prefix);
        $data->{file}=$distfile;
        my $dir;
        eval {
            $dir = tempdir('/var/tmp/arv_XXXXXX');
            my $archive=Archive::Any->new($distfile->stringify) || die $!;