~ubuntu-branches/ubuntu/quantal/recoll/quantal

« back to all changes in this revision

Viewing changes to .pc/02_recoll_staticfix_626882.diff/filters/rclimg

  • Committer: Bazaar Package Importer
  • Author(s): Kartik Mistry
  • Date: 2011-06-15 09:20:20 UTC
  • mfrom: (1.3.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20110615092020-gkauqeqlgiw4pju4
Tags: 1.15.9-1
* New upstream release:
  + Dropped patch 02_recoll_staticfix_626882.diff, merged upstream

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
#! /usr/bin/perl -w
2
 
# @(#$Id: rclimg,v 1.5 2008-10-09 06:41:21 dockes Exp $  (C) 2007 Cedric Scott
3
 
#######################################################
4
 
# This program is free software; you can redistribute it and/or modify
5
 
# it under the terms of the GNU General Public License as published by
6
 
# the Free Software Foundation; either version 2 of the License, or
7
 
# (at your option) any later version.
8
 
#
9
 
# This program is distributed in the hope that it will be useful,
10
 
# but WITHOUT ANY WARRANTY; without even the implied warranty of
11
 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12
 
# GNU General Public License for more details.
13
 
#
14
 
# You should have received a copy of the GNU General Public License
15
 
# along with this program; if not, write to the
16
 
# Free Software Foundation, Inc.,
17
 
# 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
18
 
######################################################
19
 
 
20
 
#
21
 
# Extract image tags with exiftool and convert the data to html for
22
 
# recoll indexing.
23
 
#
24
 
 
25
 
#
26
 
# maps image file tags to xapian tags
27
 
#
28
 
$tagMap = {
29
 
        'subject' => 'subject',
30
 
        'title' => 'title',
31
 
        'headline' => 'title',
32
 
        'caption' => 'caption',
33
 
        'caption-abstract' => 'caption',
34
 
        'author' => 'author',
35
 
        'creator' => 'creator',
36
 
        'from' => 'from',
37
 
        'keywords' => 'keywords',
38
 
        'keyword' => 'keyword',
39
 
        'tag' => 'tag',
40
 
};
41
 
 
42
 
# set to non-zero if tags which map to xapian tags are to output
43
 
# in the body as well as the header
44
 
#
45
 
$headAndBody = 1;
46
 
 
47
 
# xapianTag
48
 
# returns a xapian tag to be used for this tag
49
 
#
50
 
sub xapianTag {
51
 
        my $imgtag = shift;
52
 
        while ( ( $tagre, $xapiantag) = each %{$tagMap} ) {
53
 
                return $xapiantag  if $imgtag =~ /$tagre/i;
54
 
        }
55
 
        return undef;
56
 
}
57
 
 
58
 
sub imgTagsToHtml {
59
 
    my $imageFile = shift;
60
 
    my $output = "";
61
 
    $imageFile = '-' if $imageFile eq '';
62
 
    unless ( open(IMGF, $imageFile)  ) {
63
 
        print STDERR "$0: can't open file $imageFile\n";
64
 
        return $output; # file doesn't exist or can't be read
65
 
    }
66
 
    $info = ImageInfo(\*IMGF);
67
 
    return $output unless $info;
68
 
    $fields = [];
69
 
    $other = [];
70
 
    $titleHtmlTag = "";
71
 
    foreach $tagname ( sort keys %{$info} ) {
72
 
        $xapiantag = xapianTag($tagname);
73
 
        if (defined $xapiantag ) {
74
 
            push @{$fields}, [ $xapiantag, $info->{$tagname} ];
75
 
            if ($xapiantag eq 'title') {
76
 
                $titleHtmlTag = "<title>$info->{$tagname}</title>";
77
 
            }
78
 
            push @{$other}, [ $tagname, $info->{$tagname} ] if $headAndBody;
79
 
        } else {
80
 
            push @{$other}, [ $tagname, $info->{$tagname} ];
81
 
        }
82
 
    }
83
 
    $output = "<html>\n<head>\n$titleHtmlTag\n" .
84
 
    "<meta http-equiv=\"Content-Type\" content=\"text/html;charset=UTF-8\">\n";
85
 
    foreach $tagpair ( @{$fields} ) {
86
 
        ($tagname, $value) = @{$tagpair};
87
 
        $output = $output . "<meta name=\"$tagname\" content=\"$value\">\n";
88
 
    }
89
 
    $output = $output . "</head><body>\n";
90
 
    foreach $tagpair (@{$other} ) {
91
 
        ($tagname, $value) = @{$tagpair};
92
 
        $output = $output . sprintf("%30s : %s<br>\n", $tagname, $value);
93
 
    }
94
 
    $output = $output . "</body>\n</html>\n";
95
 
    return $output;
96
 
}
97
 
 
98
 
# Get one line from stdin (from recollindex), exit on eof
99
 
sub readlineorexit {
100
 
    my $s = <STDIN>;
101
 
    unless ($s) {
102
 
        # print STDERR "RCLIMG: EOF\n";
103
 
        exit 0;
104
 
    }
105
 
    return $s
106
 
}
107
 
 
108
 
# Read one named parameter
109
 
sub readparam {
110
 
    my $s = readlineorexit();
111
 
    if ($s eq "\n") {
112
 
        return ("","");
113
 
    }
114
 
    my @l = split(' ', $s);
115
 
 
116
 
    if (scalar(@l) != 2) {
117
 
        print STDERR "RCLIMG: bad line:", $s;
118
 
        exit 1;
119
 
    }
120
 
    my $paramname = lc $l[0];
121
 
    my $paramsize = $l[1];
122
 
    if ($paramsize > 0) {
123
 
        my $n = read STDIN, $paramdata, $paramsize;
124
 
        if ($n != $paramsize) {
125
 
            print STDERR "RCLIMG: [$paramname] expected $paramsize, got $n\n";
126
 
            exit 1;
127
 
        }
128
 
    }
129
 
    # print STDERR "RCLIMG: [$paramname] $paramsize bytes: [$paramdata]\n";
130
 
    return ($paramname, $paramdata);
131
 
}
132
 
 
133
 
#
134
 
# Main program starts here. Talks the rclexecm protocol
135
 
#
136
 
 
137
 
# JFD: replaced the "use" call with a runtime load with error checking,
138
 
# for compat with the missing filter detection code.
139
 
#use Image::ExifTool qw(:Public);
140
 
eval {require Image::ExifTool; Image::ExifTool->import(qw(:Public));}; 
141
 
if ($@) {
142
 
        print "RECFILTERROR HELPERNOTFOUND Perl::Image::ExifTool\n";
143
 
        exit(1);
144
 
}
145
 
 
146
 
#print STDERR "RCLIMG: Starting\n";
147
 
$| = 1;
148
 
while (1) {
149
 
    # print STDERR "RCLIMG: waiting for command\n";
150
 
 
151
 
    my %params = ();
152
 
    # Read at most 10 parameters (we only actually use one), stop at empty line
153
 
    for($i = 1; $i < 10; $i++) {
154
 
        my ($name, $value) = readparam;
155
 
        if ($name eq "") {
156
 
            last;
157
 
        }
158
 
        $params{$name} = $value;
159
 
    }
160
 
    unless (defined $params{"filename:"}) {
161
 
        print STDERR "RCLIMG: no filename ??\n";
162
 
        # Recoll is requesting next subdocument (it shouldn't cause we 
163
 
        # returned eofnext last time), but we have none, just say so:
164
 
        print "Eofnow:0\nDocument: 0\n\n";
165
 
        next;
166
 
    }
167
 
 
168
 
    print "Mimetype: 9\ntext/html";
169
 
    my $data = imgTagsToHtml($params{"filename:"});
170
 
    my $l = length($data);
171
 
    print "Document: $l\n";
172
 
    # print STDERR "RCLIMG: writing $l bytes of data\n";
173
 
    print $data;
174
 
    # Say we have no further documents for this file
175
 
    print "Eofnext: 0\n";
176
 
    # End of output parameters: print empty line
177
 
    print "\n";
178
 
    # print STDERR "RCLIMG: done writing data\n";
179
 
}
180
 
#print STDERR "RCLIMG: Exiting\n";