tests/quviTest.pm.in

   1 #
   2 # Copyright (C) 2010 Toni Gundogdu.
   3 #
   4 # This program is free software: you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation, either version 3 of the License, or
   7 # (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16 #
  17
  18 package quviTest;
  19
  20 use warnings;
  21 use strict;
  22
  23 use POSIX ":sys_wait_h";
  24 use File::Basename qw(basename);
  25
  26 require Exporter;
  27 use vars qw(@ISA @EXPORT @EXPORT_OK);
  28
  29 our @ISA       = qw(Exporter);
  30 our @EXPORT    = ();
  31 our @EXPORT_OK = qw(run run_t pod_checks check_codeset);
  32
  33 my $QUVI_PATH      = "@top_builddir@/src/quvi";
  34 $ENV{QUVI_BASEDIR} = "@top_srcdir@/share";
  35
  36 # Exit test if NO_INTERNET is set.
  37 sub no_internet {
  38     if ($ENV{NO_INTERNET}) {
  39         print STDERR "SKIP: No internet. Unset NO_INTERNET to enable.\n";
  40         exit (0);
  41     }
  42 }
  43
  44 # Remove these from the args: we use them for
  45 # default "flv" runs only.
  46 sub remove_checks {
  47     my (@args) = @_;
  48
  49     my @remove =
  50         qw(--page-title --video-id --file-length --file-suffix);
  51
  52     my @tmp;
  53     my $skip = 0;
  54
  55     foreach my $arg (@args) {
  56         foreach (@remove) {
  57             if ($arg =~ /$_/) {
  58                 $skip = 1;
  59                 last;
  60             }
  61         }
  62         push @tmp, $arg  if !$skip;
  63         $skip ||= $skip;
  64     }
  65
  66     return @tmp;
  67 }
  68
  69 # Wraps "-t -f $fmt", parses quvi --support output, and
  70 # tests all host supported formats.
  71 sub run_t {
  72     no_internet();
  73
  74     my @args    = ("--no-shortened", "-t", @_);
  75     my @formats = parse_formats($_[0]);
  76
  77     my $rc;
  78     foreach (@formats) {
  79         $rc = run( ("-f", $_, @args) );
  80         last if $rc != 0;
  81         @args = remove_checks(@args);
  82     }
  83
  84     return $rc;
  85 }
  86
  87 # Runs quvi with the given options. Checks and
  88 # parses the supported environment variables.
  89 sub run {
  90     my @args  = ( $QUVI_PATH, @_ );
  91     my $extra = $ENV{QUVI_TEST_OPTIONS};
  92
  93     @args = ( @args, split( /\s+/, $extra ) )
  94         if ($extra);
  95
  96     foreach (@_) {
  97         if ( $_ =~ /-t/ ) {
  98             no_internet();
  99             last;
 100         }
 101     }
 102
 103     printf "\nTEST: %s\nRUN: ", basename($0);
 104     print qq/"$_"/ . " " foreach @args;
 105     print "\n";
 106
 107     my $child = fork;
 108     if ( $child < 0 ) {
 109         die "fork: $! ($?)";
 110     }
 111     elsif ( $child == 0 ) {
 112         exit( system(@args) >> 8 );
 113     }
 114
 115     print "\n";
 116
 117     my $rc;
 118     while (1) {
 119         my $result = waitpid( $child, 0 );
 120
 121         if ( $result == -1 ) {
 122             die "no more processes to wait: pid $child not found";
 123         }
 124         elsif ( $result == 0 ) {
 125
 126             # $child is still running.
 127             next;
 128         }
 129         elsif ( $result != $child ) {
 130             die "got invalid pid $result (expected $child)";
 131         }
 132
 133         print STDERR "  ";
 134
 135         my $status = $?;
 136         if ( WIFEXITED($status) ) {
 137             $rc = WEXITSTATUS($status);
 138             print STDERR "-> child: normal termination ($rc)\n";
 139             last;
 140         }
 141         elsif ( WIFSIGNALED($status) ) {
 142             $rc = WTERMSIG($status);
 143             print STDERR "-> child: abnormal termination ($rc)\n";
 144             last;
 145         }
 146         elsif ( WIFSTOPPED($status) ) {
 147             $rc = WSTOPSIG($status);
 148             print STDERR "-> child: stopped ($rc)\n";
 149             last;
 150         }
 151     }
 152
 153     return $rc;
 154 }
 155
 156 # Parses quvi --support output. First argument is
 157 # expected to be the host id, e.g. "youtube".
 158 sub parse_formats {
 159     my $output = `$QUVI_PATH --support`;
 160     my $host = shift;
 161     my @r = ();
 162     if ($output =~ /$host\.(?:\w+\s+|\s+)(.*)/i) {
 163         @r = split(/\|/,$1);
 164     }
 165     return @r;
 166 }
 167
 168 # Check the pod markup.
 169 sub pod_checks {
 170     require Pod::Checker;
 171     my $rc = Pod::Checker::podchecker("@top_srcdir@/man1/quvi.1.pod");
 172     return $rc;
 173 }
 174
 175 # Returns current locale codeset. Terminates if codeset
 176 # is not matched to UTF-8/16/32.
 177 sub check_codeset {
 178     my $cs;
 179     eval {
 180         require I18N::Langinfo;
 181         I18N::Langinfo->import( qw(langinfo CODESET) );
 182         $cs = langinfo( CODESET() );
 183     };
 184     my $skip = 0;
 185     if ($@) { $skip = 1; }
 186     else    { if ($cs !~ /^utf/i) { $skip = 1; } }
 187     if ($skip) {
 188         print STDERR "SKIP: No utf-8 (or utf-16, utf-32) locale codeset.\n";
 189         exit (0);
 190     }
 191 }
 192
 193 1;