1#
2# -*- Perl -*-
3# $Id: rpm.pl,v 1.4.4.10 2008-05-09 07:40:01 opengl2772 Exp $
4# Copyright (C) 2000-2008 Namazu Project All rights reserved.
5#     This is free software with ABSOLUTELY NO WARRANTY.
6#
7#  This program is free software; you can redistribute it and/or modify
8#  it under the terms of the GNU General Public License as published by
9#  the Free Software Foundation; either versions 2, or (at your option)
10#  any later version.
11#
12#  This program is distributed in the hope that it will be useful
13#  but WITHOUT ANY WARRANTY; without even the implied warranty of
14#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15#  GNU General Public License for more details.
16#
17#  You should have received a copy of the GNU General Public License
18#  along with this program; if not, write to the Free Software
19#  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
20#  02111-1307, USA
21#
22#  This file must be encoded in EUC-JP encoding
23#
24
25package rpm;
26use strict;
27require 'util.pl';
28require 'gfilter.pl';
29
30my $rpmpath = undef;
31my @rpmopts = undef;
32
33sub mediatype() {
34    return ('application/x-rpm');
35}
36
37sub status() {
38    $rpmpath = util::checkcmd('rpm');
39    @rpmopts = ("-qpi");
40    return 'no' unless (defined $rpmpath);
41    return 'yes';
42}
43
44sub recursive() {
45    return 0;
46}
47
48sub pre_codeconv() {
49    return 0;
50}
51
52sub post_codeconv () {
53    return 0;
54}
55
56sub add_magic ($) {
57    my ($magic) = @_;
58
59    # FIXME: very ad hoc.
60    $magic->addFileExts('\\.rpm$', 'application/x-rpm');
61    return;
62}
63
64sub filter ($$$$$) {
65    my ($orig_cfile, $cont, $weighted_str, $headings, $fields)
66      = @_;
67    my $cfile = defined $orig_cfile ? $$orig_cfile : '';
68    my $size = 0;
69
70    util::vprint("Processing rpm file ... (using  '$rpmpath')\n");
71
72    my $tmpfile = util::tmpnam('NMZ.rpm');
73    {
74        my $fh = util::efopen("> $tmpfile");
75        print $fh $$cont;
76        util::fclose($fh);
77    }
78
79    {
80        my %env = (
81            "LC_ALL" => undef,
82            "LC_MESSAGE" => $util::LANG,
83            "LC_TIME" => "C",
84        );
85        my @cmd = ($rpmpath, @rpmopts, $tmpfile);
86        my $fh_out = IO::File->new_tmpfile();
87        my $status = util::syscmd(
88            command => \@cmd,
89            option => {
90                "stdout" => $fh_out,
91                "stderr" => "/dev/null",
92            },
93            env => \%env,
94        );
95        my $size = util::filesize($fh_out);
96        if ($size == 0) {
97            util::fclose($fh_out);
98            unlink $tmpfile;
99            return "Unable to convert file ($rpmpath error occurred).";
100        }
101        if ($size > $conf::FILE_SIZE_MAX) {
102            util::fclose($fh_out);
103            unlink $tmpfile;
104            return 'Too large rpm file.';
105        }
106        $$cont = util::readfile($fh_out);
107        util::fclose($fh_out);
108    }
109    unlink $tmpfile;
110
111    codeconv::normalize_document($cont);
112
113    rpm_filter($cont, $weighted_str, $fields, $headings);
114
115    gfilter::line_adjust_filter($cont);
116    gfilter::line_adjust_filter($weighted_str);
117    gfilter::white_space_adjust_filter($cont);
118    $fields->{'title'} = gfilter::filename_to_title($cfile, $weighted_str)
119        unless $fields->{'title'};
120    gfilter::show_filter_debug_info($cont, $weighted_str,
121                                    $fields, $headings);
122
123    return undef;
124}
125
126sub rpm_filter ($$$$) {
127    my ($contref, $weighted_str, $fields, $headings) = @_;
128
129    rpm::get_title($contref, $weighted_str, $fields);
130    rpm::get_author($contref, $fields);
131    rpm::get_date($contref, $fields);
132    rpm::get_size($contref, $fields);
133    rpm::get_summary($contref, $fields);
134
135    return;
136}
137
138
139# Below is the sample result of 'rpm -qi rpm'.
140#
141# Name        : rpm                          Relocations: (not relocateable)
142# Version     : 3.0.5                             Vendor: (none)
143# Release     : 3k                            Build Date: Fri Jun 30 10:12:19 2000
144# Install date: Thu Sep 14 21:32:32 2000      Build Host: omoi.kondara.org
145# Group       : System Environment/Base       Source RPM: rpm-3.0.5-3k.nosrc.rpm
146# Size        : 3111493                          License: GPL
147# URL         : http://www.rpm.org/
148# Summary     : The Red Hat package management system.
149# Description :
150# The RPM Package Manager (RPM) is a powerful command line driven
151# package management system capable of installing, uninstalling,
152# verifying, querying, and updating software packages.  Each software
153# package consists of an archive of files along with information about
154# the package like its version, a description, etc.
155
156
157sub get_title ($$$) {
158    my ($contref, $weighted_str, $fields) = @_;
159
160    if ($$contref =~ /Summary     : (.*)/) {
161        my $tmp = $1;
162        $fields->{'title'} = $tmp;
163        my $weight = $conf::Weight{'html'}->{'title'};
164        $$weighted_str .= "\x7f$weight\x7f$tmp\x7f/$weight\x7f\n";
165    }
166}
167
168sub get_author ($$) {
169    my ($contref, $fields) = @_;
170
171    if ($$contref =~ /Vendor: (.*)/) {
172        my $tmp = $1;
173        $fields->{'author'} = $tmp;
174    }
175}
176
177sub get_date ($$) {
178    my ($contref, $fields) = @_;
179
180    if ($$contref =~ /Build Date: (.*)/) {
181        my $time = $1;
182        my $err = time::ctime_to_rfc822time(\$time);
183        $fields->{'date'} = $time unless ($err);
184    }
185}
186
187sub get_size ($$) {
188    my ($contref, $fields) = @_;
189
190    if ($$contref =~ /Size\s+: (.*)$/) {
191        my $tmp = $1;
192        $fields->{'size'} = $tmp;
193    }
194}
195
196sub get_summary ($$) {
197    my ($contref, $fields) = @_;
198
199    if ($$contref =~ /Description :(.*)/is) {
200        my $tmp = $1;
201        $fields->{'summary'} = $tmp;
202    }
203    $$contref =~ s/^.*Description ://is;
204}
205
2061;
207