initial import of perl-RPM2

CVS patchset: 5375
CVS date: 2002/04/07 06:45:24

7 files changed, 537 insertions, 0 deletions

diff --git a/perl-RPM2/MANIFEST b/perl-RPM2/MANIFEST
new file mode 100644
index 000000000..12148ea59
--- /dev/null
+++ b/perl-RPM2/MANIFEST
@@ -0,0 +1,6 @@
+Makefile.PL
+MANIFEST
+README
+RPM2.pm
+RPM2.xs
+test.pl
diff --git a/perl-RPM2/Makefile.PL b/perl-RPM2/Makefile.PL
new file mode 100644
index 000000000..51741a3d7
--- /dev/null
+++ b/perl-RPM2/Makefile.PL
@@ -0,0 +1,13 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    'NAME'		=> 'RPM2',
+    'VERSION_FROM'	=> 'RPM2.pm', # finds $VERSION
+    'PREREQ_PM'		=> {}, # e.g., Module::Name => 1.1
+    'LIBS'		=> ['-lpopt -lrpm -lrpmio -lrpmdb'], # e.g., '-lm'
+    'DEFINE'		=> '', # e.g., '-DHAVE_SOMETHING'
+    'INC'		=> '-I/usr/include/rpm', # e.g., '-I/usr/include/other'
+    'TYPEMAPS'          => [ 'typemap' ],
+    'OPTIMIZE'          => '-g'
+);
diff --git a/perl-RPM2/README b/perl-RPM2/README
new file mode 100644
index 000000000..9280a4bad
--- /dev/null
+++ b/perl-RPM2/README
@@ -0,0 +1,35 @@
+RPM2 version 0.01
+=================
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+  blah blah blah
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2001 A. U. Thor blah blah blah
+
diff --git a/perl-RPM2/RPM2.pm b/perl-RPM2/RPM2.pm
new file mode 100644
index 000000000..cc11d27a2
--- /dev/null
+++ b/perl-RPM2/RPM2.pm
@@ -0,0 +1,242 @@
+package RPM2;
+
+use 5.00503;
+use strict;
+use DynaLoader;
+use Data::Dumper;
+
+use vars qw/$VERSION/;
+$VERSION = '0.01';
+use vars qw/@ISA/;
+@ISA = qw/DynaLoader/;
+
+bootstrap RPM2 $VERSION;
+
+my %tagmap;
+
+RPM2::_init_rpm();
+RPM2::_populate_header_tags(\%tagmap);
+
+sub open_rpm_db {
+  my $class = shift;
+  my %params = @_;
+
+  my $self = bless { }, $class;
+  $self->{db} = RPM2::_open_rpm_db($params{-path}, $params{-read_only} ? 0 : 1);
+
+  return $self;
+}
+
+sub open_package_file {
+  my $class = shift;
+  my $file = shift;
+
+  open FH, "<$file"
+    or die "Can't open $file: $!";
+
+  my ($hdr, $sigs) = RPM2::_read_package_info(*FH);
+  close FH;
+
+  $hdr = RPM2::Header->_new_raw($hdr, 1);
+  $sigs = RPM2::Header->_new_raw($sigs, 1);
+
+  return ($hdr, $sigs);
+}
+
+sub close_rpm_db {
+  my $self = shift;
+  die "db not open" unless $self->{db};
+
+  foreach my $iter (@{$self->{active_iterators}}) {
+    $iter->_cleanup();
+  }
+
+  $self->{active_iterators} = [];
+
+  RPM2::_close_rpm_db($self->{db});
+  $self->{db} = undef;
+}
+
+sub iterator {
+  my $self = shift;
+  my $str = shift;
+
+  die "db closed" unless $self->{db};
+  my $iter = RPM2::PackageIterator->new_iterator($self->{db}, $str);
+  push @{$self->{active_iterators}}, $iter;
+
+  return $iter;
+}
+
+sub _remove_iter {
+  my $self = shift;
+  my $iter = shift;
+
+  @{$self->{active_iterators}} = grep { $_ != $iter } @{$self->{active_iterators}};
+}
+
+sub DESTROY {
+  my $self = shift;
+
+  if ($self->{db}) {
+    $self->close_rpm_db();
+  }
+}
+
+package RPM2::Header;
+
+sub _new_raw {
+  my $class = shift;
+  my $c_header = shift;
+  my $need_free = shift;
+
+  my $self = bless { }, $class;
+  $self->{header} = $c_header;
+  $self->{need_free} = $need_free;
+
+  return $self;
+}
+
+sub tag {
+  my $self = shift;
+  my $tag = shift;
+
+  $tag = uc "RPMTAG_$tag";
+
+  die "tag $tag invalid"
+    unless exists $tagmap{$tag};
+
+  return RPM2::_header_tag($self->{header}, $tagmap{$tag});
+}
+
+sub as_nvre {
+  my $self = shift;
+  my $epoch = $self->tag('epoch');
+  my $epoch_str = '';
+
+  $epoch_str = "$epoch:" if defined $epoch;
+
+  my $ret = $epoch_str . join("-", map { $self->tag($_) } qw/name version release/);
+
+  return $ret;
+}
+
+sub files {
+  my $self = shift;
+
+  if (not exists $self->{files}) {
+    my @base_names = $self->tag('basenames');
+    my @dir_names = $self->tag('dirnames');
+    my @dir_indexes = $self->tag('dirindexes');
+
+    my @files;
+    foreach (0 .. $#base_names) {
+      push @files, $dir_names[$dir_indexes[$_]] . $base_names[$_];
+    }
+
+    $self->{files} = \@files;
+  }
+
+  return @{$self->{files}};
+}
+
+sub DESTROY {
+  my $self = shift;
+
+  if ($self->{need_free}) {
+    RPM2::_free_header(delete $self->{header});
+  }
+}
+
+package RPM2::PackageIterator;
+
+sub RPMDBI_PACKAGES { 0; }
+
+sub new_iterator {
+  my $class = shift;
+  my $db = shift;
+  my $key = shift;
+
+  my $self = bless {}, $class;
+  $self->{iter} = RPM2::_init_iterator($db, RPM2::PackageIterator::RPMDBI_PACKAGES, $key, defined $key ? length $key : 0);
+
+  return $self;
+}
+
+sub next {
+  my $self = shift;
+
+  die "no iterator" unless $self->{iter};
+
+  my $hdr = RPM2::_iterator_next($self->{iter});
+  return unless $hdr;
+
+  return RPM2::Header->_new_raw($hdr, 1);
+}
+
+sub _cleanup {
+  my $self = shift;
+  return unless $self->{iter};
+
+  RPM2::_destroy_iterator($self->{iter});
+
+  delete $self->{$_} foreach keys %$self;
+}
+
+sub DESTROY {
+  my $self = shift;
+
+  $self->_cleanup();
+}
+
+# Preloaded methods go here.
+
+1;
+__END__
+# Below is stub documentation for your module. You better edit it!
+
+=head1 NAME
+
+RPM2 - Perl extension for blah blah blah
+
+=head1 SYNOPSIS
+
+  use RPM2;
+  blah blah blah
+
+=head1 DESCRIPTION
+
+Stub documentation for RPM2, created by h2xs. It looks like the
+author of the extension was negligent enough to leave the stub
+unedited.
+
+Blah blah blah.
+
+=head2 EXPORT
+
+None by default.
+
+
+=head1 HISTORY
+
+=over 8
+
+=item 0.01
+
+Original version; created by h2xs 1.21 with options
+
+  -AC
+	RPM2
+
+=back
+
+
+=head1 AUTHOR
+
+A. U. Thor, E<lt>a.u.thor@a.galaxy.far.far.awayE<gt>
+
+=head1 SEE ALSO
+
+L<perl>.
+
+=cut
diff --git a/perl-RPM2/RPM2.xs b/perl-RPM2/RPM2.xs
new file mode 100644
index 000000000..0cde68883
--- /dev/null
+++ b/perl-RPM2/RPM2.xs
@@ -0,0 +1,171 @@
+#include "rpmcli.h"
+#include "rpmlib.h"
+#include "misc.h"
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+const char *CLASS = "RPM2";
+MODULE = RPM2		PACKAGE = RPM2
+
+int
+rpmvercmp(one, two)
+	char* one
+	char* two
+
+void
+_init_rpm()
+    CODE:
+	rpmReadConfigFiles(NULL, NULL);
+
+void
+_close_rpm_db(db)
+	rpmdb db
+    CODE:
+	rpmdbClose(db);
+
+rpmdb
+_open_rpm_db(path,for_write)
+        char  *path
+	int   for_write
+    PREINIT:
+	 rpmdb db;
+    CODE:
+	if (rpmdbOpen(path, &db, for_write ? O_RDWR | O_CREAT : O_RDONLY, 0644)) {
+		croak("rpmdbOpen failed");
+		RETVAL = NULL;
+	}
+	RETVAL = db;		
+    OUTPUT:
+	RETVAL
+
+rpmdbMatchIterator
+_init_iterator(db, rpmtag, key, len)
+	rpmdb db
+	int rpmtag
+	char *key
+	size_t len
+    CODE:
+	RETVAL = rpmdbInitIterator(db, rpmtag, key && *key ? key : NULL, len);
+    OUTPUT:
+	RETVAL
+
+void
+_destroy_iterator(i)
+	rpmdbMatchIterator i
+    CODE:
+	rpmdbFreeIterator(i);
+
+Header
+_iterator_next(i)
+	rpmdbMatchIterator i
+    CODE:
+	RETVAL = rpmdbNextIterator(i);
+    OUTPUT:
+	RETVAL
+
+void
+_read_package_info(fp)
+	FILE *fp
+    PREINIT:
+	Header ret;
+	Header sigs;
+	rpmRC rc;
+	FD_t fd;
+    PPCODE:
+	fd = fdDup(fileno(fp));
+	rc = rpmReadPackageInfo(fd, &sigs, &ret);
+	Fclose(fd);
+
+	if (rc == RPMRC_OK) {
+	    SV *h_sv, *s_sv;
+
+	    EXTEND(SP, 2);
+
+	    h_sv = sv_newmortal();
+	    s_sv = sv_newmortal();
+            sv_setref_pv(h_sv, "Header", (void *)ret);
+            sv_setref_pv(s_sv, "Header", (void *)sigs);
+
+	    PUSHs(h_sv);
+	    PUSHs(s_sv);
+	}
+	else {
+	    croak("error reading package");
+	}
+
+void
+_free_header(h)
+	Header h
+    CODE:
+	headerFree(h);
+
+void
+_header_tag(h, tag)
+	Header h
+	int tag
+    PREINIT:
+	void *ret = NULL;
+	int type;
+	int n;
+	int ok;
+    PPCODE:
+	ok = headerGetEntry(h, tag, &type, &ret, &n);
+
+	if (!ok) {
+		/* nop, empty stack */
+	}
+	else {
+		switch(type)
+		{
+		case RPM_STRING_ARRAY_TYPE:
+			{
+			int i;
+			char **s;
+
+			EXTEND(SP, n);
+			s = (char **)ret;
+
+			for (i = 0; i < n; i++) {
+				PUSHs(sv_2mortal(newSVpv(s[i], 0)));
+			}
+			}
+			break;
+		case RPM_STRING_TYPE:
+			PUSHs(sv_2mortal(newSVpv((char *)ret, 0)));
+			break;
+		case RPM_CHAR_TYPE:
+		case RPM_INT8_TYPE:
+		case RPM_INT16_TYPE:
+		case RPM_INT32_TYPE:
+			{
+			int i;
+			int *r;
+
+			EXTEND(SP, n);
+			r = (int *)ret;
+
+			for (i = 0; i < n; i++) {
+				PUSHs(sv_2mortal(newSViv(r[i])));
+			}
+			}
+			break;
+		default:
+			croak("unknown rpm tag type %d", type);
+		}
+	}
+	headerFreeData(ret, type);
+
+
+void
+_populate_header_tags(href)
+	SV *href
+    PREINIT:
+	int i = 0;
+	HV *h;
+    CODE:
+	h = (HV *)SvRV(href);
+	for (i = 0; i < rpmTagTableSize; i++) {
+	    hv_store(h, rpmTagTable[i].name, strlen(rpmTagTable[i].name), newSViv(rpmTagTable[i].val), 0);
+	}
diff --git a/perl-RPM2/test.pl b/perl-RPM2/test.pl
new file mode 100644
index 000000000..be8d78a9c
--- /dev/null
+++ b/perl-RPM2/test.pl
@@ -0,0 +1,50 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test;
+use strict;
+BEGIN { plan tests => 6 };
+use RPM2;
+ok(1); # If we made it this far, we're ok.
+
+#########################
+
+# Insert your test code below, the Test module is use()ed here so read
+# its man page ( perldoc Test ) for help writing this test script.
+
+ok(RPM2::rpmvercmp("1.0", "1.1") == -1);
+ok(RPM2::rpmvercmp("1.1", "1.0") == 1);
+ok(RPM2::rpmvercmp("1.0", "1.0") == 0);
+ok(RPM2::rpmvercmp("1.a", "1.0") == RPM2::rpmvercmp("1.0", "1.a"));
+
+my $db = RPM2->open_rpm_db(-read_only => 1);
+ok(defined $db);
+
+while(1) {
+  my @h;
+  push @h, [ RPM2->open_package_file($_) ]
+    foreach <~/rhn/RPMS/*.rpm>;
+
+  print $_->[0]->as_nvre, "\n" foreach @h;
+}
+
+exit;
+
+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";
+}
+
+$db->close_rpm_db();
diff --git a/perl-RPM2/typemap b/perl-RPM2/typemap
new file mode 100644
index 000000000..f8bfedeb6
--- /dev/null
+++ b/perl-RPM2/typemap
@@ -0,0 +1,20 @@
+TYPEMAP
+rpmTransaction *	O_OBJECT
+rpmdb			O_OBJECT
+rpmdbMatchIterator	O_OBJECT
+Header                  O_OBJECT
+
+INPUT
+O_OBJECT
+    if (sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG))
+        $var = ($type)SvIV((SV*)SvRV( $arg ));
+    else {
+        warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" );
+        XSRETURN_UNDEF;
+    }
+
+
+
+OUTPUT
+O_OBJECT
+        sv_setref_pv( $arg, (char *)CLASS, (void*)$var );