Semantic-Engine/EPrints/EPrints.pm

# Dobrica Pavlinusic, <dpavlin@rot13.org> 06/28/07 23:28:21 CEST

package EPrints;

use Exporter 'import';
@EXPORT_OK = qw(_x slogovi);

use Encode qw/from_to decode_utf8 decode/;
use Data::Dump qw/dump/;
use DBI;

use strict;
use warnings;

my $debug = 0;

my $connect = "DBI:mysql:dbname=eprints";

my $dbh = DBI->connect($connect,"dpavlin","") || die $DBI::errstr;

sub dbh {
        my $self = shift;
        return $dbh;
}

my $id;

sub id {
        my $self = shift;
        if ( defined( $_[0] ) ) {
                $id = $_[0];
                warn "# id = $id\n" if $debug;
        }
        return $id;
}

sub lookup {
        my $self = shift;
        my $field = shift;
        my $table = shift;
        my $where = '';

        if ( ! $table ) {
                $table = "archive_$field";
                $where = " and lang = 'hr'";
        }

        my $sql = qq{
        SELECT $field
        FROM $table
        WHERE eprintid = $id $where
        };
        warn "# sql: $sql\n" if $debug;
        my @results = map { _x( $_->{$field} ) } @{ $dbh->selectall_arrayref($sql, { Slice => {} }) };

        warn "# loookup( $field, $id ) = ", dump( @results ),$/ if $debug;
        return join("   ", @results);
}

sub fulltext {
        my $self = shift;
        return split(/;/, EPrints->lookup( 'fileinfo', 'archive' ));
}

sub _x {
        my $v = join(" ", @_);
        decode_utf8( $v );
        from_to( $v, 'utf-8', 'iso-8859-2' ); 
        warn "_x($v)\n" if $debug;
        return "$v ";
}

sub slogovi {
        my $text = shift;

        my $count = 2;
        my $out = '';

        foreach my $w ( split(/\W*\s+\W*/, $text ) ) {
                warn "w: $w\n" if $debug;
                my @s;
                while ( $w =~ s/^([^aeiou]*[aeiou])//i ) {
                        push @s, $1;
                }
                push @s, $w if $w;
                warn "slogovi = ", dump( @s ), $/ if $debug;
                foreach my $p ( 0 .. ( $#s - $count + 1 )  ) {
                        map { $out .= $s[ $p + $_ ] } 0 .. $count - 1;
                        $out .= ' ';
                }
        }
        warn "$out\n" if $debug;
        return $out;
}

1;
1	dpavlin	1	# Dobrica Pavlinusic, <dpavlin@rot13.org> 06/28/07 23:28:21 CEST
2
3			package EPrints;
4
5			use Exporter 'import';
6	dpavlin	4	@EXPORT_OK = qw(_x slogovi);
7	dpavlin	1
8			use Encode qw/from_to decode_utf8 decode/;
9			use Data::Dump qw/dump/;
10	dpavlin	3	use DBI;
11	dpavlin	1
12			use strict;
13			use warnings;
14
15			my $debug = 0;
16
17			my $connect = "DBI:mysql:dbname=eprints";
18
19			my $dbh = DBI->connect($connect,"dpavlin","") \|\| die $DBI::errstr;
20
21			sub dbh {
22			my $self = shift;
23			return $dbh;
24			}
25
26			my $id;
27
28			sub id {
29			my $self = shift;
30			if ( defined( $_[0] ) ) {
31			$id = $_[0];
32			warn "# id = $id\n" if $debug;
33			}
34			return $id;
35			}
36
37			sub lookup {
38			my $self = shift;
39			my $field = shift;
40	dpavlin	11	my $table = shift;
41			my $where = '';
42	dpavlin	1
43	dpavlin	11	if ( ! $table ) {
44			$table = "archive_$field";
45			$where = " and lang = 'hr'";
46			}
47
48	dpavlin	1	my $sql = qq{
49			SELECT $field
50	dpavlin	11	FROM $table
51			WHERE eprintid = $id $where
52	dpavlin	1	};
53			warn "# sql: $sql\n" if $debug;
54			my @results = map { _x( $_->{$field} ) } @{ $dbh->selectall_arrayref($sql, { Slice => {} }) };
55
56			warn "# loookup( $field, $id ) = ", dump( @results ),$/ if $debug;
57			return join(" ", @results);
58			}
59
60	dpavlin	12	sub fulltext {
61			my $self = shift;
62			return split(/;/, EPrints->lookup( 'fileinfo', 'archive' ));
63			}
64
65	dpavlin	1	sub _x {
66			my $v = join(" ", @_);
67			decode_utf8( $v );
68			from_to( $v, 'utf-8', 'iso-8859-2' );
69			warn "_x($v)\n" if $debug;
70			return "$v ";
71			}
72
73	dpavlin	4	sub slogovi {
74			my $text = shift;
75	dpavlin	6
76			my $count = 2;
77			my $out = '';
78
79	dpavlin	4	foreach my $w ( split(/\W\s+\W/, $text ) ) {
80	dpavlin	6	warn "w: $w\n" if $debug;
81			my @s;
82	dpavlin	4	while ( $w =~ s/^([^aeiou]*[aeiou])//i ) {
83	dpavlin	6	push @s, $1;
84	dpavlin	4	}
85	dpavlin	6	push @s, $w if $w;
86	dpavlin	4	warn "slogovi = ", dump( @s ), $/ if $debug;
87	dpavlin	6	foreach my $p ( 0 .. ( $#s - $count + 1 ) ) {
88			map { $out .= $s[ $p + $_ ] } 0 .. $count - 1;
89			$out .= ' ';
90			}
91	dpavlin	4	}
92	dpavlin	6	warn "$out\n" if $debug;
93			return $out;
94	dpavlin	4	}
95
96	dpavlin	1	1;