init III

Perl OTRS/Kernel/cpan-lib/CPAN/Audit/Discover.pm

@@ -0,0 +1,32 @@
+package CPAN::Audit::Discover;
+use strict;
+use warnings;
+use CPAN::Audit::Discover::Cpanfile;
+use CPAN::Audit::Discover::CpanfileSnapshot;
+
+sub new {
+    my $class = shift;
+
+    my $self = {};
+    bless $self, $class;
+
+    return $self;
+}
+
+sub discover {
+    my $self = shift;
+    my ($path) = @_;
+
+    if ( -f "$path/cpanfile.snapshot" ) {
+        return CPAN::Audit::Discover::CpanfileSnapshot->new->discover("$path/cpanfile.snapshot");
+    }
+    elsif ( -f "$path/cpanfile" ) {
+        return CPAN::Audit::Discover::Cpanfile->new->discover("$path/cpanfile");
+    }
+    else {
+    }
+
+    return;
+}
+
+1;

Perl OTRS/Kernel/cpan-lib/CPAN/Audit/Discover/Cpanfile.pm

@@ -0,0 +1,43 @@
+package CPAN::Audit::Discover::Cpanfile;
+use strict;
+use warnings;
+use Module::CPANfile;
+
+sub new {
+    my $class = shift;
+
+    my $self = {};
+    bless $self, $class;
+
+    return $self;
+}
+
+sub discover {
+    my $self = shift;
+    my ($cpanfile_path) = @_;
+
+    my $cpanfile = Module::CPANfile->load($cpanfile_path);
+
+    my $prereqs = $cpanfile->prereqs->as_string_hash;
+
+    my @deps;
+    foreach my $phase ( keys %$prereqs ) {
+        foreach my $type ( keys %{ $prereqs->{$phase} } ) {
+            foreach my $module ( keys %{ $prereqs->{$phase}->{$type} } ) {
+                my $version = $prereqs->{$phase}->{$type}->{$module};
+
+                next if $module eq 'perl';
+
+                push @deps,
+                  {
+                    module  => $module,
+                    version => $version,
+                  };
+            }
+        }
+    }
+
+    return @deps;
+}
+
+1;

Perl OTRS/Kernel/cpan-lib/CPAN/Audit/Discover/CpanfileSnapshot.pm

@@ -0,0 +1,41 @@
+package CPAN::Audit::Discover::CpanfileSnapshot;
+use strict;
+use warnings;
+use CPAN::DistnameInfo;
+
+sub new {
+    my $class = shift;
+
+    my $self = {};
+    bless $self, $class;
+
+    return $self;
+}
+
+sub discover {
+    my $self = shift;
+    my ($cpanfile_snapshot_path) = @_;
+
+    open my $fh, '<', $cpanfile_snapshot_path or die $!;
+
+    my @deps;
+    while ( defined( my $line = <$fh> ) ) {
+        if ( $line =~ m/pathname: ([^\s]+)/ ) {
+            next unless my $d = CPAN::DistnameInfo->new($1);
+
+            next unless $d->dist && $d->version;
+
+            push @deps,
+              {
+                dist    => $d->dist,
+                version => $d->version,
+              };
+        }
+    }
+
+    close $fh;
+
+    return @deps;
+}
+
+1;

Perl OTRS/Kernel/cpan-lib/CPAN/Audit/Installed.pm

