- move to trunk

git-svn-id: svn+ssh://haiku.zarb.org/home/projects/rpm4/svn/trunk@36 971eb68f-4bfb-0310-8326-d2484c010a4c

1 files changed, 96 insertions, 0 deletions

diff --git a/RPM4/examples/rpminstall b/RPM4/examples/rpminstall
new file mode 100755
index 0000000..fef5caf
--- /dev/null
+++ b/RPM4/examples/rpminstall
@@ -0,0 +1,96 @@
+#!/usr/bin/perl
+
+##- Nanar <nanardon@mandrake.org>
+##-
+##- 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 Hdlist;
+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)) {
+    Hdlist::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);