Issue 125: HTM: text before the html tag gets included in title

Unknown reporter writes

Trying to add my own custom field:

#!config
[prefixes]

sub = XYSUB

The html files will then have something like:

#!html
<head >
<title >Perl::Strip - reduce file size by stripping whitespace, comments, pod etc.</title >
<meta http-equiv="content-type" content="text/html; charset=utf-8" / >
<link rev="made" href="mailto:root@localhost" / >
<meta name="sub" content="document strip"/ >
</head >

When I run index I get the following in the log:

#!log
:5:../rcldb/rcldb.cpp:928:Db::add: no prefix for field [docsize], no indexing
:5:../rcldb/rcldb.cpp:933:Db::add: field [filename] pfx [XSFN] inc 1: [Strip.pm]
:5:../rcldb/rcldb.cpp:928:Db::add: no prefix for field [md5], no indexing
:5:../rcldb/rcldb.cpp:933:Db::add: field [sub] pfx [XYSUB] inc 1: [document strip]
:5:../rcldb/rcldb.cpp:933:Db::add: field [title] pfx [S] inc 1: [document strip Perl::Strip - reduce file size by stripping whitespace, comments, pod etc.]

Notice in the above my sub field information is getting included in the beginning of my title field. Not sure what I’m doing that is causing this but I would like for the title to only have the title information.

medoc writes

What version are you using ? I can’t seem to reproduce it directly. jf

medoc writes

Could you please also  attach the exact HTML file you are using ? Having no luck in reproducing the problem.

mmcgillis writes

Recoll 1.18.1 + Xapian 1.2.7

Fedora 16 with recoll-1.18.1-1.fc16.i686

This works for me to reproducing:

#!html
<html >
<head >
<title >Perl::Strip - reduce file size by stripping whitespace, comments, pod etc.</title >
<meta http-equiv="content-type" content="text/html; charset=utf-8" / >
<link rev="made" href="mailto:root@localhost" / >
<meta name="sub" content="document strip"/ >
</head >
<body >
</body >
</html >

mmcgillis writes

Actually the above is not true. So maybe this has to do with some of the other stuff I’m doing. What I’m trying to do is process all perl files and generate two results for a single file one result is the raw code as text/plain the other result is the pod which would be text/html. The first issue I ran into is recoll is not very good at detecting perl files. recoll only looks at extensions and I need something that will look at the file to decide. So I created my own mimeconf

#!config
[index]
application/x-perl = execm rclperl
text/plain = execm rclperl

As indicated above that uses rclperl which currently is this:

#!python
#!/usr/bin/env python

# Perl file filter for Recoll

import re
import subprocess
import sys
sys.path.append("/usr/share/recoll/filters")
import rclexecm

class PerlExtractor:
    def __init__(self, em):
        self.currentindex = 0
        self.em = em

    def extractone(self, ipath):
        #self.em.rclog("extractone: [%s]" % ipath)
        iseof = rclexecm.RclExecM.noteof
        p=subprocess.Popen(["file",self.filename],stdout=subprocess.PIPE)
        x=p.stdout.read()
        isPerl=(re.search("perl",x,re.IGNORECASE)!=None)
        #self.em.rclog("isPerl: [%s]" % isPerl)
        docdata = ""

        if (ipath == "pod"):
            self.em.setmimetype("text/html")
            p=subprocess.Popen(["rclpod",self.filename],stdout=subprocess.PIPE,stderr=subprocess.PIPE)
            docdata=p.stdout.read()
            iseof = rclexecm.RclExecM.eofnext
        elif (isPerl):
            self.em.setmimetype("text/x-perl")
            # generate code content
            f=open(self.filename,"r")
            docdata= f.read()
            f.close()

            # check for pod
            p=subprocess.Popen(["podchecker",self.filename],stderr=subprocess.PIPE)
            x=p.stderr.read()
            isPod=(re.search("does not contain any pod commands",x,re.IGNORECASE)==None)
            #self.em.rclog("isPOD: [%s]" % isPod)
            if (not isPod):
                iseof = rclexecm.RclExecM.eofnext
        else:
            self.em.setmimetype("text/plain")
            f=open(self.filename,"r")
            docdata= f.read()
            f.close()
            iseof = rclexecm.RclExecM.eofnext
        ok = True
        self.currentindex = 0
        return (ok, docdata, ipath, iseof)

    ###### File type handler api, used by rclexecm ---------- >
    def openfile(self, params):
        self.currentindex = -1
        try:
            self.filename = params["filename:"]
            return True
        except:
            return False

    def getipath(self, params):
        ipath = params["ipath:"]
        return self.extractone(ipath)

    def getnext(self, params):
        if self.currentindex == -1:
            # Return "self" doc
            return self.extractone("")
        return self.extractone("pod")

