Hi Rainer,

Am Dienstag, den 03.05.2011, 12:12 +0000 schrieb rj...@apache.org:
> Author: rjung
> Date: Tue May  3 12:12:35 2011
> New Revision: 1099032
> 
> URL: http://svn.apache.org/viewvc?rev=1099032&view=rev
> Log:
> Add a script to check web.xml and httpd mime.types
> for differences.
> 
> Added:
>     tomcat/trunk/res/scripts/
>     tomcat/trunk/res/scripts/check-mime.pl   (with props)
> 
> Added: tomcat/trunk/res/scripts/check-mime.pl
> URL: 
> http://svn.apache.org/viewvc/tomcat/trunk/res/scripts/check-mime.pl?rev=1099032&view=auto
> ==============================================================================
> --- tomcat/trunk/res/scripts/check-mime.pl (added)
> +++ tomcat/trunk/res/scripts/check-mime.pl Tue May  3 12:12:35 2011
> @@ -0,0 +1,410 @@
> +#!/usr/bin/perl
> +
...
> +# Script version, printed via getopts with "--version"
> +$main::VERSION = '1.0';
Any reason for not using 'our' like
our $VERSION = '1.0'; ?

> +
...
> +
> +# Parse arguments:
> +# -m: mime.types file (httpd) to use
> +# -i: input web.xml file to check
> +# -o: output web.xml file (gets generated and overwritten)
> +
> +$Getopt::Std::STANDARD_HELP_VERSION = 1;
> +our($opt_m, $opt_i, $opt_o);
Why should those options be visible by everyone outside this package?
'my' should be enough:
my ($opt_m, $opt_i, $opt_o);

> +getopts('m:i:o:');
> +
> +
> +# Check whether mandatory arguments are given
> +if ($opt_m eq '' || $opt_i eq '' || $opt_o eq '') {
> +    HELP_MESSAGE(*STDOUT);
> +    exit 1;
> +}
> +
> +
> +# Switch locale for alphabetical ordering
> +setlocale(LC_COLLATE, $LOCALE);
> +
> +# Read and parse httpd mime.types, build up hash extension->mime-type
> +open(MIMETYPES, "<$opt_m") or die "Could not open file '$opt_m' for read - 
> Aborting!";
You could use three param open and use lexical filehandles like
open my $mimetpyes_fh, '<', $opt_m or die "...";

