Platon Technologies
neprihlásený Prihlásiť Registrácia
SlovakEnglish
open source software development oslavujeme 10 rokov vývoja otvoreného softvéru! Piatok, 19. apríl 2024

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/
Copyright © 2002-2006 Platon Group
Stránka používa redakčný systém Metafox
Na začiatok