# Main program: create protocol handler and extractor and run them
proto = rclexecm.RclExecM()
extract = PerlExtractor(proto)
rclexecm.main(proto, extract)

The basic idea of the above is if something is determined to actually be a perl file first generate the code using a empty ipath then if the perl code does have pod generate a html file for the pod using an ipath of "pod".

To actually generate the pod pice for the above I use this perl script:

#!perl

#!/usr/bin/perl

use lib("/home/matthew/tools/perl-strip/lib");

use Pod::Html;
use Perl::Strip;

pod2html("--cachedir=/tmp","--infile=$ARGV[0]","--outfile=/tmp/o");

open(FILE,$ARGV[0]);
my $code="";
while (<FILE >) {
  $code.=$_;
}
close(FILE);

my $ps=Perl::Strip- >new();
my $striped=$ps- >strip($code);

my @sub=();
while ($striped=~/sub ([\w]+)/g) {
  push(@sub,$1);
}
print "@sub\n";

open(INFILE,"</tmp/o");
open(OUTFILE," >/tmp/o2");
while (<INFILE >) {
  if ($_ =~ /\<\/head\ >/) {
      print OUTFILE '<meta name="sub" content="'.join(" ",@sub).'"/ >'."\n";
  }
  print OUTFILE $_;
}
close(INFILE);
close(OUTFILE);

system("cat /tmp/o2");
unlink("/tmp/pod2htmd.tmp");
unlink("/tmp/pod2htmi.tmp");
unlink("/tmp/o");
unlink("/tmp/o2");

So with all the above in place if I then process this file Strip.pm

#!perl

=head1 NAME

Perl::Strip - reduce file size by stripping whitespace, comments, pod etc.

=head1 SYNOPSIS

   use Perl::Strip;

=head1 DESCRIPTION

This module transforms perl sources into a more compact format. It does
this by removing most whitespace, comments, pod, and by some other means.

The resulting code looks obfuscated, but perl (and the deparser) don't
have any problems with that. Depending on the source file you can expect
about 30-60% "compression".

The main target for this module is low-diskspace environments, such as
L<App::Staticperl >, boot floppy/CDs/flash environments and so on.

See also the commandline utility L<perlstrip >.

=head1 METHODS

The C<Perl::Strip > class is a subclsass of L<PPI::Transform >, and as such
inherits all of it's methods, even the ones not documented here.

=over 4

=cut

package Perl::Strip;

our $VERSION = '1.1';
our $CACHE_VERSION = 2;

use common::sense;

use PPI;

use base PPI::Transform::;

=item my $transform = new Perl::Strip key = > value...

Creates a new Perl::Strip transform object. It supports the following
parameters:

=over 4

=item optimise_size = > $bool

By default, this module optimises I<compressability >, not raw size. This
switch changes that (and makes it slower).

=item keep_nl = > $bool

By default, whitespace will either be stripped or replaced by a space. If
this option is enabled, then newlines will not be removed. This has the
advantage of keeping line number information intact (e.g. for backtraces),
but of course doesn't compress as well.

=item cache = > $path

Since this module can take a very long time (minutes for the larger files
in the perl distribution), it can utilise a cache directory. The directory
will be created if it doesn't exist, and can be deleted at any time.

=back

=cut

