File: //usr/local/share/namazu/pl/filter.pl
#
# -*- Perl -*-
# filter.pl - class for filter
#
# $Id: filter.pl.in,v 1.5.2.3 2009-02-17 08:53:35 opengl2772 Exp $
#
# Copyright (C) 2004 Yukio USUDA All rights reserved.
# Copyright (C) 2000-2004 Namazu Project All rights reversed.
# This is free software with ABSOLUTELY NO WARRANTY.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either versions 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA
package mknmz::filter;
use strict;
use English;
require 'util.pl';
require 'codeconv.pl';
require 'var.pl';
my $MMagic = undef;
my %REQUIRE_ACTIONS = ();
my %RECURSIVE_ACTIONS = ();
my %REQUIRE_PRE_CODECONV = ('text/plain' => 1,);
my %REQUIRE_POST_CODECONV = ('text/plain' => 0,);
my %Supported = ('text/plain' => "yes",);
my $PKGDATADIR = $ENV{'pkgdatadir'} || "/usr/local/share/namazu";
my $filterdir = $PKGDATADIR . "/filter"; # directory where filters are in.
sub new {
my $self = {};
my $proto = shift @_;
my $class = ref($proto) || $proto;
bless($self, $class);
return $self;
}
sub init {
my $self = shift @_;
$MMagic = shift @_;
if (defined $conf::FILTERDIR && -d $conf::FILTERDIR) {
$filterdir = $conf::FILTERDIR
};
if (($English::OSNAME eq "MSWin32") || ($English::OSNAME eq "os2")) {
if ($filterdir !~ /^[A-Z]:|^\\\\/i && $0 =~ m#^([A-Z]:)(/|\\)#i) {
$filterdir = $1 . $filterdir ;
}
util::win32_yen_to_slash(\$filterdir);
}
#
# Windows modules must be loaded first.
# Because OLE filters have low precedence over normal ones.
#
_load_filtermodules($filterdir);
}
sub apply_filter {
my $self = shift @_;
my $orig_cfile = shift @_;
my $contentref = shift @_;
my $mtype = shift @_;
$self->{'_lang'} = shift @_;
my $fields_ref = shift @_;
$self->{'weighted_str'} = "";
$self->{'headings'} = "";
# Pre code conversion.
if ($REQUIRE_PRE_CODECONV{$mtype}) {
util::dprint("pre_codeconv\n");
_codeconv_document($contentref);
}
util::vprint("mtype = $mtype\n");
if (! $Supported{$mtype} ||
$Supported{$mtype} ne 'yes') {
util::vprint(_("Unsupported media type ")."$mtype\n");
return (0, "$mtype; x-system=unsupported");
}
if ($REQUIRE_ACTIONS{$mtype}) {
util::vprint(_("Using ")."$REQUIRE_ACTIONS{$mtype}.pl\n");
require $REQUIRE_ACTIONS{$mtype}.'.pl'
|| die _("unable to require ") .
"\"$REQUIRE_ACTIONS{$mtype}.pl\"\n";
my $err = undef;
{
local $SIG{'PIPE'} = \&trapintr;
my $eval_txt = '$err = ' . $REQUIRE_ACTIONS{$mtype} .
'::filter($orig_cfile, $contentref,' .
' \$self->{\'weighted_str\'}, ' .
' \$self->{\'headings\'}, $$fields_ref);';
eval $eval_txt;
}
if ($err) {
if ($err =~ m/; x-system=unsupported$/) {
return (0, $err);
}
return (0, "$mtype; x-error=$err");
}
if ($@) {
util::vprint(_("Failed to call ")."$REQUIRE_ACTIONS{$mtype}\n$@\n");
return (0, "$mtype; x-error=$@");
}
# Post code conversion.
if ($REQUIRE_POST_CODECONV{$mtype}) {
util::dprint("post_codeconv\n");
_codeconv_document($contentref);
}
if ($RECURSIVE_ACTIONS{$mtype}) {
my $uri;
my $Document = undef;
$Document = mknmz::document->new();
$Document->init_doc($uri, $orig_cfile, $contentref, undef);
$contentref= $Document->get_filtered_contentref();
$self->{'weighted_str'} .= $Document->get_weighted_str();
$self->{'headings'} .= $Document->get_headings();
}
}
return ($self->{'weighted_str'}, $self->{'headings'});
}
sub get_info {
my $self = shift @_;
my $name = shift @_;
if ($name eq 'filter_dir') {
return $filterdir;
} elsif ($name eq 'all_types') {
return $self->_get_all_types;
} elsif ($name eq 'supported_types') {
return $self->_get_supported_list;
} elsif ($name eq 'supported_list') {
return $self->_get_supported_list;
}
}
#######################################################
sub _get_all_types {
my $self = shift @_;
my @all_types = keys %Supported;
return @all_types;
}
sub _get_supported_types {
my $self = shift @_;
my @supported = sort grep { $Supported{$_} eq "yes" } $self->_get_all_types;
return @supported;
}
sub _get_supported_list {
my $self = shift @_;
my $num_supported = $self->_get_supported_types();
my $num_unsupported = $self->_get_all_types() - $num_supported;
my $list = _("Supported media types: ") . "($num_supported)\n";
$list .= _("Unsupported media types: ") . "($num_unsupported) " . _("marked with minus (-) probably missing application in your \$path.\n");
my $supported_list = "";
for my $mtype (sort keys %Supported) {
my $yn = $Supported{$mtype};
if ($yn eq 'yes') { $yn = ' ' } else {$yn = '-'};
$supported_list .= "$yn $mtype";
if ($REQUIRE_ACTIONS{$mtype}) {
$supported_list .= ": $REQUIRE_ACTIONS{$mtype}.pl";
}
$supported_list .= "\n";
}
$list .= $supported_list;
return $list;
}
sub _codeconv_document ($) {
my ($textref) = @_;
#codeconv::to_inner_encoding($textref, 'unknown');
codeconv::toeuc($textref);
$$textref =~ s/\r\n/\n/g;
$$textref =~ s/\r/\n/g;
$$textref =~ tr/\x01-\x08\x0b-\x0c\x0e-\x1f\x7f/ /; # Remove control char.
}
sub _load_filtermodules ($) {
my $filterdir = shift @_;
unshift @INC, $filterdir;
# Check filter modules
my @filters = ();
@filters = glob "$filterdir/*.pl";
#
# Windows modules must be check only when Active Perl environment.
# Because OLE filters use Win32::OLE module.
#
if ($English::OSNAME eq "MSWin32") {
@filters = (@filters, glob "$filterdir/win32/*.pl");
unshift @INC, "$filterdir/win32";
}
_load_filters(@filters);
}
sub _load_filters ($) {
my @filters = @_;
for my $filter (@filters) {
$filter =~ m!([-\w]+)\.pl$!;
my $module = $1;
require "$module.pl" || die "unable to require \"$module.pl\"\n";;
my (@mtypes, $status, $recursive, $pre_codeconv, $post_codeconv);
eval "\@mtypes = ${module}::mediatype();";
die $@ if $@; # eval error
eval "\$status = ${module}::status();";
die $@ if $@;
eval "\$recursive = ${module}::recursive();";
die $@ if $@;
eval "\$pre_codeconv = ${module}::pre_codeconv();";
die $@ if $@;
eval "\$post_codeconv = ${module}::post_codeconv();";
die $@ if $@;
my $tmp = ref \$MMagic; # I don't know why this line is needed.
eval "${module}::add_magic(\$MMagic);";
die $@ if $@;
for my $mt (@mtypes) {
next if (defined $Supported{$mt} &&
$Supported{$mt} eq 'yes' && $status eq 'no');
$Supported{$mt} = $status;
$REQUIRE_ACTIONS{$mt} = $module;
$RECURSIVE_ACTIONS{$mt} = $recursive;
$REQUIRE_PRE_CODECONV{$mt} = $pre_codeconv;
$REQUIRE_POST_CODECONV{$mt} = $post_codeconv;
}
}
}
1;