Súbor: [Platon] / iotta / Iotta / Categorizer / Simple.pm (stiahnutie)
Revízia 1.3, Sun Mar 23 11:30:01 2003 UTC (21 years, 1 month ago) by yenar
Zmeny od 1.2: +1 -1
[lines]
bump segmentation limit to 16 (FIXME: make configurable) [Iotta/Categorizer/Simple.pm]
|
package Iotta::Categorizer::Simple;
use strict;
require Iotta::Elem;
our @ISA = ("Iotta::Elem");
#sub run {
# my $s = shift;
# my $m = shift;
# my $in = shift;
#}
sub setup {
my $self = shift;
my $o = shift;
my @segm;
$self->ctrl ($$o{control}) if $$o{control};
for (keys %$o) {
if (/^segment/) {
my $s = $self->chain->mod_creat ($$o{$_});
push @segm, $s;
}
}
$self->segm (\@segm);
}
sub segment {
my $self = shift;
my $c = shift;
my $fls = shift;
for (@{$self->segm}) {
print "segmenter: $_\n";
$fls = $_->segment ($c, $fls);
};
return $fls;
}
sub fillcat
{
my $self = shift;
my $c = shift;
my $files = shift;
my $fls;
print "categorizer: $$c{input}\n";
my @_fls = sort { $$a{input} cmp $$b{input} } grep
{ (join ":", @{$$_{topics}}) =~ /$$c{kw}/ }
@$files;
$fls = \@_fls;
my @remain = sort { $$a{input} cmp $$b{input} } grep
{ (join ":", @{$$_{topics}}) !~ /$$c{kw}/ }
@$files;
for (@{$$c{subs}}) {
print "sub: $$_{input}\n";
my $rem = $self->fillcat ($_, $fls);
print "endsub: $$_{input}\n";
if (scalar @{$$_{files}} < 5 and scalar @{$$_{files}} + scalar @$fls <
10 and not scalar @{$$_{subs}}) {
$$_{remove} = 1;
} else {
$fls = $rem;
}
}
my $i = 0;
while ($i < scalar @{$$c{subs}}) {
my $it = ${$$c{subs}}[$i];
if ($$it{remove}) {
print "removing: $$it{input}\n";
splice @{$$c{subs}}, $i, 1;
$i --;
}
$i ++;
}
if (scalar @$fls > 16) {
$fls = $self->segment ($c, $fls);
}
for (@$fls) {
print "file: $$_{input}\n";
}
for (@{$$c{subs}}) {
print "remained sub: $$_{input}\n";
}
$$c{files} = $fls;
return \@remain;
}
sub sort {
my @idx;
my $s = shift;
my $files =shift;
my $in;
my @cats;
open IN, $s->ctrl;
$in .= $_ while (<IN>);
close IN;
$in =~ s/^#.*?\n//gsm;
for (split /\n/, $in) {
my %cat;
/^(.*?)[ \t]*\[(.*?)\][ \t]*\((.*?)\)$/;
$cat{input} = $1;
$cat{title} = $2;
$cat{kw} = $3;
push @cats, \%cat;
}
my @tcats = @cats;
for my $c (@cats) {
my @subs = grep { $$_{input} =~ /^$$c{input}-/ } @tcats;
@tcats = grep { $$_{input} !~ /^$$c{input}-/ } @tcats;
for (@subs) {
print "sub: $$_{input}\n";
}
$$c{subs} = \@subs;
}
for my $c (@tcats) {
$s->fillcat ($c, $files);
}
return \@tcats;
}
sub initialize {
my $self = shift;
$self->SUPER::initialize (@_);
$self->{ctrl} = 'default.cat';
$self->{segm} = ();
}
1;
Platon Group <platon@platon.sk> http://platon.sk/
|