/[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

Diff of /EPrints/EPrints.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 3 by dpavlin, Fri Jun 29 09:21:11 2007 UTC revision 13 by dpavlin, Fri Jun 29 18:46:45 2007 UTC
# Line 3  Line 3 
3  package EPrints;  package EPrints;
4    
5  use Exporter 'import';  use Exporter 'import';
6  @EXPORT_OK = qw(_x);  @EXPORT_OK = qw(_x slogovi);
7    
8  use Encode qw/from_to decode_utf8 decode/;  use Encode qw/from_to decode_utf8 decode/;
9  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
10  use DBI;  use DBI;
11    use URI::Escape;
12    
13  use strict;  use strict;
14  use warnings;  use warnings;
# Line 15  use warnings; Line 16  use warnings;
16  my $debug = 0;  my $debug = 0;
17    
18  my $connect = "DBI:mysql:dbname=eprints";  my $connect = "DBI:mysql:dbname=eprints";
19    # path to eprints installation
20    my $eprints_archive = '/data/eprints2/archives/ffzg/documents/disk0/';
21    
22  my $dbh = DBI->connect($connect,"dpavlin","") || die $DBI::errstr;  my $dbh = DBI->connect($connect,"dpavlin","") || die $DBI::errstr;
23    
# Line 37  sub id { Line 40  sub id {
40  sub lookup {  sub lookup {
41          my $self = shift;          my $self = shift;
42          my $field = shift;          my $field = shift;
43            my $table = shift;
44            my $where = '';
45    
46            if ( ! $table ) {
47                    $table = "archive_$field";
48                    $where = " and lang = 'hr'";
49            }
50    
51          my $sql = qq{          my $sql = qq{
52          SELECT $field          SELECT $field
53          FROM archive_$field          FROM $table
54          WHERE eprintid = $id          WHERE eprintid = $id $where
55          };          };
56          warn "# sql: $sql\n" if $debug;          warn "# sql: $sql\n" if $debug;
57          my @results = map { _x( $_->{$field} ) } @{ $dbh->selectall_arrayref($sql, { Slice => {} }) };          my @results = map { _x( $_->{$field} ) } @{ $dbh->selectall_arrayref($sql, { Slice => {} }) };
# Line 50  sub lookup { Line 60  sub lookup {
60          return join("   ", @results);          return join("   ", @results);
61  }  }
62    
63    sub fulltext {
64            my $self = shift;
65            my $fulltext = EPrints->lookup( 'fileinfo', 'archive' );
66            $fulltext =~ s/\s+$//;
67            return split(/;/, $fulltext);
68    }
69    
70    sub fulltext_content {
71            my $self = shift;
72    
73            my $path = $eprints_archive;
74    
75            my ( $type, $uri ) = EPrints->fulltext;
76            $uri =~ s!http://[^/]+/!!;
77            $uri = uri_unescape($uri);
78            if ( $uri =~ s|^(\d+)/|| ) {
79                    my $nr = sprintf("%08d", $1);
80                    $nr =~ s!(\d\d)!$1/!g;
81                    $path .= "/$nr/$uri";
82            } else {
83                    warn "can't find ID in $uri";
84                    return;
85            }
86            $path =~ s!//+!/!g;
87            if ( -r $path ) {
88                    print "+ $path ", -s $path, " bytes\n";
89                    open(my $pdf, "pdftotext $path - | iconv -f utf-8 -t iso-8859-2 -c |") || die "can't open pdftotext $path: $!";
90                    local $/;
91                    my $content = <$pdf>;
92                    print "\t>>", length( $content ), " text bytes\n";
93                    close($pdf); # || die "can't close $path: $!";
94                    return $content;
95            } else {
96                    warn "ERROR: $path: $!\n";
97            }
98    
99    }
100    
101  sub _x {  sub _x {
102          my $v = join(" ", @_);          my $v = join(" ", @_);
103          decode_utf8( $v );          decode_utf8( $v );
# Line 58  sub _x { Line 106  sub _x {
106          return "$v ";          return "$v ";
107  }  }
108    
109    sub slogovi {
110            my $text = shift;
111    
112            my $count = 2;
113            my $out = '';
114    
115            foreach my $w ( split(/\W*\s+\W*/, $text ) ) {
116                    warn "w: $w\n" if $debug;
117                    my @s;
118                    while ( $w =~ s/^([^aeiou]*[aeiou])//i ) {
119                            push @s, $1;
120                    }
121                    push @s, $w if $w;
122                    warn "slogovi = ", dump( @s ), $/ if $debug;
123                    foreach my $p ( 0 .. ( $#s - $count + 1 )  ) {
124                            map { $out .= $s[ $p + $_ ] } 0 .. $count - 1;
125                            $out .= ' ';
126                    }
127            }
128            warn "$out\n" if $debug;
129            return $out;
130    }
131    
132  1;  1;
Legend:
Removed from v.3  
changed lines
  Added in v.13
  ViewVC Help
Powered by ViewVC 1.1.26