> +while (<MIMETYPES>) {
> +    chomp($_);
> +    $line = $_;
while (my $line = <$mimetypes_fh>) {
  chomp($line);
> +    $line =~ s/#.*//;
> +    $line =~ s/^\s+//;
> +    if ($line ne '') {
> +        @cols = split(/\s+/, $line);
> +        if ($#cols > 0) {
> +            for ($i=1; $i <= $#cols; $i++) {
> +                $httpd{$cols[$i]} = $cols[0];
> +            }
> +        } else {
> +            print STDERR "WARN mime.types line ignored: $_\n";
> +        }
> +    }
> +}
> +close(MIMETYPES);
>

($mimetype, @endings) = split(/\s+/, $line); 
if (@endings > 0) {
   for my $ending (@endings) {
     $httpd{$ending} = $mimetype;
   }
} else {
   print STDERR "WARN mime.types line ignored: $_\n";
}
close $mimetypes_fh;

 would be possible also.
> +
> +# Read and parse web.xml, build up hash extension->mime-type
> +# and store the file parts form before and after mime mappings.
> +open(WEBXML, "<$opt_i") or die "Could not open file '$opt_i' for read - 
> Aborting!";
three-params open could be used again.

> +
> +# Skip and record all lines before the first mime type definition.
> +# Because of comment handling we need to read one line ahead.
> +$line = '';
> +while (<WEBXML>) {
> +    if ($_ !~ /<mime-mapping>/) {
> +        $tomcat_pre .= $line;
> +    } else {
> +        last;
> +    }
> +    $line = $_;
> +}
> +
> +$commented = 0;
> +# If the previous line was start of a comment
> +# set marker, else add it to pre.
> +if ($line =~ /^\s*<!--[^>]*$/) {
> +    $commented = 1;
> +} else {
> +    $tomcat_pre .= $line;
> +}
> +
> +# Now we parse blocks of the form:
> +#    <mime-mapping>
> +#        <extension>abs</extension>
> +#        <mime-type>audio/x-mpeg</mime-type>
> +#    </mime-mapping>
> +# Optional single comment lines directly after "<mime-mapping>"
> +# are allowed. The whole block is also allowed to be commented out.
> +
> +while ($_ =~ /^\s*<mime-mapping>\s*$/) {
> +    $_ = <WEBXML>;
> +    chomp($_);
> +    $comment = '';
> +    if ($_ =~ /^\s*<!--([^>]*)-->\s*$/) {
> +        $comment = $1;
> +        $_ = <WEBXML>;
> +        chomp($_);
> +    }
> +    if ($_ =~ /^\s*<extension>([^<]*)<\/extension>\s*$/ ) {
> +        $extension = $1;
> +        $extension =~ s/^\s+//;
> +        $extension =~ s/\s+$//;
> +    } else {
> +        print STDERR "ERROR Parse error in Tomcat mime-mapping line $.\n";
> +        print STDERR "ERROR Expected <extension>...</extension>', got '$_' - 
> Aborting!\n";
> +        close(WEBXML);
> +        exit 2;
> +    }
> +    $_ = <WEBXML>;
> +    chomp($_);
> +    if ($_ =~ /^\s*<mime-type>([^<]*)<\/mime-type>\s*$/ ) {
> +        $type = $1;
> +        $type =~ s/^\s+//;
> +        $type =~ s/\s+$//;
> +        if (exists($tomcat{$extension}) && $tomcat{$extension} ne $type) {
> +            print STDERR "WARN MIME mapping redefinition detected!\n";
> +            print STDERR "WARN Kept '$extension' -> '$tomcat{$extension}'\n";
> +            print STDERR "WARN Ignored '$extension' -> '$type'\n";
> +        } else {
> +            $tomcat{$extension} = $type;
> +            if ($comment ne '') {
> +                $tomcat_comments{$extension} = $comment;
> +            }
> +            if ($commented) {
> +                $tomcat_commented{$extension} = 1;
> +            }
> +            push(@tomcat_extensions, $extension);
> +        }
> +    } else {
> +        print STDERR "ERROR Parse error in Tomcat mime-mapping line $.\n";
> +        print STDERR "ERROR Expected <mime-type>...</mime-type>', got '$_' - 
> Aborting!\n";
> +        close(WEBXML);
> +        exit 3;
> +    }
> +    $_ = <WEBXML>;
> +    chomp($_);
> +    if ($_ !~ /^\s*<\/mime-mapping>\s*$/) {
> +        print STDERR "ERROR Parse error in Tomcat mime-mapping line $.\n";
> +        print STDERR "ERROR Expected '</mime-mapping>', got '$_' - 
> Aborting!\n";
> +        close(WEBXML);
> +        exit 4;
> +    }
> +    $_ = <WEBXML>;
> +    # Check for comment closure
> +    if ($commented && $_ =~ /^[^<]*-->\s*$/) {
> +        $commented = 0;
> +        $_ = <WEBXML>;
> +    }
> +    # Check for comment opening
> +    if ($_ =~ /^\s*<!--[^>]*$/) {
> +        $commented = 1;
> +        $line = $_;
> +        $_ = <WEBXML>;
> +    }
> +}
> +
> +# Add back the last comment line already digested
> +if ($commented) {
> +    $tomcat_post = $line;
> +}
> +
> +# Read and record the remaining lines
> +$tomcat_post .= $_;
> +while (<WEBXML>) {
> +    if ($_ =~ /<mime-mapping>/) {
> +        print STDERR "ERROR mime-mapping blocks are not consecutive\n";
> +        print STDERR "ERROR See line $. in $opt_i - Aborting!\n";
> +        close(WEBXML);
> +        exit 5;
> +    }
> +    $tomcat_post .= $_;
> +}
> +
> +close(WEBXML);
> +
> +
> +# Look for extensions existing for Tomcat but not for httpd.
> +# Log them if they are not in TOMCAT_ONLY
> +for $extension (@tomcat_extensions) {
> +    if (!exists($httpd{$extension})) {
> +        if (!exists($TOMCAT_ONLY{$extension})) {
> +            print STDERR "WARN Extension '$extension' found in web.xml but 
> not in mime.types is missing from TOMCAT_ONLY list.\n";
> +            print STDERR "WARN Definition '$extension' -> 
> '$tomcat{$extension}' will be removed from generated web.xml.\n";
> +        } elsif ($tomcat{$extension} ne $TOMCAT_ONLY{$extension}) {
> +            print STDERR "WARN Additional extension '$extension' allowed by 
> TOMCAT_ONLY list, but has new definition.\n";
> +            print STDERR "WARN Definition '$extension' -> 
> '$tomcat{$extension}' will be replaced" .
> +                         " by '$extension' -> '$TOMCAT_ONLY{$extension}' in 
> generated web.xml.\n";
> +        }
> +    }
> +}
> +
> +
> +# Look for extensions with inconsistent mime types for Tomcat and httpd.
> +# Log them if they are not in TOMCAT_KEEP
> +for $extension (@tomcat_extensions) {
> +    if (exists($httpd{$extension}) && $tomcat{$extension} ne 
> $httpd{$extension}) {
> +        if (!exists($TOMCAT_KEEP{$extension})) {
> +            print STDERR "WARN Mapping '$extension' inconsistency is missing 
> from TOMCAT_KEEP list.\n";
> +            print STDERR "WARN Definition '$extension' -> 
> '$tomcat{$extension}' will be replaced" .
> +                         " by '$extension' -> '$httpd{$extension}' in 
> generated web.xml.\n";
> +        } elsif ($tomcat{$extension} ne $TOMCAT_KEEP{$extension}) {
> +            print STDERR "WARN Extension '$extension' inconsistency allowed 
> by TOMCAT_KEEP list, but has new definition.\n";
> +            print STDERR "WARN Definition '$extension' -> 
> '$tomcat{$extension}' will be replaced" .
> +                         " by '$extension' -> '$TOMCAT_KEEP{$extension}' in 
> generated web.xml.\n";
> +        }
> +    }
> +}
> +
> +
> +# Log if extensions in web.xml are not sorted alphabetically.
> +$check = 0;
> +$msg = '';
> +for ($i=1; $i <= $#tomcat_extensions; $i++) {
> +    if ($tomcat_extensions[$i - 1] ge $tomcat_extensions[$i]) {
> +        $check = 1;
> +        $msg .= "WARN Extension '" . $tomcat_extensions[$i - 1] . "' defined 
> before '" . $tomcat_extensions[$i] . "'\n";
> +    }
> +}
my $last_line = $tomcat_extensions[0];
for my $current_line (@tomcat_extensions) {
   if ($last_line ge $current_line) {
     $check = 1;
     $msg .= "WARN Extension '$last_line' defined before
'$current_line'\n";
   }
   $last_line = $current_line;
}

Not really shorter, but we don't have to look up array elements.
> +if ($check) {
We could check for $msg and get rid of $check.
> +    print STDERR "WARN MIME type definitions in web.xml were not sorted 
> alphabetically by extension\n";
> +    print STDERR $msg;
> +    print STDERR "WARN This will be fixed in the new generated web.xml file 
> '$opt_o'.\n";
> +}
> +
> +
> +# Log all extensions defined for httpd but not for Tomcat
> +for $extension (sort keys %httpd) {
> +    if (!exists($tomcat{$extension})) {
> +        print STDERR "INFO Extension '$extension' found for httpd, but not 
> for Tomcat.\n";
> +        print STDERR "INFO Definition '$extension' -> '$httpd{$extension}' 
> will be added" .
> +                         " to the generated web.xml.\n";
> +    }
> +}
> +
> +
> +# Generate new web.xml:
> +#   - Use definitions from httpd
> +#   - Add TOMCAT_ONLY
> +#   - Fix TOMCAT_KEEP
> +#   - output tomcat_pre, sorted mime-mappings, tomcat_post.
> +for $extension (keys %TOMCAT_ONLY) {
> +    $httpd{$extension} = $TOMCAT_ONLY{$extension};
> +}
while (my ($mimetype, $file_extension) = each %TOMCAT_ONLY) {
  $httpd{file_extension) = $mimetype;
}

We don't have to lookup the file extension ourself.

> +for $extension (keys %TOMCAT_KEEP) {
> +    $httpd{$extension} = $TOMCAT_KEEP{$extension};
> +}
see above

> +open (NEW, ">$opt_o") or die "Could not open file '$opt_o' for write - 
> Aborting!";
three params open and lexical filehandle?

> +print NEW $tomcat_pre;
> +for $extension (sort keys %httpd) {
while combined whith each %httpd to omit hash lookup a little bit later
while (my ($mimetype, $file_extension) = each %httpd) {
...

Regards
 Felix
> +    if (exists($tomcat_commented{$extension})) {
> +        print NEW "    <!--\n";
> +    }
> +    print NEW "    <mime-mapping>\n";
> +    if (exists($tomcat_comments{$extension})) {
> +        print NEW "        <!--$tomcat_comments{$extension}-->\n";
> +    }
> +    print NEW "        <extension>$extension</extension>\n";
> +    print NEW "        <mime-type>$httpd{$extension}</mime-type>\n";
> +    print NEW "    </mime-mapping>\n";
> +    if (exists($tomcat_commented{$extension})) {
> +        print NEW "    -->\n";
> +    }
> +}
> +print NEW $tomcat_post;
> +close(NEW);
> +print "New file '$opt_o' has been written.\n";
> +
> 
> Propchange: tomcat/trunk/res/scripts/check-mime.pl
> ------------------------------------------------------------------------------
>     svn:eol-style = native
> 
> Propchange: tomcat/trunk/res/scripts/check-mime.pl
> ------------------------------------------------------------------------------
>     svn:executable = *
> 
> Propchange: tomcat/trunk/res/scripts/check-mime.pl
> ------------------------------------------------------------------------------
>     svn:keywords = Author Date Id Revision
> 
> 
> 
> ---------------------------------------------------------------------
> To unsubscribe, e-mail: dev-unsubscr...@tomcat.apache.org
> For additional commands, e-mail: dev-h...@tomcat.apache.org
> 



---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscr...@tomcat.apache.org
For additional commands, e-mail: dev-h...@tomcat.apache.org

Reply via email to