add bindings and test case to load hdlist files like the python bindings

CVS patchset: 6965
CVS date: 2003/12/08 21:36:50

4 files changed, 47 insertions, 2 deletions

diff --git a/perl-RPM2/RPM2.pm b/perl-RPM2/RPM2.pm
index 76bbd734f..282dbdc8e 100644
--- a/perl-RPM2/RPM2.pm
+++ b/perl-RPM2/RPM2.pm
@@ -9,7 +9,7 @@ use File::Basename;
 use File::Spec;
 
 use vars qw/$VERSION/;
-$VERSION = '0.63';
+$VERSION = '0.64';
 use vars qw/@ISA/;
 @ISA = qw/DynaLoader/;
 
@@ -51,6 +51,25 @@ sub open_rpm_db {
   return $self;
 }
 
+sub open_hdlist {
+  my $class = shift;
+  my $file = shift;
+
+  open FH, "<$file"
+    or die "Can't open $file: $!";
+
+  my @ret;
+  while (1) {
+    my ($hdr) = RPM2::_read_from_file(*FH);
+    last unless $hdr;
+
+    push @ret, RPM2::Header->_new_raw($hdr);
+  }
+
+  close FH;
+  return @ret;
+}
+
 sub open_package {
   my $class = shift;
   my $file = shift;
diff --git a/perl-RPM2/RPM2.xs b/perl-RPM2/RPM2.xs
index 919262e45..98b228fd8 100644
--- a/perl-RPM2/RPM2.xs
+++ b/perl-RPM2/RPM2.xs
@@ -299,6 +299,28 @@ _create_transaction(vsflags)
 
 	PUSHs(h_sv);
 
+void
+_read_from_file(fp)
+	FILE *fp
+PREINIT:
+	SV *h_sv;
+	FD_t fd;
+	Header h;
+PPCODE:
+	fd = fdDup(fileno(fp));
+	h = headerRead(fd, HEADER_MAGIC_YES);
+
+	if (h) {
+	    EXTEND(SP, 1);
+
+	    h_sv = sv_newmortal();
+	    sv_setref_pv(h_sv, "RPM2::C::Header", (void *)h);
+
+	    PUSHs(h_sv);
+	}
+	Fclose(fd);
+
+
 rpmdb
 _open_rpm_db(for_write)
 	int   for_write
diff --git a/perl-RPM2/hdlist-test.hdr b/perl-RPM2/hdlist-test.hdr
new file mode 100644
index 000000000..61ff4fada
--- /dev/null
+++ b/perl-RPM2/hdlist-test.hdr
diff --git a/perl-RPM2/test.pl b/perl-RPM2/test.pl
index ff3229f01..089c9aa6f 100644
--- a/perl-RPM2/test.pl
+++ b/perl-RPM2/test.pl
@@ -11,7 +11,7 @@ use strict;
 
 use Test;
 use strict;
-BEGIN { plan tests => 35 };
+BEGIN { plan tests => 59 };
 use RPM2;
 ok(1); # If we made it this far, we're ok.
 
@@ -182,3 +182,7 @@ ok(scalar(@rpms) == 1);
 ok($t->run());
 # Test closing the database
 ok($t->close_db());
+
+my @headers = RPM2->open_hdlist("hdlist-test.hdr");
+ok(scalar @headers, 3, 'found three headers in hdlist-test.hdr');
+ok(grep { $_->tag('name') eq 'mod_perl' } @headers);