# PPI::Transform compatible
sub document {
   my ($self, $doc) = @_;

   $self- >{optimise_size} = 1; # more research is needed

   # special stripping for unicore/ files
   if (eval { $doc- >child (1)- >content =~ /^# .* (build by mktables|machine-generated .*mktables) / }) {

      for my $heredoc (@{ $doc- >find (PPI::Token::HereDoc::) }) {
         my $src = join "", $heredoc- >heredoc;

         # special stripping for unicore swashes and properties
         # much more could be done by going binary
         for ($src) {
            s/^(?:0*([0-9a-fA-F]+))?\t(?:0*([0-9a-fA-F]+))?\t(?:0*([0-9a-fA-F]+))?/$1\t$2\t$3/gm
               if $self- >{optimise_size};

#            s{
#               ^([0-9a-fA-F]+)\t([0-9a-fA-F]*)\t
#            }{
#               # ww - smaller filesize, UU - compress better
#               pack "C0UU",
#                    hex $1,
#                    length $2 ? (hex $2) - (hex $1) : 0
#            }gemx;

            s/#.*\n/\n/mg;
            s/\s+\n/\n/mg;
         }

         # PPI seems to be mostly undocumented
         $heredoc- >{_heredoc} = [split /$/, $src];
      }
   }

   $doc- >prune (PPI::Token::Comment::);
   $doc- >prune (PPI::Token::Pod::);

   # prune END stuff
   for (my $last = $doc- >last_element; $last; ) {
      my $prev = $last- >previous_token;

      if ($last- >isa (PPI::Token::Whitespace::)) {
         $last- >delete;
      } elsif ($last- >isa (PPI::Statement::End::)) {
         $last- >delete;
         last;
      } elsif ($last- >isa (PPI::Token::Pod::)) {
         $last- >delete;
      } else {
         last;
      }

      $last = $prev;
   }

   # prune some but not all insignificant whitespace
   for my $ws (@{ $doc- >find (PPI::Token::Whitespace::) }) {
      my $prev = $ws- >previous_token;
      my $next = $ws- >next_token;

      if (!$prev || !$next) {
         $ws- >delete;
      } else {
         if (
            $next- >isa (PPI::Token::Operator::) && $next- >{content} =~ /^(?:,|=|!|!=|==|= >)$/ # no ., because of digits. == float
            or $prev- >isa (PPI::Token::Operator::) && $prev- >{content} =~ /^(?:,|=|\.|!|!=|==|= >)$/
            or $prev- >isa (PPI::Token::Structure::)
            or ($self- >{optimise_size} &&
                ($prev- >isa (PPI::Token::Word::)
                   && (PPI::Token::Symbol:: eq ref $next
                       || $next- >isa (PPI::Structure::Block::)
                       || $next- >isa (PPI::Structure::List::)
                       || $next- >isa (PPI::Structure::Condition::)))
               )
         ) {
            $ws- >delete;
         } elsif ($prev- >isa (PPI::Token::Whitespace::)) {
            $ws- >{content} = ' ';
            $prev- >delete;
         } else {
            $ws- >{content} = ' ';
         }
      }
   }

   # prune whitespace around blocks, also ";" at end of blocks
   if ($self- >{optimise_size}) {
      # these usually decrease size, but decrease compressability more
      for my $struct (PPI::Structure::Block::, PPI::Structure::Condition::, PPI::Structure::List::) {
         for my $node (@{ $doc- >find ($struct) }) {
            my $n1 = $node- >first_token;
#            my $n2 = $n1- >previous_token;
            my $n3 = $n1- >next_token;
            $n1- >delete if        $n1- >isa (PPI::Token::Whitespace::);
#            $n2- >delete if $n2 && $n2- >isa (PPI::Token::Whitespace::); # unsafe! AE::timer $MAX_SIGNAL_LATENCY -($NOW - int$NOW)
            $n3- >delete if $n3 && $n3- >isa (PPI::Token::Whitespace::);
            my $n1 = $node- >last_token;
            my $n2 = $n1- >next_token;
            my $n3 = $n1- >previous_token;
            $n1- >delete if        $n1- >isa (PPI::Token::Whitespace::);
            $n2- >delete if $n2 && $n2- >isa (PPI::Token::Whitespace::);
            $n3- >{content} = "" # delete seems to trigger a bug inside PPI
                        if $n3 && ($n3- >isa (PPI::Token::Whitespace::)
                                   || ($n3- >isa (PPI::Token::Structure::) && $n3- >content eq ";"));
         }
      }
   }

   # foreach = > for
   for my $node (@{ $doc- >find (PPI::Statement::Compound::) }) {
      if (my $n = $node- >first_token) {
         $n- >{content} = "for" if $n- >{content} eq "foreach" && $n- >isa (PPI::Token::Word::);
      }
   }

   # reformat qw() lists which often have lots of whitespace
   for my $node (@{ $doc- >find (PPI::Token::QuoteLike::Words::) }) {
      if ($node- >{content} =~ /^qw(.)(.*)(.)$/s) {
         my ($a, $qw, $b) = ($1, $2, $3);
         $qw =~ s/^\s+//;
         $qw =~ s/\s+$//;
         $qw =~ s/\s+/ /g;
         $node- >{content} = "qw$a$qw$b";
      }
   }

   # prune return at end of sub-blocks
   #TODO:
   # PPI::Document
   #   PPI::Statement::Sub
   #     PPI::Token::Word    'sub'
   #     PPI::Token::Whitespace      ' '
   #     PPI::Token::Word    'f'
   #     PPI::Structure::Block       { ... }
   #       PPI::Statement
   #         PPI::Token::Word        'sub'
   #         PPI::Structure::Block   { ... }
   #           PPI::Statement::Break
   #             PPI::Token::Word    'return'
   #             PPI::Token::Whitespace      ' '
   #             PPI::Token::Number          '5'
   #         PPI::Token::Structure   ';'
   #       PPI::Statement::Compound
   #         PPI::Structure::Block   { ... }
   #           PPI::Statement::Break
   #             PPI::Token::Word    'return'
   #             PPI::Token::Whitespace      ' '
   #             PPI::Token::Number          '8'
   #       PPI::Statement::Break
   #         PPI::Token::Word        'return'
   #         PPI::Token::Whitespace          ' '
   #         PPI::Token::Number      '7'

   1
}

=item $perl = $transform- >strip ($perl)

Strips the perl source in C<$perl > and returns the stripped source.

=cut

sub strip {
   my ($self, $src) = @_;

   my $filter = sub {
      my $ppi = new PPI::Document \$src
         or return;

      $self- >document ($ppi)
         or return;

      $src = $ppi- >serialize;
   };

   if (exists $self- >{cache} && (2048 <= length $src)) {
      my $file = "$self- >{cache}/" . Digest::MD5::md5_hex "$CACHE_VERSION \n" . (!!$self- >{optimise_size}) . "\n\x00$src";

      if (open my $fh, "<:perlio", $file) {
         # zero size means unchanged
         if (-s $fh) {
            local $/;
            $src = <$fh >
         }
      } else {
         my $oldsrc = $src;

         $filter- >();

         mkdir $self- >{cache};

         if (open my $fh, " >:perlio", "$file~") {
            # write a zero-byte file if source is unchanged
            if ($oldsrc eq $src or (syswrite $fh, $src) == length $src) {
               close $fh;
               rename "$file~", $file;
            }
         }
      }
   } else {
      $filter- >();
   }

   $src
}

=back

=head1 SEE ALSO

L<App::Staticperl >, L<Perl::Squish >.

=head1 AUTHOR

   Marc Lehmann <schmorp@schmorp.de >
   http://home.schmorp.de/

=cut

1;

Then I get the results indicated.

mmcgillis writes

Sorry my fault the rclpod script still has some extra output. It is printing the sub information to stdout which is some how getting picked up in the title. I removed the print in this and problem solved:

#!perl

my @sub=();
while ($striped=~/sub ([\w]+)/g) {
  push(@sub,$1);
}
print "@sub\n";

mmcgillis writes

Well with the above information this is the actual file that would produce the problem results:

#!html
document strip
<html >
<head >
<title >Perl::Strip - reduce file size by stripping whitespace, comments, pod etc.</title >
<meta http-equiv="content-type" content="text/html; charset=utf-8" / >
<link rev="made" href="mailto:root@localhost" / >
<meta name="sub" content="document strip"/ >
</head >
<body >
</body >
</html >

medoc writes

Ok, thanks, then this is an issue with the html parser. This text should probably not be discarded, but inserting it in the title does not seem right either… Apparently Firefox prepends it to the body, which is probably not standardized but the right approach. I’ll see if this is feasible with the parser used in Recoll.

I did not look at the scripts in much detail because I’m really not a Perl guy. Don’t hesitate to come back to me if there are things which don’t work as they could on the recoll side.

About the file type detection: for files without suffixes or with unknown suffixes, recoll will call "file -i" as a last resort. So, if "file" is better at recognizing perl files, you could try to remove any mistaken suffix from the mimemap file and let the "file" command do its thing. Unfortunately, there is no way to substract suffixes in the personal config, so you’ll have to modify the mimemap installed in /usr/share/recoll

mmcgillis writes

You can see in my rclperl I also use file because it will do a good job of detection perl but not if you restrict it to mime types. Meaning the file -i will still get things wrong but file when it uses magic to detect the type will properly identify perl files "man magic" for more details.

mmcgillis writes

Looks like file vs file -i issue is a bad magic config on some linux boxes. Not a recall issue.

medoc writes

HTML: do not concatenate text found before body tag with the title. Fixes issue #125

→ <<cset 5baf046df3f7 > >