home *** CD-ROM | disk | FTP | other *** search
Text File | 1996-08-01 | 7.5 KB | 264 lines | [TEXT/ttxt] |
- #========================================================================
- # Function: whine
- # Purpose: Give a standard format whine:
- # filename(line #): <message>
- # The associative array `enabled' is used as a gating
- # function, to suppress or enable each warning. Every
- # warning has an associated identifier, which is used to
- # refer to the warning, and as the index into the hash.
- #========================================================================
- sub whine
- {
- local($line, $id, @argv) = @_;
- local($mstyle) = $variable{'message-style'};
-
- ## JS 12-6-95
- ## Added the following lines so that the results would be saved to a file
- ## this is nice for the mac version.
- local ($outFile) = ":MacWebLint Results";
- open (OUTFILE, ">>$outFile") || die "cannot do it: $!\n";
-
- return unless $enabled{$id};
- $exit_status = 1;
-
- ## JS 12-6-95
- ## rewritten to output to a text file cause this is the way that
- ## i want it to work. this is the best way that i know how to do it.
-
- if ($mstyle eq 'terse') {
- print "$filename:$line:$id\n";
- print OUTFILE "$filename:$line:$id\n";
- return; }
-
- if ($mstyle eq 'lint') {
- (eval "print \"$filename($line): $message{$id}\n\"");
- (eval "print OUTFILE \"$filename($line): $message{$id}\n\"");
- return; }
-
- if ($mstyle eq 'short') {
- (eval "print \"line $line: $message{$id}\n\"");
- (eval "print OUTFILE \"line $line: $message{$id}\n\"");
- return; }
-
- close (OUTFILE);
-
- # JS 12-6-95
- # commented this out because it is re-done above
- # (print "$filename:$line:$id\n"), return if $mstyle eq 'terse';
- # (eval "print \"$filename($line): $message{$id}\n\""), return if $mstyle eq 'lint';
- # (eval "print \"line $line: $message{$id}\n\""), return if $mstyle eq 'short';
-
- die "Unknown message style `$mstyle'\n";
- }
-
- #========================================================================
- # Function: GetConfigFile
- # Purpose: Read user's configuration file, if such exists.
- # If WEBLINTRC is set in user's environment, then read the
- # file referenced, otherwise try for $HOME/.weblintrc.
- #========================================================================
- sub GetConfigFile
- {
- local(*CONFIG);
- local($filename);
- local($arglist);
- local($value);
-
- # JS 12-6-96
- # this is the config file for MacWebLint.
- $filename = "MacWebLint.rc";
- return unless -f $filename;
-
- open(CONFIG,"< $filename") || do
- {
- print WARNING "Unable to read config file `$filename': $!\n";
- return 0;
- };
-
- while (<CONFIG>)
- {
- s/#.*$//;
- next if /^\s*$/o;
-
- #-- match keyword: process one or more argument -------------------
- if (/^\s*(enable|disable|extension|ignore)\s+(.*)$/io)
- {
- $keyword = "\U$1";
- $arglist = $2;
- while ($arglist =~ /^\s*(\S+)/o)
- {
- $value = "\L$1";
-
- &enableWarning($1, 1) if $keyword eq 'ENABLE';
-
- &enableWarning($1, 0) if $keyword eq 'DISABLE';
-
- $ignore{"\U$1"} = 1 if $keyword eq 'IGNORE';
-
- &AddExtension($1) if $keyword eq 'EXTENSION';
-
- $arglist = $';
- }
- }
- elsif (/^\s*set\s+(\S+)\s*=\s*(.*)/)
- {
- # setting a weblint variable
- if (defined $variable{$1})
- {
- $variable{$1} = $2;
- }
- else
- {
- print WARNING "Unknown variable `$1' in configuration file\n"
- }
- }
- }
-
- close CONFIG;
-
- 1;
- }
-
- sub enableWarning
- {
- local($id, $enabled) = @_;
-
-
- if (! defined $enabled{$id})
- {
- print WARNING "$PROGRAM: unknown warning identifier \"$id\"\n";
- return 0;
- }
-
- $enabled{$id} = $enabled;
-
- #
- # ensure consistency: if you just enabled upper-case,
- # then we should make sure that lower-case is disabled
- #
- $enabled{'lower-case'} = 0 if $_ eq 'upper-case';
- $enabled{'upper-case'} = 0 if $_ eq 'lower-case';
- $enabled{'upper-case'} = $enabled{'lower-case'} = 0 if $_ eq 'mixed-case';
-
- return 1;
- }
-
- #========================================================================
- # Function: AddExtension
- # Purpose: Extend the HTML understood. Currently supported extensions:
- # netscape - the netscape extensions proposed by
- # Netscape Communications, Inc. See:
- # http://www.netscape.com/home/services_docs/html-extensions.html
- #========================================================================
- sub AddExtension
- {
- local($extension) = @_;
-
- if ("\L$extension" ne 'netscape')
- {
- warn "$PROGRAM: unknown extension `$extension' -- ignoring.\n";
- return;
- }
-
- #---------------------------------------------------------------------
- # netscape extensions
- #---------------------------------------------------------------------
-
- #-- new element attributes for existing elements ---------------------
-
- &AddAttributes('ISINDEX', 'PROMPT');
- &AddAttributes('HR', 'SIZE', 'WIDTH', 'ALIGN', 'NOSHADE');
- &AddAttributes('UL', 'TYPE');
- &AddAttributes('OL', 'TYPE', 'START');
- &AddAttributes('LI', 'TYPE', 'VALUE');
- &AddAttributes('IMG', 'BORDER', 'VSPACE', 'HSPACE');
- &AddAttributes('BODY', 'BGCOLOR', 'TEXT', 'LINK', 'VLINK', 'ALINK');
- &AddAttributes('TABLE', 'CELLSPACING', 'CELLPADDING');
- &AddAttributes('TD', 'WIDTH');
- &AddAttributes('TH', 'WIDTH');
-
- #-- new elements -----------------------------------------------------
-
- $legalElements .= '|'.$netscapeElements;
- $pairElements .= '|BLINK|CENTER|FONT|NOBR';
- &AddAttributes('FONT', 'SIZE');
- &AddAttributes('BASEFONT', 'SIZE');
- }
-
- sub AddAttributes
- {
- local($element,@attributes) = @_;
- local($attr);
-
-
- $attr = join('|', @attributes);
- if (defined $validAttributes{$element})
- {
- $validAttributes{$element} .= "|$attr";
- }
- else
- {
- $validAttributes{$element} = "$attr";
- }
- }
-
- #========================================================================
- # Function: ListWarnings()
- # Purpose: List all supported warnings, with identifier, and
- # whether the warning is enabled.
- #========================================================================
- sub ListWarnings
- {
- local($id);
- local($message);
-
-
- foreach $id (sort keys %enabled)
- {
- ($message = $message{$id}) =~ s/\$argv\[\d+\]/.../g;
- $message =~ s/\\"/"/g;
- print WARNING "$id (", ($enabled{$id} ? "enabled" : "disabled"), ")\n";
- print WARNING " $message\n\n";
- }
- }
-
- sub CheckURL
- {
- local($url) = @_;
- local($workfile) = "$TMPDIR/$PROGRAM.$$";
- local($urlget) = $variable{'url-get'};
-
-
- die "$PRORGAM: url-get variable is not defined -- ".
- "don't know how to get $url\n" unless defined $urlget;
-
- system("$urlget $url > $workfile");
- &WebLint($workfile, $url);
- unlink $workfile;
- }
-
- #========================================================================
- # Function: wanted
- # Purpose: This is called by &find() to determine whether a file
- # is wanted. We're looking for files, with the filename
- # extension .html or .htm.
- #========================================================================
-
- ## JS 12-6-96
- ## Changed the "/" to a ":" below
-
- sub wanted
- {
- if (-d $_ && ! -f "$_$variable{'directory-index'}")
- {
- &whine('*', 'directory-index', "$arg$_", $variable{'directory-index'});
- }
-
- /\.(html|htm)$/ && # valid filename extensions: .html .htm
- -f $_ && # only looking for files
- (!$opt_l || !-l $_) && # ignore symlinks if -l given
- &WebLint($_,$name); # check the file
- }
-
- 1;
-