tests/perlmodules.t

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # perlmodules.t
   5 # File ID: a2e25ad4-56fe-11e0-8c2f-00023faf1383
   6 #
   7 # Find missing Perl modules.
   8 #
   9 # Character set: UTF-8
  10 # ©opyleft 2011– Øyvind A. Holm <sunny@sunbase.org>
  11 # License: GNU General Public License version 2 or later, see end of
  12 # file for legal stuff.
  13 #=======================================================================
  14
  15 use strict;
  16 use warnings;
  17
  18 BEGIN {
  19     use Test::More qw{no_plan};
  20     # use_ok() goes here
  21
  22     use lib "$ENV{HOME}/bin/Lib/perllib";
  23     use lib "$ENV{HOME}/bin/src/fldb";
  24     use lib "$ENV{HOME}/bin/src/gpstools";
  25
  26 }
  27
  28 use Getopt::Long;
  29
  30 local $| = 1;
  31
  32 our $CMDB = "";
  33 our $CMD = "../$CMDB";
  34
  35 our %Opt = (
  36
  37     'all' => 0,
  38     'help' => 0,
  39     'quiet' => 0,
  40     'todo' => 0,
  41     'verbose' => 0,
  42     'version' => 0,
  43
  44 );
  45
  46 our $progname = $0;
  47 $progname =~ s/^.*\/(.*?)$/$1/;
  48 our $VERSION = '0.0.0';
  49
  50 my %descriptions = ();
  51
  52 Getopt::Long::Configure('bundling');
  53 GetOptions(
  54
  55     'all|a' => \$Opt{'all'},
  56     'help|h' => \$Opt{'help'},
  57     'quiet|q+' => \$Opt{'quiet'},
  58     'todo|t' => \$Opt{'todo'},
  59     'verbose|v+' => \$Opt{'verbose'},
  60     'version' => \$Opt{'version'},
  61
  62 ) || die("$progname: Option error. Use -h for help.\n");
  63
  64 $Opt{'verbose'} -= $Opt{'quiet'};
  65 $Opt{'help'} && usage(0);
  66 if ($Opt{'version'}) {
  67     print_version();
  68     exit(0);
  69 }
  70
  71 exit(main());
  72
  73 sub main {
  74     # {{{
  75     my $Retval = 0;
  76
  77     diag(sprintf('========== Executing %s v%s ==========',
  78                  $progname, $VERSION));
  79
  80     if ($Opt{'todo'} && !$Opt{'all'}) {
  81         goto todo_section;
  82     }
  83
  84 =pod
  85
  86     testcmd("$CMD command", # {{{
  87         <<'END',
  88 [expected stdout]
  89 END
  90         '',
  91         0,
  92         'description',
  93     );
  94
  95     # }}}
  96
  97 =cut
  98
  99     my %Modules = (
 100
 101         'Authen::SASL' => 'libauthen-sasl-perl',
 102         'CGI' => '',
 103         'Cwd' => '',
 104         'DBI' => 'libdbi-perl',
 105         'Data::Dumper' => '',
 106         'Date::Manip' => 'libdate-manip-perl',
 107         'Devel::GDB' => 'libdevel-gdb-perl',
 108         'Devel::NYTProf' => 'libdevel-nytprof-perl',
 109         'Devel::ptkdb' => 'libdevel-ptkdb-perl',
 110         'Digest::CRC' => 'libdigest-crc-perl',
 111         'Digest::MD5' => 'libdigest-md5-file-perl',
 112         'Digest::SHA' => 'libdigest-sha-perl',
 113         'Env' => '',
 114         'Exporter' => '',
 115         'FLDBdebug' => '', # mine
 116         'FLDBpg' => '', # mine
 117         'FLDBsum' => '', # mine
 118         'FLDButf' => '', # mine
 119         'Fcntl' => '',
 120         'File::Basename' => '',
 121         'File::Copy' => '',
 122         'File::Find' => '',
 123         'File::Glob' => '',
 124         'File::Path' => '',
 125         'File::Spec' => '',
 126         'File::Temp' => '',
 127         'FileHandle' => '',
 128         'GPST' => '', # mine
 129         'GPSTdate' => '', # mine
 130         'GPSTdebug' => '', # mine
 131         'GPSTgeo' => '', # mine
 132         'GPSTxml' => '', # mine
 133         'Getopt::Long' => '',
 134         'Getopt::Std' => '',
 135         'GraphViz' => 'libgraphviz-perl',
 136         'HTML::Template' => 'libhtml-template-perl',
 137         'HTML::TreeBuilder' => 'libxml-treebuilder-perl libhtml-treebuilder-xpath-perl',
 138         'HTML::WikiConverter' => 'libhtml-wikiconverter-mediawiki-perl',
 139         'IO::Handle' => '',
 140         'IPC::Open3' => '',
 141         'Image::ExifTool' => 'libimage-exiftool-perl',
 142         'JSON::XS' => 'libjson-xs-perl',
 143         'MIME::Base64' => 'libmime-base64-urlsafe-perl',
 144         'Math::Round' => 'libmath-round-perl',
 145         'Net::SMTP::SSL' => 'libnet-smtp-ssl-perl',
 146         'Number::Bytes::Human' => 'libnumber-bytes-human-perl',
 147         'OSSP::uuid' => 'libossp-uuid-perl',
 148         'POSIX' => '',
 149         'Perl::Critic' => 'libtest-perl-critic-perl',
 150         'Socket' => '',
 151         'Term::ReadLine' => '',
 152         'Term::ReadLine::Gnu' => 'libterm-readline-gnu-perl',
 153         'Term::ReadLine::Perl' => 'libterm-readline-perl-perl',
 154         'Test::More' => '',
 155         'Test::Perl::Critic' => 'libtest-perl-critic-perl',
 156         'Text::Diff' => 'libtext-diff-perl',
 157         'Time::HiRes' => '',
 158         'Time::Local' => '',
 159         'XML::Parser' => 'libxml-parser-perl',
 160         'bigint' => '',
 161         'constant' => '',
 162         'strict' => '',
 163         'utf8' => '',
 164         'vars' => '',
 165
 166     );
 167
 168     my @missing = ();
 169     my $outfile = './install-modules';
 170
 171     unlink $outfile;
 172     for my $mod (sort keys %Modules) {
 173         my $package = $Modules{$mod};
 174         use_ok($mod) || length($package) && push(@missing, $package);
 175     }
 176     -e "nytprof.out" && ok(unlink("nytprof.out"), "Remove nytprof.out");
 177
 178     if (scalar(@missing)) {
 179         open(my $fp, '>', $outfile) || die("$progname: $outfile: Cannot create file: $!\n");
 180         print($fp
 181             join("\n",
 182                 '#!/bin/sh',
 183                 '',
 184                 '# Created by perlmodules.t',
 185                 '',
 186                 "sudo apt-get update\n",
 187             )
 188         );
 189         for my $m (@missing) {
 190             print($fp "sudo apt-get --assume-yes install $m\n");
 191         }
 192         ok(close($fp), "Close $outfile");
 193         ok(chmod(0755, $outfile), "Make $outfile executable");
 194         diag("\nExecute $outfile to install missing modules.\n\n");
 195         diag("Contents of $outfile:\n==== BEGIN ====\n", file_data($outfile), "==== END ====\n\n");
 196     }
 197
 198     todo_section:
 199     ;
 200
 201     if ($Opt{'all'} || $Opt{'todo'}) {
 202         diag('Running TODO tests...'); # {{{
 203
 204         TODO: {
 205
 206             local $TODO = '';
 207             # Insert TODO tests here.
 208
 209         }
 210         # TODO tests }}}
 211     }
 212
 213     diag('Testing finished.');
 214     return $Retval;
 215     # }}}
 216 } # main()
 217
 218 sub testcmd {
 219     # {{{
 220     my ($Cmd, $Exp_stdout, $Exp_stderr, $Exp_retval, $Desc) = @_;
 221     defined($descriptions{$Desc}) &&
 222         BAIL_OUT("testcmd(): '$Desc' description is used twice");
 223     $descriptions{$Desc} = 1;
 224     my $stderr_cmd = '';
 225     my $cmd_outp_str = $Opt{'verbose'} >= 1 ? "\"$Cmd\" - " : '';
 226     my $Txt = join('', $cmd_outp_str, defined($Desc) ? $Desc : '');
 227     my $TMP_STDERR = "$CMDB-stderr.tmp";
 228     my $retval = 1;
 229
 230     if (defined($Exp_stderr)) {
 231         $stderr_cmd = " 2>$TMP_STDERR";
 232     }
 233     $retval &= is(`$Cmd$stderr_cmd`, $Exp_stdout, "$Txt (stdout)");
 234     my $ret_val = $?;
 235     if (defined($Exp_stderr)) {
 236         $retval &= is(file_data($TMP_STDERR), $Exp_stderr, "$Txt (stderr)");
 237         unlink($TMP_STDERR);
 238     } else {
 239         diag("Warning: stderr not defined for '$Txt'");
 240     }
 241     $retval &= is($ret_val >> 8, $Exp_retval, "$Txt (retval)");
 242
 243     return $retval;
 244     # }}}
 245 } # testcmd()
 246
 247 sub likecmd {
 248     # {{{
 249     my ($Cmd, $Exp_stdout, $Exp_stderr, $Exp_retval, $Desc) = @_;
 250     defined($descriptions{$Desc}) &&
 251         BAIL_OUT("likecmd(): '$Desc' description is used twice");
 252     $descriptions{$Desc} = 1;
 253     my $stderr_cmd = '';
 254     my $cmd_outp_str = $Opt{'verbose'} >= 1 ? "\"$Cmd\" - " : '';
 255     my $Txt = join('', $cmd_outp_str, defined($Desc) ? $Desc : '');
 256     my $TMP_STDERR = "$CMDB-stderr.tmp";
 257     my $retval = 1;
 258
 259     if (defined($Exp_stderr)) {
 260         $stderr_cmd = " 2>$TMP_STDERR";
 261     }
 262     $retval &= like(`$Cmd$stderr_cmd`, $Exp_stdout, "$Txt (stdout)");
 263     my $ret_val = $?;
 264     if (defined($Exp_stderr)) {
 265         $retval &= like(file_data($TMP_STDERR), $Exp_stderr, "$Txt (stderr)");
 266         unlink($TMP_STDERR);
 267     } else {
 268         diag("Warning: stderr not defined for '$Txt'");
 269     }
 270     $retval &= is($ret_val >> 8, $Exp_retval, "$Txt (retval)");
 271
 272     return $retval;
 273     # }}}
 274 } # likecmd()
 275
 276 sub file_data {
 277     # Return file content as a string {{{
 278     my $File = shift;
 279     my $Txt;
 280
 281     open(my $fp, '<', $File) or return undef;
 282     local $/ = undef;
 283     $Txt = <$fp>;
 284     close($fp);
 285     return $Txt;
 286     # }}}
 287 } # file_data()
 288
 289 sub print_version {
 290     # Print program version {{{
 291     print("$progname $VERSION\n");
 292     return;
 293     # }}}
 294 } # print_version()
 295
 296 sub usage {
 297     # Send the help message to stdout {{{
 298     my $Retval = shift;
 299
 300     if ($Opt{'verbose'}) {
 301         print("\n");
 302         print_version();
 303     }
 304     print(<<"END");
 305
 306 Usage: $progname [options]
 307
 308 Find missing Perl modules.
 309
 310 Options:
 311
 312   -a, --all
 313     Run all tests, also TODOs.
 314   -h, --help
 315     Show this help.
 316   -q, --quiet
 317     Be more quiet. Can be repeated to increase silence.
 318   -t, --todo
 319     Run only the TODO tests.
 320   -v, --verbose
 321     Increase level of verbosity. Can be repeated.
 322   --version
 323     Print version information.
 324
 325 END
 326     exit($Retval);
 327     # }}}
 328 } # usage()
 329
 330 sub msg {
 331     # Print a status message to stderr based on verbosity level {{{
 332     my ($verbose_level, $Txt) = @_;
 333
 334     $verbose_level > $Opt{'verbose'} && return;
 335     print(STDERR "$progname: $Txt\n");
 336     return;
 337     # }}}
 338 } # msg()
 339
 340 __END__
 341
 342 # This program is free software; you can redistribute it and/or modify
 343 # it under the terms of the GNU General Public License as published by
 344 # the Free Software Foundation; either version 2 of the License, or (at
 345 # your option) any later version.
 346 #
 347 # This program is distributed in the hope that it will be useful, but
 348 # WITHOUT ANY WARRANTY; without even the implied warranty of
 349 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 350 # See the GNU General Public License for more details.
 351 #
 352 # You should have received a copy of the GNU General Public License
 353 # along with this program.
 354 # If not, see L<http://www.gnu.org/licenses/>.
 355
 356 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :