vastly improve test suite; add some new methods; add some documentation; use librpm.la to help determine linker parameters

CVS patchset: 5405
CVS date: 2002/04/14 05:13:23

perl-RPM2/MANIFEST

@@ -4,3 +4,6 @@ README
 RPM2.pm
 RPM2.xs
 test.pl
+test-rpm-1.0-1.noarch.rpm
+test-rpm-1.0-1.src.rpm
+typemap

perl-RPM2/Makefile.PL

@@ -12,7 +12,6 @@ if (open FH, "</usr/lib/librpm.la") {
   if ($line and not @rest) {
     if ($line =~ /^dependency_libs='(.*)'$/) {
       $libs = "-lrpm $1";
-      print "libs: $libs\n"
     }
   }
 }

perl-RPM2/RPM2.pm

@@ -6,7 +6,7 @@ use DynaLoader;
 use Data::Dumper;
 
 use vars qw/$VERSION/;
-$VERSION = '0.01';
+$VERSION = '0.09';
 use vars qw/@ISA/;
 @ISA = qw/DynaLoader/;
 
@@ -17,17 +17,39 @@ my %tagmap;
 RPM2::_init_rpm();
 RPM2::_populate_header_tags(\%tagmap);
 
+sub add_macro {
+  my $class = shift;
+  my $name = shift;
+  my $val = shift;
+
+  RPM2::_add_macro($name, $val);
+}
+
+sub delete_macro {
+  my $class = shift;
+  my $name = shift;
+
+  RPM2::_delete_macro($name);
+}
+
 sub open_rpm_db {
   my $class = shift;
   my %params = @_;
 
   my $self = bless { }, $class;
-  $self->{db} = RPM2::_open_rpm_db($params{-path}, $params{-readwrite} ? 1 : 0);
+  if ($params{-path}) {
+    $class->add_macro("_dbpath", $params{-path});
+    $self->{db} = RPM2::_open_rpm_db(undef, $params{-readwrite} ? 1 : 0);
+    $class->delete_macro("_dbpath");
+  }
+  else {
+    $self->{db} = RPM2::_open_rpm_db(undef, $params{-readwrite} ? 1 : 0);
+  }
 
   return $self;
 }
 
