test: Turn it to a real prog.
authorMikko Värri <vmj@linuxbox.fi>
Wed, 28 Sep 2011 00:17:15 +0000 (03:17 +0300)
committerMikko Värri <vmj@linuxbox.fi>
Wed, 28 Sep 2011 00:17:15 +0000 (03:17 +0300)
bin/test

index 7007c2e..6096140 100644 (file)
--- a/bin/test
+++ b/bin/test
@@ -1,16 +1,64 @@
 #!/usr/bin/perl -w
+#
+# Copyright (C) 2011 Mikko Värri <vmj@linuxbox.fi>
+#
+# This file is part of Slackware.
+#
+# Slackware is free software: you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# Slackware is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Slackware.  If not, see <http://www.gnu.org/licenses/>.
+#
 use strict;
 use FindBin qw( $Bin $Script );
+use File::Path;
+use File::Spec;
 use lib "$Bin/../lib";
+use Slackware::CLI;
 use Slackware::Package;
 use Slackware::Dependency;
 
+# Defaults
 my $HIDE_ALTERNATIVES = 0;
 my $HIDE_SUPERSETS = 0;
 my $HIDE_SUBSETS = 0;
 my $SHOW_FILES = 0;
 my $SHOW_ALTERNATIVES_SEPARATELY = 0;
 my $SHOW_SUBSETS_SEPARATELY = 0;
+my $OUTPUT = undef;
+
+#
+# Command line handling
+#
+my $summary = "Build slack-required files";
+my $usage   = "[ -ausASF ] [ -o OUTPUT ] PKG [PKG...]";
+my $help    = [
+    qq[    -o OUTPUT   Write to OUTPUT (file or directory).\n],
+    qq[    -a          Hide alternatives.\n],
+    qq[    -u          Hide supersets.\n],
+    qq[    -s          Hide subsets.\n],
+    qq[    -A          Show alternatives separately.\n],
+    qq[    -S          Show subsets separately.\n],
+    qq[    -F          Show files.\n],
+];
+my $options = {
+    'o|output=s' => \$OUTPUT,
+    'a|no-alt'   => \$HIDE_ALTERNATIVES,
+    'u|no-super' => \$HIDE_SUPERSETS,
+    's|no-sub'   => \$HIDE_SUBSETS,
+    'A|alt'      => \$SHOW_ALTERNATIVES_SEPARATELY,
+    'S|sub'      => \$SHOW_SUBSETS_SEPARATELY,
+    'F|files'    => \$SHOW_FILES,
+};
+Slackware::CLI::ParseOptions( $summary, $usage, $help, $options );
 
 my %seen;
 
@@ -21,39 +69,89 @@ sub dep_name {
     return $name;
 }
 
-sub print_slack_required {
+sub slack_required {
     my $dep = shift;
+    my $out = "";
 
-    return if defined $seen{$dep->name};
+    return $out if defined $seen{$dep->name};
     $seen{$dep->name} = 1;
 
-    print dep_name($dep);
+    $out .= dep_name($dep);
     unless ($HIDE_ALTERNATIVES) {
-        print " | " . dep_name($_) foreach $dep->alternatives;
+        $out .= " | " . dep_name($_) foreach $dep->alternatives;
     }
     unless ($HIDE_SUPERSETS) {
-        print " | " . dep_name($_) foreach $dep->supersets;
+        $out .= " | " . dep_name($_) foreach $dep->supersets;
     }
     unless ($HIDE_SUBSETS) {
         my $subsets = join(' & ', map { dep_name($_) } $dep->subsets);
-        print " | ( $subsets )" if $subsets;
+        $out .= " | ( $subsets )" if $subsets;
     }
-    print "\n";
+    $out .= "\n";
 
     if ($SHOW_FILES) {
-        print "#    " . $_->name . "\n" foreach $dep->files;
+        $out .= "#    " . $_->name . "\n" foreach $dep->files;
     }
 
     if ($SHOW_ALTERNATIVES_SEPARATELY) {
-        print_slack_required($_) foreach $dep->alternatives;
+        $out .= slack_required($_) foreach $dep->alternatives;
     }
     if ($SHOW_SUBSETS_SEPARATELY) {
-        print_slack_required($_) foreach $dep->subsets;
+        $out .= slack_required($_) foreach $dep->subsets;
     }
+    return $out;
 }
 
+my $pkg = undef;
+my $fh = undef;
 foreach my $pkg_db_entry (@ARGV) {
-    print "==> $pkg_db_entry\n";
-    my $pkg = Slackware::Package->new_from_pkg_db_entry($pkg_db_entry);
-    print_slack_required($_) foreach $pkg->dependencies;
+    # Reset "seen" registry
+    delete $seen{$_} foreach keys(%seen);
+
+    $pkg = Slackware::Package->new_from_pkg_db_entry($pkg_db_entry);
+
+    if (defined $OUTPUT and $OUTPUT ne "-") {
+        if ( -d $OUTPUT or (not -e $OUTPUT and $OUTPUT =~ m[/$]) ) {
+            #
+            # Directory
+            #
+            my $output = File::Spec->catfile($OUTPUT,
+                                             (File::Spec->splitdir($pkg->location))[-2],
+                                             $pkg->name);
+            mkpath( $output, { error => \my $err } );
+            die "$Script: Unable create directory '$output': $!\n"
+                if @$err;
+            #
+            # File
+            #
+            $output = File::Spec->catfile( $output, "slack-required" );
+            open $fh, ">$output"
+                or die "$Script: ERROR: Unable to open file '$output' for writing: $!\n";
+
+            print $fh slack_required($_) foreach $pkg->dependencies;
+
+            close $fh
+                or die "$Script: ERROR: Unable to close file '$output': $!\n";
+            $fh = undef;
+
+        }
+        else {
+            unless ($fh) {
+                open $fh, ">$OUTPUT"
+                    or die "$Script: ERROR: Unable to open file '$OUTPUT' for writing: $!";
+            }
+            print $fh "# ==> ".$pkg->name."\n"
+                unless @ARGV == 1;
+            print $fh slack_required($_) foreach $pkg->dependencies;
+        }
+    }
+    else {
+        print "# ==> ".$pkg->name."\n"
+            unless @ARGV == 1;
+        print slack_required($_) foreach $pkg->dependencies;
+    }
+}
+if ($fh) {
+    close $fh
+        or die "$Script: ERROR: Unable to close file '$OUTPUT': $!\n";
 }