Add CLI.pm.
authorMikko Värri <vmj@linuxbox.fi>
Tue, 27 Sep 2011 23:46:07 +0000 (02:46 +0300)
committerMikko Värri <vmj@linuxbox.fi>
Tue, 27 Sep 2011 23:46:07 +0000 (02:46 +0300)
lib/Slackware/CLI.pm [new file with mode: 0644]

diff --git a/lib/Slackware/CLI.pm b/lib/Slackware/CLI.pm
new file mode 100644 (file)
index 0000000..da7e2d6
--- /dev/null
@@ -0,0 +1,317 @@
+# -*- coding: utf-8-unix; -*-
+#
+# 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/>.
+#
+package Slackware::CLI;
+use base qw( Exporter );           # Base package
+use warnings;                      # Enable all warnings (for debugging)
+use strict;                        # Restrict use of unsafe constructs
+use Carp;                          # Report errors from callers context
+use FindBin qw( $Script );
+use Getopt::Long;                  # Use standard command line interface
+
+# Exported symbols
+our @EXPORT    = qw();             # ... by default
+our @EXPORT_OK = qw();             # ... on request
+
+# Defaults for standard command line options
+
+### INTERFACE SUB ###
+# Usage      : Slackware::CLI::ParseOptions( $summary, $usage, $help, $options );
+# Purpose    : Parse command line options.
+# Returns    : None.
+# Parameters : A string: one line summary of the command.
+#              A string: short usage format for options.
+#              A reference to a list of strings: the option listing for help.
+#              A reference to a hash: See 'perldoc Getopt::Long'.
+# Throws     : Exits if options can not be parsed.  A usage message is
+#              printed.
+# Comments   : n/a
+# See also   : n/a
+sub ParseOptions {
+    # Unpack argument
+    my ($summary, $usage, $help, $options) = @_;
+
+    # Add standard meta options
+    push @{ $help },
+        qq[Standard options:\n],
+        qq[    --help      Print help and exit.\n],
+        qq[    --man       Print manual and exit.\n],
+        qq[    --usage     Print usage and exit.\n],
+        qq[    --version   Print version and exit.\n],
+        qq[See '$Script --man' for more details.\n],
+        qq[Also, 'perldoc Slackware::CLI' might be of interest.\n],
+        qq[\n]
+        ;
+    $options->{'C'}         = \&RedistributionConditions;
+    $options->{'W'}         = \&UsageWarranty;
+    $options->{'usage'}     = sub { Usage($usage); };
+    $options->{'help'}      = sub { Help($summary, $usage, $help); };
+    $options->{'man'}       = \&Man;
+    $options->{'version'}   = \&Version;
+
+    Getopt::Long::Configure( qw(no_ignore_case no_auto_abbrev bundling) );
+    Getopt::Long::GetOptions( %{ $options } )
+        or Usage( $usage );
+
+    return;
+}
+
+### INTERNAL UTILITY ###
+# Usage      : Copyright()
+# Purpose    : Print copyright
+# Parameters : None
+# Returns    : None
+# Throws     : None
+# Comments   : None
+# See also   : None
+sub Copyright {
+    print
+        qq[Copyright (C) 2011 Mikko Värri <vmj\@linuxbox.fi>\n],
+        qq[\n],
+        qq[This program comes with ABSOLUTELY NO WARRANTY; ],
+        qq[for details use the `-W' option.\n],
+        qq[This is free software, and you are welcome to redistribute it\n],
+        qq[under certain conditions; ],
+        qq[use the `-C' option for details.\n]
+        ;
+}
+
+### INTERNAL UTILITY ###
+# Usage      : UsageWarranty()
+# Purpose    : Print usage warranty and exit
+# Parameters : None
+# Returns    : Does not return
+# Throws     : None
+# Comments   : None
+# See also   : None
+sub UsageWarranty {
+    print
+        qq[Slackware is distributed in the hope that it will be useful,\n],
+        qq[but WITHOUT ANY WARRANTY; without even the implied warranty of\n],
+        qq[MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n],
+        qq[GNU General Public License for more details.\n],
+        qq[\n],
+        qq[You should have received a copy of the GNU General Public License\n],
+        qq[along with Slackware.  If not, see <http://www.gnu.org/licenses/>.\n],
+        ;
+    exit 0;
+}
+
+### INTERNAL UTILITY ###
+# Usage      : RedistributionConditions()
+# Purpose    : Print redistribution conditions and exit
+# Parameters : None
+# Returns    : Does not return
+# Throws     : None
+# Comments   : None
+# See also   : None
+sub RedistributionConditions {
+    print
+        qq[Slackware is free software: you can redistribute it and/or modify it\n],
+        qq[under the terms of the GNU General Public License as published by\n],
+        qq[the Free Software Foundation, either version 3 of the License, or\n],
+        qq[(at your option) any later version.\n],
+        qq[\n],
+        qq[You should have received a copy of the GNU General Public License\n],
+        qq[along with Slackware.  If not, see <http://www.gnu.org/licenses/>.\n]
+        ;
+    exit 0;
+}
+
+### INTERNAL UTILITY ###
+# Usage      : Version()
+# Purpose    : Print version and exit
+# Parameters : None
+# Returns    : Does not return
+# Throws     : None
+# Comments   : None
+# See also   : None
+sub Version {
+    # Use version control to maintain the version
+    my $version = q[ $Revision$ ];
+
+    # Remove tag and spaces
+    $version =~ s[ (?: [\$\s] | Revision:? ) ][]xmsg;
+
+    # Business as usual
+    print "$Script $version\n";
+    exit 0;
+}
+
+### INTERFACE UTILITY ###
+# Usage      : Usage()
+# Purpose    : Print usage and exit
+# Parameters : A string: Usage summary.
+# Returns    : Does not return
+# Throws     : None
+# Comments   : None
+# See also   : None
+sub Usage {
+    # Unpack arguments
+    my ($usage) = @_;
+
+    print
+        qq[Usage: $Script $usage\n],
+        qq[See '$Script --help' or '$Script --man' for more details.\n],
+        qq[\n]
+        ;
+    Copyright();
+    exit 0;
+}
+
+### INTERNAL UTILITY ###
+# Usage      : Help()
+# Purpose    : Print help and exit
+# Parameters : A string: One line summary of the command.
+#              A string: Short usage format.
+#              A reference to a list of strings: The options help.
+# Returns    : Does not return
+# Throws     : None
+# Comments   : None
+# See also   : None
+sub Help {
+    # Unpack arguments
+    my ($summary, $usage, $help) = @_;
+
+    print
+        qq[Usage: $Script $usage\n],
+        qq[\n],
+        qq[  $summary\n],
+        qq[\n],
+        qq[Options:\n]
+        ;
+    print foreach @{ $help };
+    Copyright();
+    exit 0;
+}
+
+### INTERNAL UTILITY ###
+# Usage      : Man()
+# Purpose    : Print manual and exit
+# Parameters : None
+# Returns    : Does not return
+# Throws     : None
+# Comments   : None
+# See also   : None
+sub Man {
+    exec "perldoc $0";
+    exit 0;
+}
+
+1; # Magic true value required at end of module
+__END__
+=pod
+
+=head1 NAME
+
+Slackware::CLI.pm - Standard command line interface for Slackware
+
+=head1 VERSION
+
+This document describes Slackware::CLI included in version XXX of Slackware.
+
+=head1 SYNOPSIS
+
+  use Slackware::CLI;
+
+  my $summary = "Read config and check syntax";
+  my $usage   = "[-c CONFIG]";
+  my $help    = [
+      qq[    -c CONFIG   Read settings from CONFIG.\n],
+  ];
+  my $options = {
+      'c|config=s' => \$CONFIG,
+  };
+  Slackware::CLI::ParseOptions( $summary, $usage, $help, $options );
+
+=head1 DESCRIPTION
+
+This module contain a set of utility subroutines used by Slackware.
+
+=head1 SUBROUTINES
+
+No subroutines are exported by default. You need to call each one fully qualified.
+
+=over 1
+
+=item * ParseOptions
+
+Parses the command line options and provides following standard
+options for all commands.
+
+=over 1
+
+=item * -C
+
+Print redistribution conditions to standard output and exit.  Exit
+code is zero.
+
+=item * -W
+
+Print usage warranty to standard output and exit.  Exit code is zero.
+
+=item * --usage
+
+Print usage message and copyright to standard output and exit.  Exit
+code is zero.
+
+=item * --help
+
+Print help message to standard output and exit.  Exit code is zero.
+
+=item * --man
+
+Print manual page to standard output and exit.  Exit code is zero.
+
+=item * --version
+
+Print version to standard output and exit.  Exit code is zero.
+
+=back
+
+=head1 DEPENDENCIES
+
+This module needs Perl 5.6 or above.
+
+=head1 BUGS AND LIMITATIONS
+
+There's no known bugs.
+
+Please report problems to current maintainer. Patches are welcome.
+
+=head1 COPYRIGHT
+
+Copyright 2011, Mikko Värri.
+
+=head1 LICENSE
+
+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/>.
+
+=cut