#!/usr/bin/perl ##- Nanar ##- ##- This program is free software; you can redistribute it and/or modify ##- it under the terms of the GNU General Public License as published by ##- the Free Software Foundation; either version 2, or (at your option) ##- any later version. ##- ##- This program is distributed in the hope that it will be useful, ##- but WITHOUT ANY WARRANTY; without even the implied warranty of ##- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ##- GNU General Public License for more details. ##- ##- You should have received a copy of the GNU General Public License ##- along with this program; if not, write to the Free Software ##- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # $Id$ use strict; use RPM4; use Getopt::Long qw(:config pass_through); sub help { die " Usage $0 [options] [-i rpm_to_install.rpm] [-e rpm_name_to_remove] This script mimic a simple rpm programs for installing or removing packages options: --dbpath path alternate path to rpmdb --root root set rootdir for installation --test only test, do not install pkg --justdb only install package in the db, not on filesystem Notice it permit to install and to remove package in same time ! :) "; } my (@rpmi, @rpme); my @installflags; my ($root, $dbpath) = (undef, undef ); GetOptions( 'root=s' => \$root, 'dbpath=s' => \$dbpath, 'test' => sub { push(@installflags, 'TEST') }, 'justdb' => sub { push(@installflags, 'JUSTDB') }, 'h|help' => sub { help() }, ); { my $install = 1; while (my $arg = shift(@ARGV)) { $arg =~ /^-i$/ and do { $install = 1; next; }; $arg =~ m/^-e$/ and do { $install = 0; next; }; if ($install) { push(@rpmi, $arg); } else { push(@rpme, $arg); } } } (@rpmi || @rpme) or help(); if (defined($dbpath)) { RPM4::add_macro("_dbpath $dbpath"); } my $db = newdb(0, $root); foreach my $rpm (@rpmi) { my $hdr = rpm2header($rpm) or do { warn "Can't get header from $rpm, skipping"; next; }; $db->transadd($hdr, $rpm, 1); } foreach my $rpm (@rpme) { $db->transremove($rpm) or warn "Can't remove unknown package $rpm, skipping"; } $db->transcheck(); my @pb = $db->transpb(); if (@pb) { die(join('\n', map { s/^/\t/ } format_rpmpb(@pb))); } $db->transrun(undef, @installflags);