Merge branch 'cpan_fix', fixes #23

2 files changed, 44 insertions, 6 deletions

diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm
index 6a8b4db..67c7e3e 100644
--- a/SBO-Lib/lib/SBO/Lib.pm
+++ b/SBO-Lib/lib/SBO/Lib.pm
@@ -42,6 +42,7 @@ our @EXPORT = qw(
 	get_arch
 	get_build_queue
 	merge_queues
+	get_installed_cpans
 	$tempdir
 	$conf_dir
 	$conf_file
@@ -884,3 +885,29 @@ sub get_readme_contents($) {
 	close $fh;
 	return $readme;
 }
+
+# return a list of perl modules installed via the CPAN
+sub get_installed_cpans() {
+	my @locals;
+	for my $dir (@INC) {
+		push @locals, "$dir/perllocal.pod" if -f "$dir/perllocal.pod";
+	}
+	my @contents;
+	for my $file (@locals) {
+		my $fh = open_read $file;
+#		push @contents, grep {/Module|VERSION/} <$fh>;
+		push @contents, grep {/Module/} <$fh>;
+		close $fh;
+	}
+	my $mod_regex = qr/C<Module>\s+L<([^\|]+)/;
+#	my $ver_regex = qr/C<VERSION:\s+([^>]+)>/;
+	my (@mods, @vers);
+	for my $line (@contents) {
+		push @mods, ($line =~ $mod_regex)[0];
+#		push @vers, ($line =~ $ver_regex)[0];
+	}
+	return \@mods;
+#	my %cpans;
+#	$cpans{$mods[$_]} = $vers[$_] for keys @mods;
+#	return \%cpans;
+}
diff --git a/sboupgrade b/sboupgrade
index c70794d..12c086f 100755
--- a/sboupgrade
+++ b/sboupgrade
@@ -319,24 +319,35 @@ FIRST: for my $sbo (@$upgrade_queue) {
 
 INSTALL_NEW:
 goto BEGIN_BUILD unless $install_new;
+
+my $pms = get_installed_cpans;
+s/::/-/g for @$pms;
+
 @temp_queue = ();
 FIRST: for my $sbo (@$build_queue) {
     my $name = $compat32 ? "$sbo-compat32" : $sbo;
     if ($name ~~ @$inst_names) {
         say "$name already installed." unless $force; 
         next FIRST;
-    } 
+    } else {
+		my $pm_name = $name;
+		$pm_name =~ s/^perl-//g;
+		if (/$pm_name/i ~~ @$pms) {
+			say "$name installed via the cpan." unless $force;
+			next FIRST;
+		}
+	}
     $locations{$name} = get_sbo_location($sbo) if $compat32;
     unless ($non_int) {
         # if compat32 is TRUE, we need to see if the non-compat version exists.
         if ($compat32) {
             unless ($sbo ~~ @$inst_names or $sbo ~~ @$upgrade_queue) {
                 if (user_prompt($sbo, $locations{$sbo})){
-                    push(@temp_queue, $sbo);
-                    say "$sbo added to install queue.";
-                } else {
-                    last FIRST;
-                }
+  	               	push(@temp_queue, $sbo);
+  	               	say "$sbo added to install queue.";
+  	           	} else {
+  	               	last FIRST;
+  	           	}
             } 
         }
         if (user_prompt($name, $locations{$name})) {