From f60ad53050bcbcfbfaa1fe4d43a77f43a6c04f49 Mon Sep 17 00:00:00 2001
From: Rafael Garcia-Suarez <rgarciasuarez@mandriva.org>
Date: Thu, 22 Jul 2004 03:15:21 +0000
Subject: Add URPM::stream2header (borrowed from perl-Hdlist, thanks to Olivier
 Thauvin)

---
 URPM.xs   | 23 +++++++++++++++++++++++
 t/parse.t | 23 ++++++++++++++++++-----
 2 files changed, 41 insertions(+), 5 deletions(-)

diff --git a/URPM.xs b/URPM.xs
index 6db9d48..1f384d7 100644
--- a/URPM.xs
+++ b/URPM.xs
@@ -4064,3 +4064,26 @@ Urpm_import_pubkey(...)
 #endif
   OUTPUT:
   RETVAL
+
+void
+Urpm_stream2header(pio)
+    PerlIO *pio;
+  PREINIT:
+    FILE *fp;
+    FD_t fd;
+    URPM__Package pkg;
+  PPCODE:
+    if (!(fp = PerlIO_findFILE(pio))) croak("Can't get perlio");
+    if ((fd = fdDup(fileno(fp)))) {
+	pkg = (URPM__Package)malloc(sizeof(struct s_Package));
+	memset(pkg, 0, sizeof(struct s_Package));
+        pkg->h = headerRead(fd, HEADER_MAGIC_YES);
+        if (pkg->h) {
+            SV *sv_pkg;
+            EXTEND(SP, 1);
+            sv_pkg = sv_newmortal();
+            sv_setref_pv(sv_pkg, "URPM::Package", (void*)pkg);
+            PUSHs(sv_pkg);
+        }
+        Fclose(fd);
+    }
diff --git a/t/parse.t b/t/parse.t
index 92d14d0..6fb4b26 100644
--- a/t/parse.t
+++ b/t/parse.t
@@ -4,7 +4,7 @@
 
 use strict ;
 use warnings ;
-use Test::More tests => 15;
+use Test::More tests => 20;
 use URPM;
 use URPM::Build;
 use URPM::Query;
@@ -25,10 +25,12 @@ ok($pkg->get_tag(1001) eq '1.0');
 ok($pkg->get_tag(1002) eq '1mdk');
 ok($pkg->queryformat("%{NAME}-%{VERSION}-%{RELEASE}.%{ARCH}") eq "test-rpm-1.0-1mdk.noarch");
 
-$a->build_hdlist(start  => 0,
-                    end    => $#{$a->{depslist}},
-                    hdlist => 'hdlist.cz',
-                    ratio  => 9);
+$a->build_hdlist(
+    start  => 0,
+    end    => $#{$a->{depslist}},
+    hdlist => 'hdlist.cz',
+    ratio  => 9,
+);
 
 ok(-f 'hdlist.cz');
 
@@ -41,3 +43,14 @@ ok($pkg->get_tag(1000) eq 'test-rpm');
 ok($pkg->get_tag(1001) eq '1.0');
 ok($pkg->get_tag(1002) eq '1mdk');
 ok($pkg->queryformat("%{NAME}-%{VERSION}-%{RELEASE}.%{ARCH}") eq "test-rpm-1.0-1mdk.noarch");
+
+{
+    open(my $hdfh, "zcat hdlist.cz |") or die $!;
+    my $pkg = URPM::stream2header($hdfh);
+    ok(defined $pkg, "Reading a header works");
+    ok($pkg->get_tag(1000) eq 'test-rpm');
+    ok($pkg->get_tag(1001) eq '1.0');
+    ok($pkg->get_tag(1002) eq '1mdk');
+    ok($pkg->queryformat("%{NAME}-%{VERSION}-%{RELEASE}.%{ARCH}") eq "test-rpm-1.0-1mdk.noarch");
+    close $hdfh;
+}
-- 
cgit v1.2.1