-sub open_package_file {
+sub open_package {
   my $class = shift;
   my $file = shift;
 
@@ -94,6 +116,20 @@ sub find_by_provides {
   return $self->find_by_provides_iter($name)->expand_iter;
 }
 
+sub find_by_requires_iter {
+  my $self = shift;
+  my $name = shift;
+
+  return $self->iterator("RPMTAG_REQUIRENAME", $name);
+}
+
+sub find_by_requires {
+  my $self = shift;
+  my $name = shift;
+
+  return $self->find_by_requires_iter($name)->expand_iter;
+}
+
 sub find_by_file_iter {
   my $self = shift;
   my $name = shift;
@@ -309,9 +345,71 @@ RPM2 - Perl bindings for the RPM Package Manager API
 The RPM2 module provides an object-oriented interface to querying both
 the installed RPM database as well as files on the filesystem.
 
-TODO: Everything, including:
+=head1 CLASS METHODS
 
-The above methods need documenting.
+Pretty much all use of the class starts here.  There are two main
+entrypoints into the package -- either through the database of
+installed rpms (aka the rpmdb) or through a file on the filesystem
+(such as kernel-2.4.9-31.src.rpm or kernel-2.4.9-31.i386.rpm
+
+You can have multiple RPM databases open at once, as well as running
+multiple queries on each.
+
+=item open_rpm_db(-path => "/path/to/db")
+
+As it sounds, it opens the RPM database, and returns it as an object.
+
+=item open_package("foo-1.1-14.noarch.rpm")
+
+Opens a specific package (RPM or SRPM).  Returns a Header object.
+
+=head1 RPM DB object methods
+
+=item find_all_iter()
+
+Returns an iterator object that iterates over the entire database.
+
+=item find_all()
+
+Returns an list of all of the results of the find_all_iter() method.
+
+=item find_by_file_iter($filename)
+
+Returns an iterator that returns all packages that contain a given file.
+
+=item find_by_file($filename)
+
+Ditto, except it just returns the list
+
+=item find_by_name_iter($package_name)
+
+You get the idea.  This one is for iterating by package name.
+
+=item find_by_name($package_name)
+
+Ditto, except it returns a list.
+
+=item find_by_provides_iter($provides_string)
+
+This one iterates over provides.
+
+=item find_by_provides($provides_string)
+
+Ditto, except it returns a list.
+
+=item find_by_requires_iter($requires_string)
+
+This one iterates over requires.
+
+=item find_by_requires($requires_string)
+
+Ditto, except it returns a list.
+
+=head1 RPM Header object methods
+
+stuff goes here
+
+=head1 TODO
 
 Package installation and removal.
 

perl-RPM2/RPM2.xs

@@ -19,6 +19,19 @@ _init_rpm()
     CODE:
 	rpmReadConfigFiles(NULL, NULL);
 
+void
+_add_macro(name, val)
+	char * name
+	char * val
+    CODE:
+	addMacro(NULL, name, NULL, val, RMIL_DEFAULT);
+
+void
+_delete_macro(name)
+	char * name
+    CODE:
+	delMacro(NULL, name);
+
 void
 _close_rpm_db(db)
 	rpmdb db

perl-RPM2/test-rpm.spec

@@ -0,0 +1,33 @@
+Summary: test rpm for perl-RPM2 test suite
+BuildArch: noarch
+Name: test-rpm
+Version: 1.0
+Release: 1
+Source0: test-rpm.spec
+License: GPL
+Group: Application/Development
+BuildRoot: %{_tmppath}/%{name}-root
+
+%description
+test rpm
+%prep
+
+%build
+
+%install
+rm -rf $RPM_BUILD_ROOT
+mkdir -p $RPM_BUILD_ROOT/tmp
+cp %{SOURCE0} $RPM_BUILD_ROOT/tmp
+
+%clean
+rm -rf $RPM_BUILD_ROOT
+
+%files
+%defattr(-,root,root)
+/tmp/test-rpm.spec
+
+%changelog
+* Sat Apr 13 2002 Chip Turner <cturner@localhost.localdomain>
+- Initial build.
+
+

perl-RPM2/test.pl

@@ -8,7 +8,7 @@
 
 use Test;
 use strict;
-BEGIN { plan tests => 6 };
+BEGIN { plan tests => 22 };
 use RPM2;
 ok(1); # If we made it this far, we're ok.
 
@@ -20,58 +20,79 @@ ok(1); # If we made it this far, we're ok.
 ok(RPM2::rpmvercmp("1.0", "1.1") == -1);
 ok(RPM2::rpmvercmp("1.1", "1.0") == 1);
 ok(RPM2::rpmvercmp("1.0", "1.0") == 0);
+
+# this is a bug case in rpmvervmp; good one for testing
 ok(RPM2::rpmvercmp("1.a", "1.0") == RPM2::rpmvercmp("1.0", "1.a"));
 
-my $db = RPM2->open_rpm_db;
+my $db = RPM2->open_rpm_db();
 ok(defined $db);
 
-if (1) {
-  my @h;
-  push @h, [ RPM2->open_package_file($_) ]
-    foreach <~/rhn/bs/6.2/RPMS/*.rpm>;
-
-  print $_->[0]->name, " ", $_->[0]->as_nvre, "\n" foreach @h;
-}
-
-#exit;
-
-if (1) {
-  my $i = $db->iterator();
-  while (my $h = $i->next) {
-    my $epoch = $h->tag('epoch');
-    my $epoch_str = '';
-    $epoch_str = "$epoch:" if defined $epoch;
-
-    print $epoch_str . join("-", map { $h->tag($_) } qw/name version release/);
-    my @files = $h->files;
-    my $n = scalar @files;
-    print " ($n files)";
-    print "\n";
-  }
-}
-
+my @pkg;
 my $i = $db->find_all_iter();
-print "The following packages are installed (aka, 'rpm -qa'):\n";
+
+ok($i);
 while (my $pkg = $i->next) {
-  print $pkg->as_nvre, "\n";
+  push @pkg, $pkg;
 }
+ok(@pkg);
+ok($pkg[0]->name);
+
+@pkg = ();
 
 $i = $db->find_by_name_iter("kernel");
-print "The following kernels are installed (aka, 'rpm -q kernel'):\n";
+ok($i);
 while (my $pkg = $i->next) {
-  print $pkg->as_nvre, " ", int($pkg->size()/1024), "k\n";
+  push @pkg, $pkg;
 }
+if (@pkg) {
+  ok($pkg[0]->name);
+}
+
+@pkg = ();
 
 $i = $db->find_by_provides_iter("kernel");
-print "The following packages provide 'kernel' (aka, 'rpm -q --whatprovides kernel'):\n";
+ok($i);
 while (my $pkg = $i->next) {
-  print $pkg->as_nvre, " ", int($pkg->size()/1024), "k\n";
+  push @pkg, $pkg;
+}
+if (@pkg) {
+  ok($pkg[0]->name);
 }
 
-print "The following packages are installed (aka, 'rpm -qa' once more):\n";
+@pkg = ();
 foreach my $pkg ($db->find_by_file("/bin/sh")) {
-  print $pkg->as_nvre, "\n";
+  push @pkg, $pkg;
+}
+if (@pkg) {
+  ok($pkg[0]->name);
+}
+
+@pkg = ();
+foreach my $pkg ($db->find_by_requires("/bin/bash")) {
+  push @pkg, $pkg;
+}
+if (@pkg) {
+  ok($pkg[0]->name);
+}
+
+my $pkg = RPM2->open_package("test-rpm-1.0-1.noarch.rpm");
+ok($pkg);
+ok($pkg->name eq 'test-rpm');
+ok(!$pkg->is_source_package);
+
+$pkg = RPM2->open_package("test-rpm-1.0-1.src.rpm");
+ok($pkg);
+ok($pkg->name eq 'test-rpm');
+ok($pkg->is_source_package);
+
+# another rpm, handily provided by the rpmdb-redhat package
+my $other_rpm_dir = "/usr/lib/rpmdb/i386-redhat-linux/redhat";
+if (-d $other_rpm_dir) {
+  my $db2 = RPM2->open_rpm_db(-path => $other_rpm_dir);
+  ok(defined $db2);
+}
+else {
+  print "Install the rpmdb-redhat package to test two simultaneous open databases\n";
+  ok(1);
 }
 
-my $pkg = RPM2->open_package_file("/home/cturner/XFree86-4.1.0-15.src.rpm");
-print "Package opened: ", $pkg->as_nvre(), ", is source: ", $pkg->is_source_package, "\n";