bfilter/trunk/bfilter.pl

#!/usr/bin/perl -w
#

use strict;
use locale;

# maximum entries
my $max = 0;
# minimum letters to search by
my $min_len = shift @ARGV || 3;
# if more than x elements, warn to increase min_len
my $increase_at = 500;

# name of generated index
my $headlines = 'headlines';

my $debug = 1;

sub print_file {
        my $f = shift || return;
        open(F, $f) || die "$f: $!";
        while(<F>) {
                print;
        }
        close(F);
}

print qq{
var $headlines = new Object();
};

my @part_arr;
my $last_part = '';
my $total = 0;

my $max_elements = 0;

sub escape_js {
        my $t = shift || return;
        $t =~ s/(['\\])/\\$1/g && print STDERR "ESCAPED '$t'\n";
        return $t;
}

while(<STDIN>) {
        chomp;

        if (!m/\t/ || m/\t$/) {
                print STDERR "SKIP '$_': no tab\n";
                next;
        }

        my @data = split(/\t+/,$_);

        my $headline = shift @data || die "need at least headline!";

        if (length($headline) < $min_len) {
                print STDERR "SKIP '$_': too short\n";
                next;
        }


        # split into min_len part and rest
        my ($part,$rest) = ( substr($headline,0,$min_len), substr($headline,$min_len) );

        # make part lowercase
        $part = lc($part);

        $last_part = $part if (! $last_part);

        # new part?
        if ($part ne $last_part) {
                print STDERR $last_part,"\t",$#part_arr+1,"\n" if ($debug && $#part_arr > $increase_at);
                $max_elements = $#part_arr if ($#part_arr > $max_elements);
                print "${headlines}['",escape_js($last_part),"'] = [\n ",join(",\n ",@part_arr),"];\n" if (@part_arr);
                $total += $#part_arr;
                @part_arr = ();
                $last_part = $part;
        }
        push @part_arr, "['".escape_js($headline)."','".join("','",map { escape_js($_) } @data)."']";

        # break out?
        last if ($max && $total > $max);
}

print "${headlines}['",escape_js($last_part)."'] = [\n ",join(",\n ",@part_arr),"];\n" if (@part_arr);
print qq{

${headlines}.min_len = $min_len;
${headlines}.length = $total;

};

print STDERR "You have more than $increase_at elements, so you should\nincrease min_len to ",$min_len+1," or higher for performance benefit.\n" if ($max_elements > $increase_at);
1	#!/usr/bin/perl -w
2	#
3
4	use strict;
5	use locale;
6
7	# maximum entries
8	my $max = 0;
9	# minimum letters to search by
10	my $min_len = shift @ARGV \|\| 3;
11	# if more than x elements, warn to increase min_len
12	my $increase_at = 500;
13
14	# name of generated index
15	my $headlines = 'headlines';
16
17	my $debug = 1;
18
19	sub print_file {
20	my $f = shift \|\| return;
21	open(F, $f) \|\| die "$f: $!";
22	while(<F>) {
23	print;
24	}
25	close(F);
26	}
27
28	print qq{
29	var $headlines = new Object();
30	};
31
32	my @part_arr;
33	my $last_part = '';
34	my $total = 0;
35
36	my $max_elements = 0;
37
38	sub escape_js {
39	my $t = shift \|\| return;
40	$t =~ s/(['\\])/\\$1/g && print STDERR "ESCAPED '$t'\n";
41	return $t;
42	}
43
44	while(<STDIN>) {
45	chomp;
46
47	if (!m/\t/ \|\| m/\t$/) {
48	print STDERR "SKIP '$_': no tab\n";
49	next;
50	}
51
52	my @data = split(/\t+/,$_);
53
54	my $headline = shift @data \|\| die "need at least headline!";
55
56	if (length($headline) < $min_len) {
57	print STDERR "SKIP '$_': too short\n";
58	next;
59	}
60
61
62	# split into min_len part and rest
63	my ($part,$rest) = ( substr($headline,0,$min_len), substr($headline,$min_len) );
64
65	# make part lowercase
66	$part = lc($part);
67
68	$last_part = $part if (! $last_part);
69
70	# new part?
71	if ($part ne $last_part) {
72	print STDERR $last_part,"\t",$#part_arr+1,"\n" if ($debug && $#part_arr > $increase_at);
73	$max_elements = $#part_arr if ($#part_arr > $max_elements);
74	print "${headlines}['",escape_js($last_part),"'] = [\n ",join(",\n ",@part_arr),"];\n" if (@part_arr);
75	$total += $#part_arr;
76	@part_arr = ();
77	$last_part = $part;
78	}
79	push @part_arr, "['".escape_js($headline)."','".join("','",map { escape_js($_) } @data)."']";
80
81	# break out?
82	last if ($max && $total > $max);
83	}
84
85	print "${headlines}['",escape_js($last_part)."'] = [\n ",join(",\n ",@part_arr),"];\n" if (@part_arr);
86	print qq{
87
88	${headlines}.min_len = $min_len;
89	${headlines}.length = $total;
90
91	};
92
93	print STDERR "You have more than $increase_at elements, so you should\nincrease min_len to ",$min_len+1," or higher for performance benefit.\n" if ($max_elements > $increase_at);