tests/quviTest.pm.in

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