Algorithm-DimReduction

 view release on metacpan or  search on metacpan

inc/Module/Install/Metadata.pm  view on Meta::CPAN

    else {
        warn "Cannot determine perl version info from $file\n";
        return;
    }
}

sub author_from {
    my ( $self, $file ) = @_;
    my $content = $self->_slurp($file);
    if ($content =~ m/
        =head \d \s+ (?:authors?)\b \s*
        ([^\n]*)
        |
        =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
        .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
        ([^\n]*)
    /ixms) {
        my $author = $1 || $2;
        $author =~ s{E<lt>}{<}g;
        $author =~ s{E<gt>}{>}g;
        $self->author($author); 
    }
    else {
        warn "Cannot determine author info from $file\n";
    }
}

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

    if (
        $self->_slurp($file) =~ m/
        (
            =head \d \s+
            (?:licen[cs]e|licensing|copyright|legal)\b
            .*?
        )
        (=head\\d.*|=cut.*|)
        \z
    /ixms
      )
    {
        my $license_text = $1;
        my @phrases      = (
            'under the same (?:terms|license) as perl itself' => 'perl',        1,
            'GNU public license'                              => 'gpl',         1,
            'GNU lesser public license'                       => 'gpl',         1,
            'BSD license'                                     => 'bsd',         1,
            'Artistic license'                                => 'artistic',    1,
            'GPL'                                             => 'gpl',         1,
            'LGPL'                                            => 'lgpl',        1,
            'BSD'                                             => 'bsd',         1,
            'Artistic'                                        => 'artistic',    1,
            'MIT'                                             => 'mit',         1,
            'proprietary'                                     => 'proprietary', 0,
        );
        while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
            $pattern =~ s{\s+}{\\s+}g;
            if ( $license_text =~ /\b$pattern\b/i ) {
                if ( $osi and $license_text =~ /All rights reserved/i ) {
                        warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it.";
		}
                $self->license($license);
                return 1;
            }
        }
    }

    warn "Cannot determine license info from $file\n";
    return 'unknown';
}

1;



( run in 0.515 second using v1.01-cache-2.11-cpan-9bca49b1385 )