- move to trunk

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

10 files changed, 475 insertions, 0 deletions

diff --git a/RPM4/examples/checkhdr b/RPM4/examples/checkhdr
new file mode 100755
index 0000000..c2006cb
--- /dev/null
+++ b/RPM4/examples/checkhdr
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+
+# $Id$
+
+use strict;
+use warnings;
+use RPM4;
+use RPM4::Header::Checks;
+
+foreach (@ARGV) {
+    my $h = rpm2header($_);
+    RPM4::Header::Checks::check($h);
+}
diff --git a/RPM4/examples/hbuildspec b/RPM4/examples/hbuildspec
new file mode 100755
index 0000000..d0204db
--- /dev/null
+++ b/RPM4/examples/hbuildspec
@@ -0,0 +1,40 @@
+#!/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;
+
+(@ARGV) or die 
+"$0 specfile1.spec [specfile2.spec [...]] 
+Give rpms filename produce by a specfile
+";
+
+foreach (@ARGV) {
+    my $spec = Hdlist::specnew($_);
+    my @err = $spec->check();
+    if (@err) {
+        foreach (Hdlist::print_rpmpb(@err)) {
+            print "\t$_\n";
+        }
+    } else {
+
+    }
+}
diff --git a/RPM4/examples/hdinfo b/RPM4/examples/hdinfo
new file mode 100755
index 0000000..3d3de25
--- /dev/null
+++ b/RPM4/examples/hdinfo
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+ 
+##- trem <trem@zarb.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;
+
+my $arch = Hdlist::getarchname();
+print "arch = " . $arch . "\n";
+
+my $os = Hdlist::getosname();
+print "os = " . $os . "\n";
+
+my $host = Hdlist::buildhost();
+print "host = " . $host . "\n";
diff --git a/RPM4/examples/hdlist2sdb b/RPM4/examples/hdlist2sdb
new file mode 100755
index 0000000..e1fe387
--- /dev/null
+++ b/RPM4/examples/hdlist2sdb
@@ -0,0 +1,68 @@
+#!/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;
+
+GetOptions (
+    'dbpath=s' => \my $dbpath,
+    'v' => \my $verbose,
+) && @ARGV or die "
+Usage $0 [--dbpath path] hdlist.cz [hdlist2.cz [...]]
+Synch rpm found into given hdlist into a database.
+Usefull to create a solve rpm database.
+";
+
+$dbpath ||= Hdlist::expand("%_solve_dbpath");
+
+Hdlist::add_macro("_dbpath $dbpath");
+
+my $db = Hdlist::newdb(1) or die "Can't open DB";
+
+my %rpmlist;
+my %indb;
+
+$db->traverse_headers( sub {
+        my ($hdr, $id) = @_;
+        $indb{$hdr->queryformat("%{PKGID}")} = 1;
+    });
+
+foreach my $arg (@ARGV) {
+    print "Reading $arg\n";
+    open(my $hdfh, "zcat '$arg' |") or die "Can't open $_";
+    while (my $hdr = stream2header($hdfh)) {
+        $rpmlist{$hdr->queryformat("%{PKGID}")} = 1;
+        defined($indb{$hdr->queryformat("%{PKGID}")}) and next;
+        print "Adding " . $hdr->queryformat("%{NAME}-%{VERSION}-%{RELEASE}.%{ARCH}") . "\n";
+        $db->injectheader($hdr);
+    }
+}
+
+my @id2remove;
+
+$db->traverse_headers( sub {
+        my ($hdr, $id) = @_;
+        defined($rpmlist{$hdr->queryformat("%{PKGID}")}) or push(@id2remove, $id);
+    });
+
+foreach (@id2remove) {
+    $db->deleteheader($_);
+}
diff --git a/RPM4/examples/hdlistq b/RPM4/examples/hdlistq
new file mode 100755
index 0000000..1e2489a
--- /dev/null
+++ b/RPM4/examples/hdlistq
@@ -0,0 +1,68 @@
+#!/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;
+
+my $qf = "%{NAME}-%{VERSION}-%{RELEASE}.%{ARCH}\n";
+my $cond = undef;
+
+my $go_res = GetOptions (
+    "qf|queryformat=s" => \$qf,
+    "c|cond=s" => \$cond,
+    "qi" => sub {
+        $qf = 
+'Name        : %-27{NAME}  Relocations: %|PREFIXES?{[%{PREFIXES} ]}:{(not relocatable)}|
+Version     : %-27{VERSION}       Vendor: %{VENDOR}
+Release     : %-27{RELEASE}   Build Date: %{BUILDTIME:date}
+Install Date: %|INSTALLTIME?{%-27{INSTALLTIME:date}}:{(not installed)         }|      Build Host: %{BUILDHOST}
+Group       : %-27{GROUP}   Source RPM: %{SOURCERPM}
+Size        : %-27{SIZE}%|LICENSE?{      License: %{LICENSE}}|
+Signature   : %|DSAHEADER?{%{DSAHEADER:pgpsig}}:{%|RSAHEADER?{%{RSAHEADER:pgpsig}}:{%|SIGGPG?{%{SIGGPG:pgpsig}}:{%|SIGPGP?{%{SIGPGP:pgpsig}}:{(none)}|}|}|}|
+%|PACKAGER?{Packager    : %{PACKAGER}\n}|%|URL?{URL         : %{URL}\n}|\Summary     : %{SUMMARY}
+Description :\n%{DESCRIPTION}
+';
+    },
+);
+my ($type, $name, $flag, $ENV, $dep);
+if ($cond) {
+    my @d = split(/ +/, $cond);
+    $dep = Hdlist::newdep(@d);
+}
+
+($go_res && @ARGV) or die 
+"$0 [--qf|--queryformat rpm_query] [--cond cond] hdlist.cz [hdlist2.cz [...]]
+Do something like `rpm -q --queryformat' on each header contains in hdlist archive
+--cond: show only rpm which apply to this condition:
+  R|C NAME [<=> VERSION], ex C rpm = 4.2.1 will show rpm providing rpm-4.2.1
+example: $0 --qf '%{NAME}\\n' hdlist.cz
+";
+
+foreach (@ARGV) {
+    open(my $hdfh, "zcat '$_' |") or die "Can't open $_";
+    while (my $hdr = stream2header($hdfh)) {
+        if ($cond) {
+            $hdr->matchdep($dep, "PROVIDE") or next;
+        }
+        print $hdr->queryformat($qf);
+    }
+    close($hdfh);
+}
diff --git a/RPM4/examples/hdrpmq b/RPM4/examples/hdrpmq
new file mode 100755
index 0000000..5d9c91e
--- /dev/null
+++ b/RPM4/examples/hdrpmq
@@ -0,0 +1,44 @@
+#!/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;
+
+my $qf = "%{NAME}-%{VERSION}-%{RELEASE}.%{ARCH}\n";
+
+my $go_res = GetOptions (
+    "qf|queryformat=s" => \$qf,
+);
+
+($go_res && @ARGV) or die 
+"$0 [--qf|--queryformat rpm_query] rpm1 [rpm2 [...]]
+Do something like `rpm -qp --queryformat' using perl-Hdlist
+example: $0 --qf '%{NAME}\\n' test-rpm-1.0-1mdk.noarch.rpm
+";
+
+foreach (@ARGV) {
+    my $hdr = rpm2header($_);
+    if ($hdr) {
+        print $hdr->queryformat($qf);
+    } else {
+        warn "Can't read $_\n";
+    }
+}
diff --git a/RPM4/examples/hinfo b/RPM4/examples/hinfo
new file mode 100644
index 0000000..29e1f77
--- /dev/null
+++ b/RPM4/examples/hinfo
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+ 
+##- trem <trem@zarb.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;
+
+(@ARGV) or die("$0 <rpmfilename>");
+
+foreach (@ARGV) {
+  my $header = rpm2header($_);
+  if($header) {	
+    print "tag\tnom\t\texiste\tvaleur\n";
+    foreach ($header->listtag) { 
+      print "$_\t" . Hdlist::tagName($_) .  "\t\t";
+      my $e;
+      $e = $header->hastag("$_");
+      print "$e\t";
+      eval {
+	print $header->tag($_) if($e);
+      };
+      print "SOUCI: $@" if($@);
+      print "\n";
+    }
+  }
+}
diff --git a/RPM4/examples/hrpmreb-macros b/RPM4/examples/hrpmreb-macros
new file mode 100644
index 0000000..26346b5
--- /dev/null
+++ b/RPM4/examples/hrpmreb-macros
@@ -0,0 +1,31 @@
+# $id$
+
+%media contrib
+%basedistrib /home/root/mandrake/mdk/Mandrakelinux/
+
+# A way to install dependancies, with this you need a sudo
+%installdep 1
+%installdepcmd sudo -H /usr/sbin/urpmi --auto --no-verify-rpm
+
+# I have script to upload, made it
+%upload 0
+%uploadcmd /home/users/olivier/bin/upload -d %media
+
+# Where are source
+%srcdir %basedistrib/devel/cooker/SRPMS/%media
+
+# Where are binary
+%checkbinary 1
+%bindir %basedistrib/devel/cooker/%_target_cpu/media/%media
+
+# Where to put log
+%keepalllog 0
+%logdir ./%{_target_cpu}-%{media}-log
+
+# for speed up
+%_sourcedir /tmp/
+
+# If you want the build process to be niced
+# %nice 10
+
+%_signature %nil
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);
diff --git a/RPM4/examples/specwillbuild b/RPM4/examples/specwillbuild
new file mode 100755
index 0000000..7ccbbf9
--- /dev/null
+++ b/RPM4/examples/specwillbuild
@@ -0,0 +1,42 @@
+#!/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;
+
+(@ARGV) or die 
+"$0 specfile1.spec [specfile2.spec [...]] 
+Give rpms filename produce by a specfile
+";
+
+foreach (@ARGV) {
+    Hdlist::readconfig();
+    my $spec = Hdlist::specnew($_, undef, undef, undef, 1, 1);
+    defined $spec or do {
+        warn "unable to parse $_\n";
+        next;
+    };
+    print "$_:\n";
+    print $spec->srcrpm . "\n";
+    foreach my $bin ($spec->binrpm) {
+        print "$bin\n";
+    }
+}