/[gentoo-perl]/perl-info/trunk/bin/perl-info
Gentoo

Diff of /perl-info/trunk/bin/perl-info

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 97 Revision 98
2 2
3# ----------------------------------------------------------------------------- 3# -----------------------------------------------------------------------------
4# 4#
5# perl-info 5# perl-info
6# 6#
7# date : 2006-09-02 7# date : 2006-09-10
8# author : Christian Hartmann <ian@gentoo.org> 8# author : Christian Hartmann <ian@gentoo.org>
9# version : 0.10 9# version : 0.11
10# license : GPL-2 10# license : GPL-2
11# description : 'emerge --info' for perl 11# description : 'emerge --info' for perl
12# 12#
13# header : $Header: $ 13# header : $Header: $
14# 14#
26use strict; 26use strict;
27use DirHandle; 27use DirHandle;
28use Term::ANSIColor; 28use Term::ANSIColor;
29 29
30# - init vars & constants > 30# - init vars & constants >
31my $VERSION = "0.10"; 31my $VERSION = "0.11";
32my $portdir = getPortdir(); 32my $portdir = getPortdir();
33my @scan_portage_categories = ("dev-perl","perl-core","perl-gcpan"); 33my @scan_portage_categories = ("dev-perl","perl-core","perl-gcpan");
34my $pkgdbdir = "/var/db/pkg/"; 34my $pkgdbdir = "/var/db/pkg/";
35my %excludeDirs = ("." => 1, ".." => 1, "metadata" => 1, "licenses" => 1, "eclass" => 1, "distfiles" => 1, "virtual" => 1, "profiles" => 1 , "CVS" => 1); 35my %excludeDirs = ("." => 1, ".." => 1, "metadata" => 1, "licenses" => 1, "eclass" => 1, "distfiles" => 1, "virtual" => 1, "profiles" => 1 , "CVS" => 1);
36 36
298 close(FH); 298 close(FH);
299 return $content; 299 return $content;
300} 300}
301 301
302# Description: 302# Description:
303# @listOfEbuilds = getAvailableEbuilds($PORTDIR, category/packagename); 303# Returnvalue is PORTDIR from make.conf or make.globals (make.conf overrules make.globals).
304sub getAvailableEbuilds 304# $portdir = getPortdir();
305{
306 my $PORTDIR = shift;
307 my $catPackage = shift;
308 my @packagelist = ();
309
310 if (-e $PORTDIR."/".$catPackage)
311 {
312 # - get list of ebuilds >
313 my $dh = new DirHandle($PORTDIR."/".$catPackage);
314 while (defined($_ = $dh->read))
315 {
316 if ($_ =~ m/(.+)\.ebuild$/)
317 {
318 push(@packagelist,$_);
319 }
320 }
321 }
322
323 return @packagelist;
324}
325
326# Description:
327# Returns version of an ebuild. (Without -rX string etc.)
328# $version = getEbuildVersionSpecial("foo-1.23-r1.ebuild");
329sub getEbuildVersionSpecial
330{
331 my $ebuildVersion = shift;
332 $ebuildVersion=substr($ebuildVersion,0,length($ebuildVersion)-7);
333 $ebuildVersion =~ s/^([a-zA-Z0-9\-_\/\+]*)-([0-9\.]+[a-zA-Z]?)([\-r|\-rc|_alpha|_beta|_pre|_p]?)/$2$3/;
334
335 return $ebuildVersion;
336}
337
338sub getPortdir 305sub getPortdir
339{ 306{
340 return getParamFromFile(getFileContents("/etc/make.globals").getFileContents("/etc/make.conf"),"PORTDIR","lastseen"); 307 return getParamFromFile(getFileContents("/etc/make.globals").getFileContents("/etc/make.conf"),"PORTDIR","lastseen");
341} 308}
342 309
310# Description:
311# Prints a fancy header.
343sub printHeader 312sub printHeader
344{ 313{
345 print "\n"; 314 print "\n";
346 print $green." perl-info".$reset." version ".$VERSION." - brought to you by the Gentoo perl-herd-maintainer ;-)\n"; 315 print $green." perl-info".$reset." version ".$VERSION." - brought to you by the Gentoo perl-herd-maintainer ;-)\n";
347 print " Distributed under the terms of the GPL-2\n"; 316 print " Distributed under the terms of the GPL-2\n";
391 360
392perl-info - gather systems perl info 361perl-info - gather systems perl info
393 362
394=head1 VERSION 363=head1 VERSION
395 364
396This document refers to version 0.10 of perl-info 365This document refers to version 0.11 of perl-info
397 366
398=head1 SYNOPSIS 367=head1 SYNOPSIS
399 368
400perl-info 369perl-info
401 370

Legend:
Removed from v.97  
changed lines
  Added in v.98

  ViewVC Help
Powered by ViewVC 1.1.20