Parse-Distname

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

  - fixed is_perl6

0.04 2019/08/09
  - fixed a case that contains SSL3

0.03 2018/11/20
  - fixed to return early correctly

0.02 2018/11/15
  - renamed two hash keys (dist/distv => name/name_and_version)
  - fixed cpan_path not to have a needless slash

0.01 2018/11/15
  - initial release

lib/Parse/Distname.pm  view on Meta::CPAN

  }
  # A little backward incompatibility here (id/A/AU/AUTHOR etc)
  # but I believe nobody cares.
  else {
    $pause_id = "";

    # Assume it's a local distribution
    $author_dir = "L/LO/LOCAL/";
  }
  $res{pause_id}  = $pause_id;
  $res{cpan_path} = "$author_dir$path";

  # Now the path should be (subdir/)dist-version
  if ($path =~ s!^(.+/)!!) {
    $res{subdir} = $1;

    # Typical Perl6 distributions are located under Perl6/ directory
    $res{perl6} = 1 if $res{subdir} =~ m!^Perl6/!;
  }

  # PAUSE allows only a few extensions ($PAUSE::dist::SUFFQR + zip)

lib/Parse/Distname.pm  view on Meta::CPAN

It returns a hash reference, with the following keys as of this
writing:

=over 4

=item arg

The path you passed to the function. If what you passed is some kind
of an object (of Path::Tiny, for example), it's stringified.

=item cpan_path

A relative path to the distribution, whose base directory is
assumed CPAN/authors/id/. If org_path doesn't contain a pause_id,
the distribution is assumed to belong to LOCAL user. For example,

  say parse_distname('Dist-0.01.tar.gz')->{cpan_path};
  # L/LO/LOCAL/Dist-0.01.tar.gz

If you only gives a pause_id, parent directories are supplemented.

  say parse_distname('ISHIGAKI/Dist-0.01.tar.gz')->{cpan_path};
  # I/IS/ISHIGAKI/Dist-0.01.tar.gz

=item pause_id

The pause_id of the distribution. Contrary to the above, this is
empty if you don't give a pause_id.

  say parse_distname('Dist-0.01.tar.gz')->{pause_id};
  # (undef, not LOCAL)

t/basic.t  view on Meta::CPAN

use Test::Differences;
use Parse::Distname qw/parse_distname/;

my $path = "CPAN/authors/id/I/IS/ISHIGAKI/Parse-Distname-0.01.tar.gz";
my $info = parse_distname($path);

unified_diff;

eq_or_diff $info => +{
  arg              => $path,
  cpan_path        => "I/IS/ISHIGAKI/Parse-Distname-0.01.tar.gz",
  pause_id         => "ISHIGAKI",
  name             => "Parse-Distname",
  name_and_version => "Parse-Distname-0.01",
  version          => "0.01",
  version_number   => "0.01",
  extension        => ".tar.gz",
  is_dev           => undef,
}, "parse_distname";

# distname_info

t/basic.t  view on Meta::CPAN

# unrelated files
ok !parse_distname("authors/id/A/AU/AUTHOR/CHECKSUMS");
ok !parse_distname("RECENT-6h.json");
ok !parse_distname("authors/00whois.xml");

my $p6path = 'CPAN/authors/id/S/SK/SKAJI/Perl6/App-Mi6-0.0.2.tar.gz';
my $p6info = parse_distname($p6path);

eq_or_diff $p6info => +{
  arg              => $p6path,
  cpan_path        => "S/SK/SKAJI/Perl6/App-Mi6-0.0.2.tar.gz",
  pause_id         => "SKAJI",
  name             => "App-Mi6",
  name_and_version => "App-Mi6-0.0.2",
  version          => "0.0.2",
  version_number   => "0.0.2",
  extension        => ".tar.gz",
  is_dev           => undef,
  subdir           => 'Perl6/',
  perl6            => 1,
}, "parse_distname";

xt/walk_through.t  view on Meta::CPAN

    $file =~ s/\s*\(.+$//; # remove year info
    $KnownDiff{$file} = $diff;
  }
}

find({
  wanted => sub {
    my $file = $File::Find::name;
    return unless -f $file;
    return unless $file =~ /$Parse::Distname::SUFFRE/i;
    my $cpan_path = $file;
    $cpan_path =~ s|^.+authors/id/||;

    my %cd = CPAN::DistnameInfo->new($cpan_path)->properties;
    my %pd = Parse::Distname->new($cpan_path)->properties;

    # ignore spammers
    return if $pd{cpanid} =~ /^(?:DOCRIVERS|FULLHQ|ULTRAHD)$/;

    my $ok = 1;
    my $diff = '';
    for my $key (sort keys %cd) {
      if (defined $cd{$key}) {
        if (defined $pd{$key}) {
          if ($cd{$key} eq $pd{$key}) {

xt/walk_through.t  view on Meta::CPAN

      }
    }

    $diff =~ s/(?:\015\012|\015|\012)/\n/gs;
    chomp $diff;

    if ($ok) {
        pass $file;
    } else {
        SKIP: {
            skip "not portable", 1 if $^O eq 'MSWin32' and $cpan_path =~ /\.\\/;
            if (!$KnownDiff{$cpan_path} or $diff ne $KnownDiff{$cpan_path}) {
                my $mtime = (stat($file))[9];
                my $year = (localtime($mtime))[5] + 1900;
                print STDERR "$cpan_path ($year)\n$diff\n\n";
                fail $file;
            } else {
                pass $file;
            }
        }
    }
  },
  no_chdir => 1,
}, "$cpan_mirror/authors/id/");