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 * 2;
  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                 ok(0,"$file is MISSING -$flags --WARNING");
  74             }
  75         } else {
  76             ok(0,"$file uses non-standard perl location");
  77         }
  78     }
  79 }
  80
  81 TODO: {
  82 local $TODO = 'strict is not implemented thoroughly yet';
  83 foreach my $file (@testitems) {
  84     my $found_use_strict = 0;
  85     $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
  86     next if (!$file); # skip null entries
  87     if (! open (FILE, $file)) {
  88         ok(0,"could not open $file --WARNING");
  89         next;
  90     }
  91     while (my $file_line = <FILE>) {
  92         if ($file_line =~ m/^\s*use strict/) {
  93             $found_use_strict = 1;
  94             last;
  95         }
  96     }
  97     close (FILE);
  98     if ($found_use_strict) {
  99         ok(1,"$file uses strict");
 100     } else {
 101         ok(0,"$file DOES NOT use strict --WARNING");
 102     }
 103 }
 104 }
 105
 106 exit 0;