diff -r e9aa9cb9f61f -r cd800b3f5a6e mimecut.pl --- a/mimecut.pl Fri Sep 07 21:48:38 2007 +0000 +++ b/mimecut.pl Fri Sep 07 22:16:36 2007 +0000 @@ -2,9 +2,6 @@ # $Id$ # $URL$ # -# ** Just proof of concept ** to see if we really need to decode all the -# mime parts. -# use strict; use warnings; @@ -12,27 +9,22 @@ use Fatal qw(:void select); use File::Temp qw(tempfile); use if $ENV{DEBUG} => "Smart::Comments"; +use File::Basename; use FindBin qw($Bin); sub print_message(*@); sub read_message(); -sub pass_mime($$); -sub forward_to_boundary($*); +sub pass_mime($); sub read_header(*); +sub process(*;@); -# -sub process($*;@); -my $confdir = -f "$Bin/.build" ? $Bin : "/etc/$0"; -my @mimes; +my $ME = basename $0; +my $CONFDIR = -f "$Bin/.build" ? $Bin : "/etc/$ME"; $SIG{__WARN__} = sub { print STDERR "### ", @_ }; MAIN: { - open(my $fh, "< $confdir/mimes.conf") - or warn "can't read config!\n"; - my @mimes = map { chomp; $_ } grep !/(?:^\s*#|^\s*$)/, <$fh>; - # create an r/o tmp file containing the message for sequential # processing and optional failback in face of some processing error my $message = read_message(); @@ -45,7 +37,7 @@ # now we start processing but at the beginning - of course seek($message, 0, 0); - process(\@mimes, $message, boundary => undef); + process($message, boundary => undef); # everything is done, probably some rest is still unprocessed (some # epilogue, but this shouldn't be a problem at all @@ -71,8 +63,8 @@ } } -sub process($*;@) { - my ($mimes, $m, %arg) = @_; +sub process(*;@) { + my ($m, %arg) = @_; my ($header, %header) = read_header($m); my ($type, $boundary); @@ -87,7 +79,7 @@ $boundary ||= $arg{boundary}; - if (not $type or pass_mime($type, $mimes)) { + if (not $type or pass_mime($type)) { #warn "passing: " . ($type ? $type : "no mime type") . "\n"; print $header; @@ -102,7 +94,7 @@ print_message($m, to => $boundary); while (not eof($m)) { - process($mimes, $m, boundary => $boundary); + process($m, boundary => $boundary); } return; @@ -130,12 +122,19 @@ } -sub pass_mime($$) { - my ($type, $mimes) = @_; - local $_ = $type; - my $re = join "|", - map { $a = $_; $a =~ s/([^\da-z])/\\$1/gi; $a } @$mimes; - return m{$re}; +{ + my $re; + + sub pass_mime($) { + my ($type) = @_; + + if (!$re) { + open(my $fh, "<$CONFDIR/mimes.conf") + or die "can't read $CONFDIR/mimes.conf!\n"; + $re = qr{@{[join "|", map { chomp; "(?:".quotemeta($_).")" } grep !/(?:^\s*#|^\s*$)/, <$fh>]}}; + } + return $type =~ /$re/; + } } sub read_message() {