@@ -0,0 +1,120 @@
+package CPAN::Audit::Installed;
+use strict;
+use warnings;
+use File::Find ();
+use Cwd        ();
+
+sub new {
+    my $class = shift;
+    my (%params) = @_;
+
+    my $self = {};
+    bless $self, $class;
+
+    $self->{db} = $params{db};
+    $self->{cb} = $params{cb};
+
+    return $self;
+}
+
+sub find {
+    my $self = shift;
+    my (@inc) = @_;
+
+    @inc = @INC unless @inc;
+    @inc = grep { defined && -d $_ } map { Cwd::realpath($_) } @inc;
+
+    my %seen;
+    my @deps;
+
+    File::Find::find(
+        {
+            wanted => sub {
+                my $path = $File::Find::name;
+
+                if ( $path && -f $path && m/\.pm$/ ) {
+                    return unless my $module = module_from_file($path);
+
+                    return unless my $distname = $self->{db}->{module2dist}->{$module};
+
+                    my $dist = $self->{db}->{dists}->{$distname};
+                    if ( $dist->{main_module} eq $module ) {
+                        return if $seen{$module}++;
+
+                        return unless my $version = module_version($path);
+
+                        push @deps, { dist => $distname, version => $version };
+
+                        if ( $self->{cb} ) {
+                            $self->{cb}->(
+                                {
+                                    path     => $path,
+                                    distname => $distname,
+                                    version  => $version
+                                }
+                            );
+                        }
+                    }
+                }
+            },
+            follow      => 1,
+            follow_skip => 2,
+        },
+        @inc
+    );
+
+    return @deps;
+}
+
+# https://metacpan.org/source/ABELTJE/V-0.13/V.pm
+sub module_version {
+    my ($parsefile) = @_;
+
+    open my $mod, '<', $parsefile or die $!;
+
+    my $inpod = 0;
+    my $result;
+    local $_;
+    while (<$mod>) {
+        $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
+        next if $inpod || /^\s*#/;
+
+        chomp;
+        next unless m/([\$*])(([\w\:\']*)\bVERSION)\b.*\=/;
+        my $eval = qq{
+            package CPAN::Audit::_version;
+            no strict;
+
+            local $1$2;
+            \$$2=undef; do {
+                $_
+            }; \$$2
+        };
+        local $^W = 0;
+        $result = eval($eval);
+        warn "Could not eval '$eval' in $parsefile: $@" if $@;
+        $result = "undef" unless defined $result;
+        last;
+    }
+    close $mod;
+    return $result;
+}
+
+sub module_from_file {
+    my ($path) = @_;
+
+    my $module;
+
+    open my $fh, '<', $path or return;
+    while ( my $line = <$fh> ) {
+        if ( $line =~ m/package\s+(.*?)\s*;/ms ) {
+            $module = $1;
+            last;
+        }
+    }
+    close $fh;
+
+    return unless $module;
+}
+
+1;

Perl OTRS/Kernel/cpan-lib/CPAN/Audit/Query.pm

@@ -0,0 +1,67 @@
+package CPAN::Audit::Query;
+use strict;
+use warnings;
+use CPAN::Audit::Version;
+
+sub new {
+    my $class = shift;
+    my (%params) = @_;
+
+    my $self = {};
+    bless $self, $class;
+
+    $self->{db} = $params{db} || {};
+
+    return $self;
+}
+
+sub advisories_for {
+    my $self = shift;
+    my ( $distname, $version_range ) = @_;
+
+    my $dist = $self->{db}->{dists}->{$distname};
+    return unless $dist;
+
+    my @advisories = @{ $dist->{advisories} };
+    my @versions   = @{ $dist->{versions} };
+
+    if ( !$version_range ) {
+        return @advisories;
+    }
+
+    my $version_checker = CPAN::Audit::Version->new;
+
+    my @all_versions = map { $_->{version} } @versions;
+    my @selected_versions;
+
+    foreach my $version (@all_versions) {
+        if ( $version_checker->in_range( $version, $version_range ) ) {
+            push @selected_versions, $version;
+        }
+    }
+
+    if ( !@selected_versions ) {
+        return;
+    }
+
+    my @matched_advisories;
+    foreach my $advisory (@advisories) {
+        my @affected_versions = $version_checker->affected_versions( \@all_versions, $advisory->{affected_versions} );
+        next unless @affected_versions;
+
+        foreach my $affected_version ( reverse @affected_versions ) {
+            if ( $version_checker->in_range( $affected_version, $version_range ) ) {
+                push @matched_advisories, $advisory;
+                last;
+            }
+        }
+    }
+
+    if ( !@matched_advisories ) {
+        return;
+    }
+
+    return @matched_advisories;
+}
+
+1;

Perl OTRS/Kernel/cpan-lib/CPAN/Audit/Version.pm

@@ -0,0 +1,73 @@
+package CPAN::Audit::Version;
+use strict;
+use warnings;
+use version;
+
+sub new {
+    my $class = shift;
+
+    my $self = {};
+    bless $self, $class;
+
+    return $self;
+}
+
+sub in_range {
+    my $self = shift;
+    my ( $version, $range ) = @_;
+
+    return unless defined $version && defined $range;
+
+    my @ands = split /\s*,\s*/, $range;
+
+    return unless defined( $version = eval { version->parse($version) } );
+
+    foreach my $and (@ands) {
+        my ( $op, $range_version ) = $and =~ m/^(<=|<|>=|>|==|!=)?\s*([^\s]+)$/;
+
+        return
+          unless defined( $range_version = eval { version->parse($range_version) } );
+
+        $op = '>=' unless defined $op;
+
+        if ( $op eq '<' ) {
+            return unless $version < $range_version;
+        }
+        elsif ( $op eq '<=' ) {
+            return unless $version <= $range_version;
+        }
+        elsif ( $op eq '>' ) {
+            return unless $version > $range_version;
+        }
+        elsif ( $op eq '>=' ) {
+            return unless $version >= $range_version;
+        }
+        elsif ( $op eq '==' ) {
+            return unless $version == $range_version;
+        }
+        elsif ( $op eq '!=' ) {
+            return unless $version != $range_version;
+        }
+        else {
+            return 0;
+        }
+    }
+
+    return 1;
+}
+
+sub affected_versions {
+    my $self = shift;
+    my ( $available_versions, $range ) = @_;
+
+    my @affected_versions;
+    foreach my $version (@$available_versions) {
+        if ( $self->in_range( $version, $range ) ) {
+            push @affected_versions, $version;
+        }
+    }
+
+    return @affected_versions;
+}
+
+1;