Merge branch 'flash'
[kivitendo-erp.git] / 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;