initial import of perl-RPM2
CVS patchset: 5375 CVS date: 2002/04/07 06:45:24
This commit is contained in:
cturner
parent
e7b38bbd0c
commit
f5f18ee2a8
|
|
@ -0,0 +1,6 @@
|
||||||
|
Makefile.PL
|
||||||
|
MANIFEST
|
||||||
|
README
|
||||||
|
RPM2.pm
|
||||||
|
RPM2.xs
|
||||||
|
test.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'
|
||||||
|
);
|
||||||
|
|
@ -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
|
||||||
|
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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);
|
||||||
|
}
|
||||||
|
|
@ -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();
|
||||||
|
|
@ -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 );
|
||||||
Loading…
Reference in New Issue