From 9b238183d613f3b62b3f974c4cc908ec0922857a Mon Sep 17 00:00:00 2001
From: Frank Brehm <frank@brehm-online.com>
Date: Thu, 25 Feb 2010 14:10:27 +0000
Subject: [PATCH] Erst mal abgeschlossen

git-svn-id: http://svn.brehm-online.com/svn/my-stuff/Perl@39 ec8d2aa5-1599-4edb-8739-2b3a1bc399aa
---
 bin/get-perl-modules.pl | 34 +++++++++++++++++++++++++++++++---
 1 file changed, 31 insertions(+), 3 deletions(-)

diff --git a/bin/get-perl-modules.pl b/bin/get-perl-modules.pl
index 65550e9..3313279 100755
--- a/bin/get-perl-modules.pl
+++ b/bin/get-perl-modules.pl
@@ -57,6 +57,7 @@ use Config;
 use Pod::Usage;
 use Getopt::Long;
 use Cwd 'abs_path';
+use Module::Info;
 
 $Data::Dumper::Indent = 1;
 $Data::Dumper::Sortkeys = 1;
@@ -70,7 +71,6 @@ ENDE
 $Revisn =~ s/^.*:\s*(\S+)\s*\$.*/$1/s;
 our $VERSION = "1.0." . $Revisn;
 
-
 my $module = {};
 
 my ( $verbose, $cur_dir, $cmdline_verbose, $DebugLevel, $help, $show_version, $get_module_version );
@@ -129,6 +129,8 @@ ENDE
 
 print "Include-Verzeichnisse: " . Dumper(\@INC) if $verbose;
 
+my $global_count = 0;
+
 for my $d ( @INC ) {
 
 	my $dir = abs_path($d);
@@ -147,12 +149,16 @@ sub wanted {
 
     my $file_abs = $File::Find::name;
     if ( -f $file_abs and $file_abs =~ /\.pm$/ ) {
+
         print "Untersuche '$file_abs' ...\n" if $verbose > 1;
         
         my ( $volume, $file_in_volume, $file_bla ) = File::Spec->splitpath( $file_abs, 1 );
         $file_in_volume =~ s/^$cur_dir\///;
         return if $file_in_volume =~ /^$arch\//;
         return if $file_in_volume =~ /^$version\//;
+
+		$global_count++;
+
         my $modname = $file_in_volume;
         $modname =~ s/\.pm$//;
         $modname =~ s#/#::#g;
@@ -193,6 +199,13 @@ sub wanted {
 		$mod_info->{'path'} = $file_abs;
 		$mod_info->{'loc'}  = $loc_name;
 
+		if ( $get_module_version ) {
+			my $version = get_version( $file_abs, $modname );
+			$version = '' unless defined $version;
+			$mod_info->{'version'} = $version;
+			$module->{$modname}{'version'} = $version unless exists $module->{$modname}{'version'};
+		}
+
 		push @{ $module->{$modname}{'locations'} }, $mod_info;
 	
         #$module->{$modname} = $location;
@@ -203,19 +216,34 @@ sub wanted {
 print Dumper( $module ) if $verbose > 1;
 
 print "\nGefundene Module:\n\n" if $verbose;
+printf "insgesamt %d Module gefunden.\n\n", $global_count if $verbose;
 
 for my $m ( sort { lc($a) cmp lc($b) } keys %$module ) {
     printf " - %s\n", $m;
 	for my $mod_info ( @{ $module->{$m}{'locations'} } ) {
-		printf "     %-11s %s\n", $mod_info->{'loc'}, $mod_info->{'path'};
+		my $version = $get_module_version ? ( " (" . $mod_info->{'version'} . ")" ) : '';
+		printf "     %-11s %s%s\n", $mod_info->{'loc'}, $mod_info->{'path'}, $version;
 	}
-    #print $module->{$_} . " " . $_ . "\n";
 }
 
 exit 0;
 
 #------------------------------------------------------------------------------------
 
+sub get_version {
+
+	my $module_path = shift;
+	my $module_name = shift;
+
+	my $mod = Module::Info->new_from_file($module_path);
+	my $version = $mod->version;
+	$version = '~' unless defined $version and $version ne '';
+	return $version;
+
+}
+
+#------------------------------------------------------------------------------------
+
 __END__
 
 =end comment
-- 
2.39.5