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