summaryrefslogtreecommitdiff
path: root/perl-RPM2
diff options
context:
space:
mode:
Diffstat (limited to 'perl-RPM2')
-rw-r--r--perl-RPM2/MANIFEST6
-rw-r--r--perl-RPM2/Makefile.PL13
-rw-r--r--perl-RPM2/README35
-rw-r--r--perl-RPM2/RPM2.pm242
-rw-r--r--perl-RPM2/RPM2.xs171
-rw-r--r--perl-RPM2/test.pl50
-rw-r--r--perl-RPM2/typemap20
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 );
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-26 16:14:36 +0000