#!/usr/bin/perl
my $version = '0.02';
my (
$verbose, $show_content, @file, @url,
$help, $man, $quiet, $headers,
$path, $depreciated, $mimetypes
);
my $skip_binary = 1;
my $lines = 10;
my $max_chars = 1000;
my @ignore_filters = ();
GetOptions(
'verbose!' => \$verbose,
'content!' => \$show_content,
'quiet' => \$quiet,
'lines=i' => \$lines,
'help|?' => \$help,
'man' => \$man,
'headers' => \$headers,
'skip_binary!' => \$skip_binary,
'path' => \$path,
'depreciated' => \$depreciated,
'mimetypes' => \$mimetypes,
'ignore_filters=s@' => \@ignore_filters
) || pod2usage(2);
pod2usage(-verbose => 1) if $help;
pod2usage(-verbose => 2) if $man;
if ($path)
{
print '/usr/local/lib/swish-e/perl', "\n";
exit;
}
pod2usage(
-verbose => 0,
-message => "Must specify a file or URL",
-exitvar => 1,
)
unless @ARGV or $mimetypes;
$ENV{FILTER_DEBUG} = 1 if $verbose;
msg(INFO, "SWISH::Filter found at [%s]\n", $INC{'SWISH/Filter.pm'});
my $filter = SWISH::Filter->new(ignore_filters => \@ignore_filters);
if ($mimetypes)
{
my @filters = $filter->filter_list;
print "Mimetypes:\n\n";
for my $filter (@filters)
{
print " $filter:\n";
for my $pattern ($filter->mimetypes)
{
print " $pattern\n";
}
print "\n";
}
}
my $return = 0;
for my $doc (@ARGV)
{
eval { $depreciated ? process_doc_old($doc) : process_doc($doc) };
$return = 1 if $@;
warn "** $0:\n $@\n" if $@;
}
exit $return;
sub process_doc
{
my ($file) = @_;
my $uri;
eval { $uri = URI->new($file) };
my %config = !$@ && $uri->scheme ? fetch_url($file) : fetch_file($file);
my $doc =
$filter->convert(
%config,
name => $file,
meta_data => {'convertedBy' => 'swish-filter-test'}
);
die "Failed to process document [$file]\n" unless $doc;
my $content_type = $doc->content_type || "unknown";
my $parser_type = $doc->swish_parser_type || '';
my $binary = $doc->is_binary;
my $msg = $doc->was_filtered ? '' : 'not';
my $name = $doc->name;
msg(DEBUG, <<EOF );
Document $file was $msg filtered.
Document: $file ($name)
Content-Type: $content_type
Parser type: $parser_type
EOF
if (my $filters_used = $doc->filters_used)
{
for my $filter (@$filters_used)
{
my $class = ref($filter->{name});
msg(DEBUG,
" >Filter used: $class ( $filter->{start_content_type} -> $filter->{end_content_type} )"
);
msg(DEBUG, " >Metadata: " . Dumper($doc->meta_data || 'none'));
}
}
if (!$binary)
{
my @doc = split /\n/, substr(${$doc->fetch_doc}, 0, $max_chars);
my $toshow = $lines;
$toshow = scalar(@doc) - 1 if $toshow >= @doc;
msg(INFO, join "\n",
'-- Output Content Sample --',
@doc[0 .. $toshow],
'', '-- end --', '');
}
die "Skipping binary [$file]\n" if $binary && $skip_binary;
if ($headers)
{
my $len = length ${$doc->fetch_doc};
print "Path-Name: $file\nContent-Length: $len\n";
print "Document-Type: $parser_type\n" if $parser_type;
print "\n";
}
print ${$doc->fetch_doc} if $show_content;
}
sub process_doc_old
{
my ($file) = @_;
my $uri;
eval { $uri = URI->new($file) };
my %config = !$@ && $uri->scheme ? fetch_url($file) : fetch_file($file);
my $was_filtered = $filter->filter(%config, name => $file,);
my $content_type = $filter->content_type || "unknown";
my $orig_content_type = $filter->original_content_type || "unknown";
my $parser_type = $filter->swish_parser_type || '';
my $binary = $content_type !~ m[^text/];
my $msg = $was_filtered ? '' : 'not';
msg(DEBUG, <<EOF );
Document $file was $msg filtered.
Document: $file
Content-Type: $content_type (initial was $orig_content_type)
Parser type: $parser_type
EOF
if (!$binary)
{
my @doc = split /\n/, substr(${$filter->fetch_doc}, 0, $max_chars);
$lines = @doc - 1 if $lines >= @doc;
msg(INFO, join "\n",
'-- Output Content Sample --',
@doc[0 .. $lines],
'', '-- end --', '');
}
die "Skipping binary [$file]\n" if $binary && $skip_binary;
if ($headers)
{
my $len = length ${$filter->fetch_doc};
print "Path-Name: $file\nContent-Length: $len\n";
print "Document-Type: $parser_type\n" if $parser_type;
print "\n";
}
print ${$filter->fetch_doc} if $show_content;
}
sub fetch_file
{
my $file = shift;
open FH, "<$file" or die "Failed to open '$file': $!\n";
close FH;
die "File '$file' has zero size\n" if -z $file;
return (document => $file);
}
sub fetch_url
{
my $url = shift;
die "LWP::UserAgent is required to fetch a URL\n$@\n" if $@;
my $ua = LWP::UserAgent->new;
my $request = HTTP::Request->new('GET', $url);
my $response = $ua->request($request);
die sprintf "Error while getting '%s'. Server returned %s.",
$response->request->uri, $response->status_line
unless $response->is_success;
my $content = $response->content;
my $content_type = $response->content_type;
return (
document => \$content,
content_type => $content_type,
);
}
sub msg
{
my $msg_level = shift;
return if $quiet;
return if !$verbose && $msg_level > DEBUG;
printf(STDERR @_), print STDERR "\n";
}