/[Semantic-Engine]/EPrints/EPrints.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /EPrints/EPrints.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6 - (show annotations)
Fri Jun 29 14:52:31 2007 UTC (16 years, 10 months ago) by dpavlin
File size: 1515 byte(s)
Extract just lang='hr' values, implement sliding combination of slogovi
1 # Dobrica Pavlinusic, <dpavlin@rot13.org> 06/28/07 23:28:21 CEST
2
3 package EPrints;
4
5 use Exporter 'import';
6 @EXPORT_OK = qw(_x slogovi);
7
8 use Encode qw/from_to decode_utf8 decode/;
9 use Data::Dump qw/dump/;
10 use DBI;
11
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
41 my $sql = qq{
42 SELECT $field
43 FROM archive_$field
44 WHERE eprintid = $id and lang = 'hr'
45 };
46 warn "# sql: $sql\n" if $debug;
47 my @results = map { _x( $_->{$field} ) } @{ $dbh->selectall_arrayref($sql, { Slice => {} }) };
48
49 warn "# loookup( $field, $id ) = ", dump( @results ),$/ if $debug;
50 return join(" ", @results);
51 }
52
53 sub _x {
54 my $v = join(" ", @_);
55 decode_utf8( $v );
56 from_to( $v, 'utf-8', 'iso-8859-2' );
57 warn "_x($v)\n" if $debug;
58 return "$v ";
59 }
60
61 sub slogovi {
62 my $text = shift;
63
64 my $count = 2;
65 my $out = '';
66
67 foreach my $w ( split(/\W*\s+\W*/, $text ) ) {
68 warn "w: $w\n" if $debug;
69 my @s;
70 while ( $w =~ s/^([^aeiou]*[aeiou])//i ) {
71 push @s, $1;
72 }
73 push @s, $w if $w;
74 warn "slogovi = ", dump( @s ), $/ if $debug;
75 foreach my $p ( 0 .. ( $#s - $count + 1 ) ) {
76 map { $out .= $s[ $p + $_ ] } 0 .. $count - 1;
77 $out .= ' ';
78 }
79 }
80 warn "$out\n" if $debug;
81 return $out;
82 }
83
84 1;

  ViewVC Help
Powered by ViewVC 1.1.26