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