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     local $TODO;
  86     $TODO = 'schema updates are not required to be strict now' if $file =~ m{^sql/Pg-upgrade2};
  87     my $found_use_strict = 0;
  88     $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
  89     next if (!$file); # skip null entries
  90     if (! open (FILE, $file)) {
  91         ok(0,"could not open $file --WARNING");
  92         next;
  93     }
  94     while (my $file_line = <FILE>) {
  95         if ($file_line =~ m/^\s*use strict/) {
  96             $found_use_strict = 1;
  97             last;
  98         }
  99     }
 100     close (FILE);
 101     if ($found_use_strict) {
 102         ok(1,"$file uses strict");
 103     } else {
 104         ok(0,"$file DOES NOT use strict --WARNING");
 105     }
 106 }
 107
 108
 109 # note, the html checker is not really thorough.
 110 # in particular it will not find standard tags with parameters.
 111 # the estimate wether a file is dirty or not is still pretty helpful, as it will catch most of the closing tags.
 112 # if you are in doubt about a specific file, you still have to check it manually.
 113 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/;
 114 foreach my $file (@testitems) {
 115     my $found_html_count = 0;
 116     my $found_html       = '';
 117     $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
 118     next if (!$file); # skip null entries
 119     if (! open (FILE, $file)) {
 120         ok(0,"could not open $file --WARNING");
 121         next;
 122     }
 123     while (my $file_line = <FILE>) {
 124         last if $file_line =~ /^__END__/;
 125         if ($file_line =~ m/(<\/?$tags>)/o) {
 126             $found_html_count++;
 127             $found_html .= $1;
 128         }
 129     }
 130     close (FILE);
 131     if (!$found_html_count) {
 132         ok(1,"$file does not contain HTML");
 133     } elsif ($found_html_count < 50) {
 134       TODO: { local $TODO = q(Even little amounts of HTML should go away....);
 135         ok(0,"$file contains at least $found_html_count html tags.");
 136       }
 137     } else {
 138         ok(0,"$file contains at least $found_html_count html tags.");
 139     }
 140 }
 141
 142 exit 0;