From f5f18ee2a856e8e17ac9261f36cea95de7d34aa0 Mon Sep 17 00:00:00 2001 From: cturner Date: Sun, 7 Apr 2002 06:45:24 +0000 Subject: [PATCH] initial import of perl-RPM2 CVS patchset: 5375 CVS date: 2002/04/07 06:45:24 --- perl-RPM2/MANIFEST | 6 ++ perl-RPM2/Makefile.PL | 13 +++ perl-RPM2/README | 35 ++++++ perl-RPM2/RPM2.pm | 242 ++++++++++++++++++++++++++++++++++++++++++ perl-RPM2/RPM2.xs | 171 +++++++++++++++++++++++++++++ perl-RPM2/test.pl | 50 +++++++++ perl-RPM2/typemap | 20 ++++ 7 files changed, 537 insertions(+) create mode 100644 perl-RPM2/MANIFEST create mode 100644 perl-RPM2/Makefile.PL create mode 100644 perl-RPM2/README create mode 100644 perl-RPM2/RPM2.pm create mode 100644 perl-RPM2/RPM2.xs create mode 100644 perl-RPM2/test.pl create mode 100644 perl-RPM2/typemap 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, Ea.u.thor@a.galaxy.far.far.awayE + +=head1 SEE ALSO + +L. + +=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 );