tests/ydid.t

   1 #!/usr/bin/env perl
   2
   3 #==============================================================================
   4 # ydid.t
   5 # File ID: 53506c76-23d9-11e9-a4b6-4f45262dc9b5
   6 #
   7 # Test suite for ydid(1).
   8 #
   9 # Character set: UTF-8
  10 # ©opyleft 2019– Øyvind A. Holm <sunny@sunbase.org>
  11 # License: GNU General Public License version 2 or later, see end of file for
  12 # 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
  23 use Getopt::Long;
  24
  25 local $| = 1;
  26
  27 our $CMDB = "ydid";
  28 our $CMD = "../$CMDB";
  29
  30 our %Opt = (
  31
  32         'all' => 0,
  33         'help' => 0,
  34         'quiet' => 0,
  35         'todo' => 0,
  36         'verbose' => 0,
  37         'version' => 0,
  38
  39 );
  40
  41 our $progname = $0;
  42 $progname =~ s/^.*\/(.*?)$/$1/;
  43 our $VERSION = '0.0.0';
  44
  45 my %deburl = (
  46         'go1' => "google.com/url*url=*",
  47         'tw1' => "twitter.com/*/status/*",
  48         'yt1' => "youtube.com/watch?v=*",
  49         'yt2' => "youtu.be/*",
  50         'yt3' => "plain id",
  51 );
  52 my %descriptions = ();
  53
  54 Getopt::Long::Configure('bundling');
  55 GetOptions(
  56
  57         'all|a' => \$Opt{'all'},
  58         'help|h' => \$Opt{'help'},
  59         'quiet|q+' => \$Opt{'quiet'},
  60         'todo|t' => \$Opt{'todo'},
  61         'verbose|v+' => \$Opt{'verbose'},
  62         'version' => \$Opt{'version'},
  63
  64 ) || die("$progname: Option error. Use -h for help.\n");
  65
  66 $Opt{'verbose'} -= $Opt{'quiet'};
  67 $Opt{'help'} && usage(0);
  68 if ($Opt{'version'}) {
  69         print_version();
  70         exit(0);
  71 }
  72
  73 exit(main());
  74
  75 sub main {
  76         my $Retval = 0;
  77
  78         diag(sprintf('========== Executing %s v%s ==========',
  79                      $progname, $VERSION));
  80
  81         if ($Opt{'todo'} && !$Opt{'all'}) {
  82                 goto todo_section;
  83         }
  84
  85         test_standard_options();
  86         test_executable();
  87         test_create_url_option();
  88
  89         todo_section:
  90         ;
  91
  92         if ($Opt{'all'} || $Opt{'todo'}) {
  93                 diag('Running TODO tests...');
  94                 TODO: {
  95                         local $TODO = '';
  96                         # Insert TODO tests here.
  97                 }
  98         }
  99
 100         diag('Testing finished.');
 101
 102         return $Retval;
 103 }
 104
 105 sub test_standard_options {
 106         diag('Testing -h (--help) option...');
 107         likecmd("$CMD -h",
 108                 '/  Show this help/i',
 109                 '/^$/',
 110                 0,
 111                 'Option -h prints help screen');
 112
 113         diag('Testing -v (--verbose) option...');
 114         likecmd("$CMD -hv",
 115                 '/^\n\S+ \d+\.\d+\.\d+/s',
 116                 '/^$/',
 117                 0,
 118                 'Option -v with -h returns version number and help screen');
 119
 120         diag('Testing --version option...');
 121         likecmd("$CMD --version",
 122                 '/^\S+ \d+\.\d+\.\d+/',
 123                 '/^$/',
 124                 0,
 125                 'Option --version returns version number');
 126         return;
 127 }
 128
 129 sub test_executable {
 130         my ($id, $url);
 131         $id = "su045ytF_z4";
 132
 133         diag("Executing test_executable()");
 134         testcmd("$CMD",
 135                 "",
 136                 "$CMDB: No URL specified\n",
 137                 1,
 138                 'No URL specified');
 139         testcmd("$CMD https://doesntexist.invalid",
 140                 "",
 141                 "$CMDB: Unknown URL format\n",
 142                 1,
 143                 'Unknown URL format');
 144         diag("Plain id");
 145         test_yt_url($id, $id, $deburl{'yt3'}, "Plain id");
 146         testcmd("$CMD " . "a" x 10,
 147                 "",
 148                 "$CMDB: Unknown URL format\n",
 149                 1,
 150                 'Plain id, one character too short');
 151         testcmd("$CMD " . "a" x 12,
 152                 "",
 153                 "$CMDB: Unknown URL format\n",
 154                 1,
 155                 'Plain id, one character too long');
 156         testcmd("$CMD aaaaa,aaaaa",
 157                 "",
 158                 "$CMDB: Invalid Youtube ID\n",
 159                 1,
 160                 'Plain id with invalid character');
 161
 162         for my $p ("https://", "http://", "") {
 163                 diag("Use \"$p\" prefix");
 164                 diag($deburl{'yt1'});
 165
 166                 for my $w ("www.", "m.", "") {
 167                         testcmd("$CMD $p${w}youtube.com/watch?v=",
 168                                 "",
 169                                 "$CMDB: Invalid URL\n",
 170                                 1,
 171                                 "v= has no id, $p$w*");
 172
 173                         testcmd("$CMD $p${w}youtube.com/watch?v=abcde,ghijk",
 174                                 "",
 175                                 "$CMDB: Invalid URL\n",
 176                                 1,
 177                                 "v= contains invalid character, $p$w*");
 178                         $url = "$p${w}youtube.com/watch?v=$id";
 179                         diag($url);
 180                         test_yt_url($id, $url, $deburl{'yt1'}, $url);
 181                         test_yt_url($id, "$url&t=0s", $deburl{'yt1'},
 182                                     "$url&t=0s");
 183                         $url = "$p${w}youtube.com/watch?t=0s&v=$id";
 184                         diag($url);
 185                         test_yt_url($id, $url, $deburl{'yt1'}, $url);
 186                         test_yt_url($id, "$url&abc=def", $deburl{'yt1'},
 187                                     "$url&abc=def");
 188
 189                         diag($deburl{'yt2'});
 190                         testcmd("$CMD $p${w}youtu\.be/",
 191                                 "",
 192                                 "$CMDB: Invalid URL\n",
 193                                 1,
 194                                 "Missing id in $deburl{'yt2'}, $p$w*");
 195
 196                         testcmd("$CMD $p${w}youtu\.be/abcde,ghijk",
 197                                 "",
 198                                 "$CMDB: Invalid URL\n",
 199                                 1,
 200                                 "Invalid character in $deburl{'yt2'}, $p$w*");
 201
 202                         $url = "$p${w}youtu.be/$id";
 203                         diag($url);
 204                         test_yt_url($id, $url, $deburl{'yt2'}, $url);
 205                         test_yt_url($id, "$url&t=0s", $deburl{'yt2'}, "$url&t=0s");
 206                 }
 207
 208                 my $twid = "1234567890123456789";
 209                 my $twname = "example";
 210                 for my $w ("www.", "m.", "") {
 211                         $url = "$p${w}twitter.com/$twname/status/$twid";
 212                         test_yt_url($twid, $url, $deburl{'tw1'}, $url);
 213                         test_yt_url($twid, "$url?abc=def", $deburl{'tw1'},
 214                                     "$url?abc=def");
 215                         $url = "$p${w}twitter.com/$twname/status/";
 216                         testcmd("$CMD $url",
 217                                 "",
 218                                 "$CMDB: Unknown URL format\n",
 219                                 1,
 220                                 "Missing Twitter ID, $p$w*");
 221                         $url = "$p${w}twitter.com/$twname/status/abc";
 222                         testcmd("$CMD $url",
 223                                 "",
 224                                 "$CMDB: Unknown URL format\n",
 225                                 1,
 226                                 "Non-digit in Twitter ID, $p$w*");
 227                 }
 228
 229                 # Google URL, gzip + base64:
 230                 # H4sIAAAAAAACAx3OzWrCQBQF4H3fI3dXQxMFFS5l1ISogRiKbbaTyTBj1E4zv
 231                 # +jTmxTO6nDgfNLaP7OO4xDCTCglbnzG1D12+vZpKFrQzGIPAwI3mqEBo5xmHA
 232                 # NvgXX4AYx2qHsKjo7DJXjeYULl+ZiFC5sPfJEcWkFkcxn25lh8iXKzEvVjew2
 233                 # kUNmWnOtNDeMXyokRpSRK8jET5qGcde2/ZmqoZTJKcx+lu6fdZ0rketXPwRmB
 234                 # pPLfNKRs8TyUp6b67Ypd48sf8+6b6u0Fo5rSbeAAAAA=
 235                 my $goid = "ztIEogFr9j4";
 236                 for my $w ("www.", "m.", "") {
 237                         my $url = "$p${w}google.com/url?sa=t" .
 238                                   "&rct=j" .
 239                                   "&q=" .
 240                                   "&esrc=s" .
 241                                   "&source=web" .
 242                                   "&cd=1" .
 243                                   "&cad=rja" .
 244                                   "&uact=8" .
 245                                   "&ved=2ahUKEwic4qe52JbgAhXiqIsKHSgLB9gQyCk" .
 246                                     "wAHoECAUQBQ" .
 247                                   "&url=https%3A%2F%2Fwww.youtube.com%2F" .
 248                                     "watch%3Fv%3DztIEogFr9j4" .
 249                                   "&usg=AOvVaw3c5zJLPXOndHDXvLWs-vXO";
 250                         testcmd("$CMD -vv '$url'",
 251                                 "$goid\n",
 252                                 "$CMDB: url = \"$url\"\n" .
 253                                   "$CMDB: Found $deburl{'go1'}\n" .
 254                                   "$CMDB: url = " .
 255                                     "\"https://www.youtube.com/watch?" .
 256                                     "v=$goid\"\n" .
 257                                   "$CMDB: Found $deburl{'yt1'}\n",
 258                                 0,
 259                                 "$p${w}google.com url to Youtube video");
 260                         my $egoid = $goid;
 261                         $egoid =~ s/g/,/;
 262                         $url =~ s/$goid/$egoid/;
 263                         testcmd("$CMD -vv '$url'",
 264                                 "",
 265                                 "$CMDB: url = \"$url\"\n" .
 266                                   "$CMDB: Found $deburl{'go1'}\n" .
 267                                   "$CMDB: url = " .
 268                                     "\"https://www.youtube.com/watch?" .
 269                                     "v=$egoid\"\n" .
 270                                   "$CMDB: Found $deburl{'yt1'}\n" .
 271                                   "$CMDB: Invalid URL\n",
 272                                 1,
 273                                 "$p${w}google.com url has invalid char " .
 274                                   "in id");
 275
 276                         $twid = '1' x 19;
 277                         $url = "$p${w}google.com/url?sa=t&rct=j&" .
 278                                "&url=https%3A%2F%2Ftwitter.com%2Fabc%2F" .
 279                                     "status%2F$twid%3Flang%3Den";
 280                         testcmd("$CMD -vv '$url'",
 281                                 "$twid\n",
 282                                 "$CMDB: url = \"$url\"\n" .
 283                                   "$CMDB: Found $deburl{'go1'}\n" .
 284                                   "$CMDB: url = " .
 285                                     "\"https://twitter.com/abc/status/$twid" .
 286                                     "?lang=en\"\n" .
 287                                   "$CMDB: Found $deburl{'tw1'}\n",
 288                                 0,
 289                                 "$p${w}google.com url with twitter url");
 290                 }
 291         }
 292 }
 293
 294 sub test_create_url_option {
 295         my $id = "ztIEogFr9j4";
 296         my $google_url = "https://google.com/url?sa=t" .
 297                   "&rct=j" .
 298                   "&url=https%3A%2F%2Fwww.youtube.com%2F" .
 299                     "watch%3Fv%3D$id" .
 300                   "&q=";
 301         my $url_yt1 = "https://www.youtube.com/watch?v=$id";
 302         my $url_yt2 = "https://youtu.be/$id";
 303
 304         for my $o ("-c", "--create-url") {
 305                 test_c_url($o, $url_yt1, $url_yt1, $id, $deburl{'yt1'});
 306                 test_c_url($o, $url_yt2, $url_yt1, $id, $deburl{'yt2'});
 307                 test_c_url($o, $id, $url_yt1, $id, $deburl{'yt3'});
 308                 test_c_url($o, $google_url, $url_yt1, $id, $deburl{'go1'});
 309
 310                 my $eid = $id;
 311                 $eid =~ s/g/,/;
 312                 my $gurl = $google_url;
 313                 $gurl =~ s/$id/$eid/;
 314                 testcmd("$CMD -vv $o '$gurl'",
 315                         "",
 316                         "$CMDB: url = \"$gurl\"\n" .
 317                           "$CMDB: Found $deburl{'go1'}\n" .
 318                           "$CMDB: url = " .
 319                             "\"https://www.youtube.com/watch?" .
 320                             "v=$eid\"\n" .
 321                           "$CMDB: Found $deburl{'yt1'}\n" .
 322                           "$CMDB: Invalid URL\n",
 323                         1,
 324                         "Invalid char in google url, $o");
 325
 326                 for my $p ("https://", "http://", "") {
 327                         for my $w ("www.", "m.", "") {
 328                                 my $id = "1234567890";
 329                                 my $user = "example";
 330                                 my $genurl = "https://twitter.com/$user/" .
 331                                              "status/$id";
 332                                 my $url = "$p${w}twitter.com/$user/" .
 333                                           "status/$id";
 334
 335                                 for (1, 2) {
 336                                         test_c_url($o, $url, $genurl, $id,
 337                                                    $deburl{'tw1'});
 338                                         $url .= "?abc=def&jada=masa";
 339                                 }
 340                         }
 341                 }
 342         }
 343 }
 344
 345 sub test_c_url {
 346         my ($o, $arg, $url, $id, $deburl) = @_;
 347         my $debtxt = "$CMDB: url = \"$arg\"\n" .
 348                      "$CMDB: Found $deburl\n";
 349
 350         if ($deburl eq $deburl{'go1'}) {
 351                 $debtxt .= "ydid: url = \"https://www.youtube.com/" .
 352                              "watch?v=$id\"\n" .
 353                            "ydid: Found $deburl{'yt1'}\n";
 354         }
 355
 356         testcmd("$CMD -vv $o '$arg'", "$url\n", $debtxt, 0, "$o '$arg'");
 357 }
 358
 359 sub test_yt_url {
 360         my ($id, $url, $deburl, $desc) = @_;
 361
 362         testcmd("$CMD -vv '$url'",
 363                 "$id\n",
 364                 "$CMDB: url = \"$url\"\n" .
 365                 "$CMDB: Found $deburl\n",
 366                 0,
 367                 $desc);
 368 }
 369
 370 sub testcmd {
 371         my ($Cmd, $Exp_stdout, $Exp_stderr, $Exp_retval, $Desc) = @_;
 372         defined($descriptions{$Desc}) &&
 373                 BAIL_OUT("testcmd(): '$Desc' description is used twice");
 374         $descriptions{$Desc} = 1;
 375         my $stderr_cmd = '';
 376         my $cmd_outp_str = $Opt{'verbose'} >= 1 ? "\"$Cmd\" - " : '';
 377         my $Txt = join('', $cmd_outp_str, defined($Desc) ? $Desc : '');
 378         my $TMP_STDERR = "$CMDB-stderr.tmp";
 379         my $retval = 1;
 380
 381         if (defined($Exp_stderr)) {
 382                 $stderr_cmd = " 2>$TMP_STDERR";
 383         }
 384         $retval &= is(`$Cmd$stderr_cmd`, $Exp_stdout, "$Txt (stdout)");
 385         my $ret_val = $?;
 386         if (defined($Exp_stderr)) {
 387                 $retval &= is(file_data($TMP_STDERR),
 388                               $Exp_stderr, "$Txt (stderr)");
 389                 unlink($TMP_STDERR);
 390         } else {
 391                 diag("Warning: stderr not defined for '$Txt'");
 392         }
 393         $retval &= is($ret_val >> 8, $Exp_retval, "$Txt (retval)");
 394
 395         return $retval;
 396 }
 397
 398 sub likecmd {
 399         my ($Cmd, $Exp_stdout, $Exp_stderr, $Exp_retval, $Desc) = @_;
 400         defined($descriptions{$Desc}) &&
 401                 BAIL_OUT("likecmd(): '$Desc' description is used twice");
 402         $descriptions{$Desc} = 1;
 403         my $stderr_cmd = '';
 404         my $cmd_outp_str = $Opt{'verbose'} >= 1 ? "\"$Cmd\" - " : '';
 405         my $Txt = join('', $cmd_outp_str, defined($Desc) ? $Desc : '');
 406         my $TMP_STDERR = "$CMDB-stderr.tmp";
 407         my $retval = 1;
 408
 409         if (defined($Exp_stderr)) {
 410                 $stderr_cmd = " 2>$TMP_STDERR";
 411         }
 412         $retval &= like(`$Cmd$stderr_cmd`, $Exp_stdout, "$Txt (stdout)");
 413         my $ret_val = $?;
 414         if (defined($Exp_stderr)) {
 415                 $retval &= like(file_data($TMP_STDERR),
 416                                 $Exp_stderr, "$Txt (stderr)");
 417                 unlink($TMP_STDERR);
 418         } else {
 419                 diag("Warning: stderr not defined for '$Txt'");
 420         }
 421         $retval &= is($ret_val >> 8, $Exp_retval, "$Txt (retval)");
 422
 423         return $retval;
 424 }
 425
 426 sub file_data {
 427         # Return file content as a string
 428         my $File = shift;
 429         my $Txt;
 430
 431         open(my $fp, '<', $File) or return undef;
 432         local $/ = undef;
 433         $Txt = <$fp>;
 434         close($fp);
 435         return $Txt;
 436 }
 437
 438 sub create_file {
 439         # Create new file and fill it with data
 440         my ($file, $text) = @_;
 441         my $retval = 0;
 442
 443         open(my $fp, ">$file") or return 0;
 444         print($fp $text);
 445         close($fp);
 446         $retval = is(file_data($file), $text,
 447                      "$file was successfully created");
 448
 449         return $retval; # 0 if error, 1 if ok
 450 }
 451
 452 sub print_version {
 453         # Print program version
 454         print("$progname $VERSION\n");
 455         return;
 456 }
 457
 458 sub usage {
 459         # Send the help message to stdout
 460         my $Retval = shift;
 461
 462         if ($Opt{'verbose'}) {
 463                 print("\n");
 464                 print_version();
 465         }
 466         print(<<"END");
 467
 468 Usage: $progname [options]
 469
 470 Contains tests for the $CMDB(1) program.
 471
 472 Options:
 473
 474   -a, --all
 475     Run all tests, also TODOs.
 476   -h, --help
 477     Show this help.
 478   -q, --quiet
 479     Be more quiet. Can be repeated to increase silence.
 480   -t, --todo
 481     Run only the TODO tests.
 482   -v, --verbose
 483     Increase level of verbosity. Can be repeated.
 484   --version
 485     Print version information.
 486
 487 END
 488         exit($Retval);
 489 }
 490
 491 sub msg {
 492         # Print a status message to stderr based on verbosity level
 493         my ($verbose_level, $Txt) = @_;
 494
 495         $verbose_level > $Opt{'verbose'} && return;
 496         print(STDERR "$progname: $Txt\n");
 497         return;
 498 }
 499
 500 __END__
 501
 502 # This program is free software; you can redistribute it and/or modify it under
 503 # the terms of the GNU General Public License as published by the Free Software
 504 # Foundation; either version 2 of the License, or (at your option) any later
 505 # version.
 506 #
 507 # This program is distributed in the hope that it will be useful, but WITHOUT
 508 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
 509 # FOR A PARTICULAR PURPOSE.
 510 # See the GNU General Public License for more details.
 511 #
 512 # You should have received a copy of the GNU General Public License along with
 513 # this program.
 514 # If not, see L<http://www.gnu.org/licenses/>.
 515
 516 # vim: set ts=8 sw=8 sts=8 noet fo+=w tw=79 fenc=UTF-8 :