view release on metacpan or  search on metacpan

lib/Module/License/Report/CPANPLUSModule.pm  view on Meta::CPAN

   return $self->{cp}->{verbose};
}

=item $self->license()

Returns a Module::License::Report::Object instance, or undef.

=cut

sub license
{
   my $self = shift;

   _announce("Find license for $self->{name}", $self->verbose());
   for my $source (reverse sort {$a->{confidence} <=> $b->{confidence}} @license_sources)
   {
      _announce("  Try source $source->{name}", $self->verbose());
      my ($license, $file) = $source->{sub}($self);
      my $result = {
         name        => $license,
         source_file => $file,
         source_name => $source->{name},
         source_desc => $source->{description},
         confidence  => $source->{confidence},
         module      => $self,
      };
      if ($license)
      {
         return Module::License::Report::Object->new($result);
      }
   }
   return;
}

=item $self->license_from_file($filename)

Searches the specified file for license and/or copyright information.
This uses heuristics.

=cut

sub license_from_file
{
   my $self        = shift;
   my $licensefile = shift;

   if ($licensefile)
   {
      my $filename = File::Spec->catfile($self->extract_dir(), $licensefile);
      if (-f $filename)
      {
         my $content = File::Slurp::read_file($filename);
         if ($content =~ m/=head\d\s+(?:licen[cs]e|licensing|copyright|legal)\b(.*?)(=head\\d.*|=cut.*|)\z/ixms)
         {
            my $licensetext = $1;

            # Check for any of the following phrases (Change spaces to \s+)
            my @phrases = (
               'under the same (?:terms|license) as Perl itself',
            );
            my $regex = join q{|}, map {join '\\s+', split m/\s+/xms, $_} @phrases;
            if ($licensetext =~ m/$regex/ixms)
            {
               return 'perl';
            }
         }
      }
   }

   return undef; ## no critic needs an explicit undef because of list context
}

=item $self->yml()

Loads and parses a C<META.yml> file.  Returns a hashref that has,
minimally, a C<license> field.

=cut

sub yml
{
   my $self = shift;

   if (!$self->{yml})
   {
      $self->{yml} = {
         license => undef,
      };
      my $filename = File::Spec->catfile($self->extract_dir(), 'META.yml');
      if (-f $filename)
      {
         my $yaml = File::Slurp::read_file($filename);
         my $meta = eval { YAML::Load($yaml) };
         if (!$meta)
         {
            _announce('Failed to read META.yml', $self->verbose());
         }
         else
         {
            for my $key (qw(license))
            {
               if ($meta->{$key})
               {
                  $self->{yml}->{$key} = $meta->{$key};
               }
            }
         }
      }
   }
   return $self->{yml};
}

=item $self->dslip()

Parses the CPAN DSLIP metadata.  Returns a hashref that has,
minimally, a C<license> field.

See L<http://cpan.uwinnipeg.ca/htdocs/faqs/dslip.html> for more
information.

=cut

lib/Module/License/Report/CPANPLUSModule.pm  view on Meta::CPAN

=item $self->makefile()

Loads and parses a C<Makefile.PL> file.  Returns a hashref that has,
minimally, a C<license> field.

The parsing is very simplistic.

=cut

sub makefile
{
   my $self = shift;

   if (!$self->{makefile})
   {
      $self->{makefile} = {};
      my $filename = File::Spec->catfile($self->extract_dir(), 'Makefile.PL');
      if (-f $filename)
      {
         my $makefile = File::Slurp::read_file($filename);

         # Get main file from the MakeMaker command
         if ($makefile =~ m/([\'\"]?)VERSION_FROM\1\s*(?:=>|,)\s*(\"[^\"]+|\'[^\']+)/xms)
         {
            my $module_file = substr $2, 1;  # remove leading quote
            $self->{makefile}->{version_from} = $module_file;
         }
      }
   }
   return $self->{makefile};
}

=item $self->buildfile()

Loads and parses a C<Build.PL> file.  Returns a hashref that has,
minimally, a C<license> field.

The parsing is very simplistic.

=cut

sub buildfile
{
   my $self = shift;

   if (!$self->{buildfile})
   {
      $self->{buildfile} = {};
      my $filename = File::Spec->catfile($self->extract_dir(), 'Build.PL');
      if (-f $filename)
      {
         my $buildfile = File::Slurp::read_file($filename);

         # Get main file from the Module::Build constructor
         if ($buildfile =~ m/([\'\"]?)module_name\1\s*(?:=>|,)\s*(\"[^\"]+|\'[^\']+)/xms)
         {
            my $module_name = substr $2, 1;  # remove leading quote

            # This algorithm comes from Module::Build::Base::dist_version() v0.27_02
            my $file = File::Spec->catfile('lib', split m/::/xms, $module_name) . '.pm';

            $self->{buildfile}->{version_from} = $file;
         }
         elsif ($buildfile =~ m/([\'\"]?)dist_version_from\1\s*(?:=>|,)\s*(\"[^\"]+|\'[^\']+)/xms)
         {
            my $module_file = substr $2, 1;  # remove leading quote
            $self->{buildfile}->{version_from} = $module_file;
         }
      }
   }
   return $self->{buildfile};
}

=item $self->version_from()

Returns the name of the file that has the definitive C<VERSION>.
This file might not exist.

This relies on parsing C<META.yml>, C<Build.PL> or C<Makefile.PL>.

=cut

sub version_from
{
   my $self = shift;

   my @candidates = (
      $self->yml()->{version_from},
      $self->buildfile()->{version_from},
      $self->makefile()->{version_from},
   );

   for my $filename (@candidates)
   {
      if ($filename && -f File::Spec->catfile($self->extract_dir(), $filename))
      {
         return $filename;
      }
   }
   return;
}

=item $self->version_from_pod()

Returns the name of a C<.pod> file that corresponds to version_from().
This file might not exist.

=cut

sub version_from_pod
{
   my $self = shift;

   my $version_from = $self->version_from();
   my $version_pod;
   if ($version_from && $version_from =~ m/ \.pm \z /xms)
   {
      ($version_pod = $version_from) =~ s/ \.pm \z /.pod/xms;
   }
   return $version_pod;