t/002goodperl.t

   1 # -*- Mode: perl; indent-tabs-mode: nil -*-
   2 #
   3 # The contents of this file are subject to the Mozilla Public
   4 # License Version 1.1 (the "License"); you may not use this file
   5 # except in compliance with the License. You may obtain a copy of
   6 # the License at http://www.mozilla.org/MPL/
   7 #
   8 # Software distributed under the License is distributed on an "AS
   9 # IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
  10 # implied. See the License for the specific language governing
  11 # rights and limitations under the License.
  12 #
  13 # The Original Code are the Bugzilla Tests.
  14 #
  15 # The Initial Developer of the Original Code is Zach Lipton
  16 # Portions created by Zach Lipton are
  17 # Copyright (C) 2001 Zach Lipton.  All
  18 # Rights Reserved.
  19 #
  20 # Contributor(s): Zach Lipton <zach@zachlipton.com>
  21 #                 Jacob Steenhagen <jake@bugzilla.org>
  22 #                 David D. Kilzer <ddkilzer@theracingworld.com>
  23
  24
  25 #################
  26 #Bugzilla Test 2#
  27 ####GoodPerl#####
  28
  29 use strict;
  30
  31 use lib 't';
  32
  33 use Support::Files;
  34
  35 use Test::More tests => scalar @Support::Files::testitems * 3;
  36
  37 my @testitems = @Support::Files::testitems; # get the files to test.
  38
  39 foreach my $file (@testitems) {
  40     $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
  41     next if (!$file); # skip null entries
  42     if (! open (FILE, $file)) {
  43         ok(0,"could not open $file --WARNING");
  44     }
  45     my $file_line1 = <FILE>;
  46     close (FILE);
  47
  48     $file =~ m/.*\.(.*)/;
  49     my $ext = $1;
  50
  51     if ($file_line1 !~ m/^#\!/) {
  52         ok(1,"$file does not have a shebang");
  53     } else {
  54         my $flags;
  55         if (!defined $ext || $ext eq "pl") {
  56             # standalone programs aren't taint checked yet
  57             $flags = "w";
  58         } elsif ($ext eq "pm") {
  59             ok(0, "$file is a module, but has a shebang");
  60             next;
  61         } elsif ($ext eq "cgi") {
  62             # cgi files must be taint checked
  63             $flags = "wT";
  64         } else {
  65             ok(0, "$file has shebang but unknown extension");
  66             next;
  67         }
  68
  69         if ($file_line1 =~ m#^\#\!/usr/bin/perl\s#) {
  70             if ($file_line1 =~ m#\s-$flags#) {
  71                 ok(1,"$file uses standard perl location and -$flags");
  72             } else {
  73               TODO: {
  74                 local $TODO = q(warning isn't supported globally);
  75                 ok(0,"$file is MISSING -$flags --WARNING");
  76               }
  77             }
  78         } else {
  79             ok(0,"$file uses non-standard perl location");
  80         }
  81     }
  82 }
  83
  84 foreach my $file (@testitems) {
  85     my $found_use_strict = 0;
  86     $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
  87     next if (!$file); # skip null entries
  88     if (! open (FILE, $file)) {
  89         ok(0,"could not open $file --WARNING");
  90         next;
  91     }
  92     while (my $file_line = <FILE>) {
  93         if ($file_line =~ m/^\s*use strict/) {
  94             $found_use_strict = 1;
  95             last;
  96         }
  97     }
  98     close (FILE);
  99     if ($found_use_strict) {
 100         ok(1,"$file uses strict");
 101     } else {
 102         ok(0,"$file DOES NOT use strict --WARNING");
 103     }
 104 }
 105
 106
 107 # note, the html checker is not really thorough.
 108 # in particular it will not find standard tags with parameters.
 109 # the estimate wether a file is dirty or not is still pretty helpful, as it will catch most of the closing tags.
 110 # if you are in doubt about a specific file, you still have to check it manually.
 111 my $tags = qr/b|i|u|h[1-6]|a href.*|input|form|br|textarea|table|tr|td|th|body|head|html|p|button|select|option|script/;
 112 foreach my $file (@testitems) {
 113     my $found_html_count = 0;
 114     my $found_html       = '';
 115     $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
 116     next if (!$file); # skip null entries
 117     if (! open (FILE, $file)) {
 118         ok(0,"could not open $file --WARNING");
 119         next;
 120     }
 121     while (my $file_line = <FILE>) {
 122         if ($file_line =~ m/(<\/?$tags>)/) {
 123             $found_html_count++;
 124             $found_html .= $1;
 125         }
 126     }
 127     close (FILE);
 128     if (!$found_html_count) {
 129         ok(1,"$file does not contain HTML");
 130     } elsif ($found_html_count < 50) {
 131       TODO: { local $TODO = q(Even little amounts of HTML should go away....);
 132         ok(0,"$file contains at least $found_html_count html tags.");
 133       }
 134     } else {
 135         ok(0,"$file contains at least $found_html_count html tags.");
 136     }
 137 }
 138
 139 exit 0;