home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / DistnameInfo.pm < prev    next >
Encoding:
Perl POD Document  |  2003-10-23  |  4.0 KB  |  174 lines
  1.  
  2. package CPAN::DistnameInfo;
  3.  
  4. $VERSION = "0.03";
  5. use strict;
  6.  
  7. sub distname_info {
  8.   my $file = shift or return;
  9.  
  10.   my ($dist, $version) = $file =~ /^
  11.     ((?:[-+.]*(?:[A-Za-z0-9]+|(?<=\D)_|_(?=\D))*
  12.      (?:
  13.     [A-Za-z](?=[^A-Za-z]|$)
  14.     |
  15.     \d(?=-)
  16.      )(?<![._-][vV])
  17.     )+)(.*)
  18.   $/xs or return ($file,undef,undef);
  19.  
  20.   if ($version =~ /^(-[Vv].*)-(\d.*)/) {
  21.    
  22.     # Catch names like Unicode-Collate-Standard-V3_1_1-0.1
  23.     # where the V3_1_1 is part of the distname
  24.     $dist .= $1;
  25.     $version = $2;
  26.   }
  27.  
  28.   $version = $1
  29.     if !length $version and $dist =~ s/-(\d+\w)$//;
  30.  
  31.   $version = $1 . $version
  32.     if $version =~ /^\d+$/ and $dist =~ s/-(\w+)$//;
  33.  
  34.   if ($version =~ /\d\.\d/) {
  35.     $version =~ s/^[-_.]+//;
  36.   }
  37.   else {
  38.     $version =~ s/^[-_]+//;
  39.   }
  40.  
  41.   my $dev;
  42.   if (length $version) {
  43.     if ($file =~ /^perl-?\d+\.(\d+)(?:\D(\d+))?(-(?:TRIAL|RC)\d+)?$/) {
  44.       $dev = 1 if (($1 > 6 and $1 & 1) or ($2 and $2 >= 50)) or $3;
  45.     }
  46.     elsif ($version =~ /\d\D\d+_\d/) {
  47.       $dev = 1;
  48.     }
  49.   }
  50.   else {
  51.     $version = undef;
  52.   }
  53.  
  54.   ($dist, $version, $dev);
  55. }
  56.  
  57. sub new {
  58.   my $class = shift;
  59.   my $distfile = shift;
  60.  
  61.   my %info;
  62.  
  63.   $distfile =~ s,//+,/,g;
  64.  
  65.   ($info{filename} = $distfile) =~ s,^(((.*?/)?authors/)?id/)?([A-Z])/(\4[A-Z])/(\5[-A-Z]*)/,,
  66.     and $info{cpanid} = $6;
  67.  
  68.   if ($distfile =~ m,([^/]+)\.(?:tar\.g?z|zip|tgz)$,i) { # support more ?
  69.     $info{distvname} = $1;
  70.   }
  71.  
  72.   @info{qw(dist version beta)} = distname_info($info{distvname});
  73.   $info{maturity} = delete $info{beta} ? 'developer' : 'released';
  74.  
  75.   return bless \%info, $class;
  76. }
  77.  
  78. sub dist      { shift->{dist} }
  79. sub version   { shift->{version} }
  80. sub maturity  { shift->{maturity} }
  81. sub filename  { shift->{filename} }
  82. sub cpanid    { shift->{cpanid} }
  83. sub distvname { shift->{distvname} }
  84.  
  85. sub properties { %{ $_[0] } }
  86.  
  87. 1;
  88.  
  89. __END__
  90.  
  91. =head1 NAME
  92.  
  93. CPAN::DistnameInfo - Extract distribution name and version from a distribution filename
  94.  
  95. =head1 SYNOPSIS
  96.  
  97.   my $pathname = "authors/id/G/GB/GBARR/CPAN-DistnameInfo-0.02.tar.gz";
  98.  
  99.   my $d = CPAN::DistnameInfo->new($pathname);
  100.  
  101.   my $dist      = $d->dist;      # "CPAN-DistnameInfo"
  102.   my $version   = $d->version;   # "0.02"
  103.   my $maturity  = $d->maturity;  # "released"
  104.   my $filename  = $d->filename;  # "CPAN-DistnameInfo-0.02.tar.gz"
  105.   my $cpanid    = $d->cpanid;    # "GBARR"
  106.   my $distvname = $d->distvname; # "CPAN-DistnameInfo-0.02"
  107.  
  108.   my %prop = $d->properties;
  109.  
  110. =head1 DESCRIPTION
  111.  
  112. Many online services that are centered around CPAN attempt to
  113. associate multiple uploads by extracting a distribution name from
  114. the filename of the upload. For most distributions this is easy as
  115. they have used ExtUtils::MakeMaker or Module::Build to create the
  116. distribution, which results in a uniform name. But sadly not all
  117. uploads are created in this way.
  118.  
  119. C<CPAN::DistnameInfo> uses heuristics that have been learnt by
  120. L<http://search.cpan.org/> to extract the distribution name and
  121. version from filenames and also report if the version is to be
  122. treated as a developer release
  123.  
  124. The constructor takes a single pathname, returning an object with the following methods
  125.  
  126. =over
  127.  
  128. =item cpanid
  129.  
  130. If the path given looked like a CPAN authors directory path, then this will be the
  131. the CPAN id of the author.
  132.  
  133. =item dist
  134.  
  135. The name of the distribution
  136.  
  137. =item distvname
  138.  
  139. The file name with any suffix and leading directory names removed
  140.  
  141. =item filename
  142.  
  143. If the path given looked like a CPAN authors directory path, then this will be the
  144. path to the file relative to the detected CPAN author directory. Otherwise it is the path
  145. that was passed in.
  146.  
  147. =item maturity
  148.  
  149. The maturity of the distribution. This will be either C<released> or C<developer>
  150.  
  151. =item properties
  152.  
  153. This will return a list of key-value pairs, suitable for assigning to a hash,
  154. for the known properties.
  155.  
  156. =item version
  157.  
  158. The extracted version
  159.  
  160. =back
  161.  
  162. =head1 AUTHOR
  163.  
  164. Graham Barr <gbarr@pobox.com>
  165.  
  166. =head1 COPYRIGHT 
  167.  
  168. Copyright (c) 2003 Graham Barr. All rights reserved. This program is
  169. free software; you can redistribute it and/or modify it under the same
  170. terms as Perl itself.
  171.  
  172. =cut
  173.  
  174.