[zypp-devel] [PATCH] add missing libsatsolver Perl bindings
Can you please apply this patch and submit to STABLE? This is for feature #303855 and related to bug #423368. ~~~~~~~~~~~ This patch adds missing Perl bindings (and wrappers). These are required by the SAM (Supportability Analysis Module) package. - Pool: providers(Rel *rel) providers(char *name) - Solvable: identical(XSolvable *xs) overload: "==", "=" - Repo: solvables() A test script is in providers.pl. --- bindings/perl/tests/providers.pl | 128 +++++++++++++++++++++++++++++++++++++++ bindings/pool.i | 71 +++++++++++++++++++++ bindings/repo.i | 49 ++++++++++++++ bindings/solvable.i | 14 ++++ 4 files changed, 262 insertions(+) Index: bindings/perl/tests/providers.pl =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 +++ bindings/perl/tests/providers.pl 2008-11-11 18:13:30.000000000 +0100 @@ -0,0 +1,128 @@ +#!/usr/bin/perl + +use lib '../../build/bindings/perl'; + +use satsolver; + +# Get system architecture +my $sysarch = `uname -m`; +chomp $sysarch; + +# Open Solvable file +# open(F, "gzip -cd tmp/primary.gz |") || die; + +# Create Pool and Repository +my $pool = new satsolver::Pool; +$pool->set_arch( $sysarch ); +my $installed = $pool->create_repo('installed') || die; + +# Add Solvable to Repository +#$installed->add_solv ("tmp/primary"); +#$installed->add_solv("/var/cache/zypp/solv/\@System/solv"); +$installed->add_rpmdb("/"); +# close(F) || die; + +# Create more Repositories and Add a Solvable to each +my @repos = (); +while (</var/cache/zypp/solv/*/solv>) { + m{^/.*/(.*?)/solv$}; + my $rn = $1; + next if $rn =~ m{\@System}; # skip solvable mirroring the RPM DB + + push @repos, $pool->create_repo($rn) || die; + $repos[$#repos]->add_solv($_); + print "added repo $rn from $_\n"; +} + +# Create dependencies to provides table +$pool->prepare(); + +# Print how much we have +print "\"" . $installed->name() . "\" size: " . $installed->size() . "\n"; +foreach my $r (@repos) { + my $rn = $r->name(); + print "\"$rn\" size: " . $r->size() . "\n"; +} + +# Find a Solvable in the Repo +my $solvname = "aaa_base"; +my $mysolvable = $installed->find($solvname); +die "could not find $solvname" if not defined $mysolvable; + +# Create a Relation +my $rel = $pool->create_relation($mysolvable->name()); + +# Find Providers of Relation $rel +$solvname = $mysolvable->name() . "-" . + $mysolvable->evr() . "." . + $mysolvable->arch(); +print "\n(1/3) Finding repo for solvable $solvname ...\n"; +foreach my $solvable ($pool->providers($rel)) { + print "--\n"; + next if not defined $solvable; + + my $name = $solvable->name(); + next if not defined $name; + print " solvable name: $name\n"; + + my $reponame = $solvable->repo()->name(); + next if not defined $reponame; + print " checking in repo $reponame\n"; + + if ($solvable->identical($mysolvable)) { + print " found in repo $reponame\n"; +# last; + } +} + +# Find Providers of Solvables identified by a name only +$solvname = "perl"; +print "\n(2/3) Finding repo for solvable $solvname\n"; +foreach my $solvable ($pool->providers($solvname)) { + print "--\n"; + next if not defined $solvable; + + my $name = $solvable->name(); + next if not defined $name; + print " solvable name: $name\n"; + + my $reponame = $solvable->repo()->name(); + next if not defined $reponame; + + print " found in repo $reponame\n"; +} + +# Find Providers of all installed Solvables +print "\n(3/3) Finding repo for installed solvables\n"; +foreach my $inst_solvable ($installed->solvables()) { +# print "--\n"; + next if not defined $inst_solvable->name(); + + $solvname = $inst_solvable->name(); +# print "\n finding repo for installed solvable $solvname\n"; + foreach my $solvable ($pool->providers($solvname)) { +# print "----\n"; + next if not defined $solvable; + + $name = $solvable->name(); + my $evr = $solvable->evr(); + my $arch = $solvable->arch(); + next if not defined $name; +# print " solvable name: $name\n"; + + my $reponame = $solvable->repo()->name(); + next if not defined $reponame; + + # do not print matches on the 'installed' repo if we have + # at least two other repos set up + next if $#repos >= 1 and $reponame eq "installed"; +# print " checking in repo $reponame\n"; + + if ($solvable->identical($inst_solvable)) { +# print " found in repo $reponame\n"; + printf("%-55s %s\n", "$name-$evr.$arch:", $reponame); +# last; + } + } +} + Index: bindings/pool.i =================================================================== --- bindings/pool.i.orig 2008-11-10 20:25:36.000000000 +0100 +++ bindings/pool.i 2008-11-10 21:51:58.000000000 +0100 @@ -202,6 +202,77 @@ typedef struct _Pool {} Pool; } #endif +#if defined(SWIGPERL) + %typemap(out) XSolvable ** { + int n, i; + + for (n = 0; $source[n];) + n++; + + if (n > items) + EXTEND(sp, n - items); + + /* + * make each array element a reference to a new hash blessed into the + * Perl class that has all the XSolvable wrapper functions; then tie this + * hash (the satsolver::Solvable object) to a new proxy/shadow object + * that is connected to the XSolvable in the C library + */ + for (i = 0; i < n; i++) { + ST(argvi) = SWIG_NewPointerObj(SWIG_as_voidptr($source[i]), SWIGTYPE_p__Solvable, SWIG_OWNER | SWIG_SHADOW); + argvi++; + } + + /* the array of pointers can be freed now */ + free($source); + } + + /* FIXME: this function should probably go into the applayer */ +%{ + XSolvable **providers_forid(Pool *pool, Id id) + { + Id *vp; + int cnt = 0, i = 0; + XSolvable **xs; + + /* make sure whatprovides has been created */ + if (pool->whatprovides == NULL) + pool_createwhatprovides(pool); + + /* allocate array for all pointers to XSolvables -- freed in the typemap */ + for (vp = pool->whatprovidesdata + pool_whatprovides(pool, id) ; *vp; vp++) + cnt++; + + xs = (XSolvable **) malloc((cnt + 1) * sizeof(XSolvable **)); + + /* + * get an XSolvable for each element of the whatprovides result -- when + * unused this is freed by the DESTROY method (after the typemap has made + * each XSolvable into a Perl tied hash) + */ + for (vp = pool->whatprovidesdata + pool_whatprovides(pool, id) ; *vp; i++, vp++) { + xs[i] = xsolvable_new(pool, *vp); + } + xs[i] = NULL; + + return xs; + } +%} + + XSolvable **providers(const char *name) + { + return providers_forid($self, str2id($self, name, 0)); + } + + XSolvable **providers(Relation *rel) + { + return providers_forid($self, rel->id); + } + + /* do not clear the typemap, we may want to use it for other XSolvable ** */ + /* %typemap(out) XSolvable **; */ +#endif + #if defined(SWIGPYTHON) int providers_count( const char *name ) Index: bindings/repo.i =================================================================== --- bindings/repo.i.orig 2008-10-24 16:11:32.000000000 +0200 +++ bindings/repo.i 2008-11-10 22:20:08.000000000 +0100 @@ -89,6 +89,55 @@ int size() XSolvable *add( XSolvable *xs ) { return xsolvable_add( $self, xs ); } +#if defined(SWIGPERL) + %typemap(out) XSolvable ** { + int n, i; + + for (n = 0; $source[n];) + n++; + + if (n > items) + EXTEND(sp, n - items); + + for (i = 0; i < n; i++) { + ST(argvi) = SWIG_NewPointerObj(SWIG_as_voidptr($source[i]), SWIGTYPE_p__Solvable, SWIG_OWNER | SWIG_SHADOW); + argvi++; + } + free($source); + } + + XSolvable ** solvables() + { + XSolvable **xs; + int cnt = 0, i = 0; + Solvable *s; + Id p; + + FOR_REPO_SOLVABLES($self, p, s) + { + if (!s) + continue; + if (!s->name) + continue; + cnt++; + } + xs = (XSolvable **) malloc((cnt + 1) * sizeof(XSolvable **)); + + FOR_REPO_SOLVABLES($self, p, s) + { + if (!s) + continue; + if (!s->name) + continue; + xs[i] = xsolvable_new($self->pool, s - $self->pool->solvables); + i++; + } + xs[i] = NULL; + + return xs; + } +#endif + #if defined(SWIGRUBY) void each() { repo_xsolvables_iterate( $self, generic_xsolvables_iterate_callback ); } Index: bindings/solvable.i =================================================================== --- bindings/solvable.i.orig 2008-11-10 20:25:36.000000000 +0100 +++ bindings/solvable.i 2008-11-11 14:36:29.000000000 +0100 @@ -93,6 +93,20 @@ typedef struct _Solvable {} XSolvable; / return i; } +#define identical_func(name) \ + int name( XSolvable *xs ) \ + { \ + if ($self->pool != xs->pool) \ + return 0; \ + \ + return solvable_identical($self->pool, \ + xsolvable_solvable($self), xsolvable_solvable(xs)); \ + } +#if defined(SWIGPERL) + identical_func(__eq__) +#endif + identical_func(identical) + /* * Dependencies */ -- Olaf Dabrunz (od/odabrunz) SUSE LINUX Products GmbH, GF: Markus Rex, HRB 16746 (AG Nürnberg) -- To unsubscribe, e-mail: zypp-devel+unsubscribe@opensuse.org For additional commands, e-mail: zypp-devel+help@opensuse.org
participants (1)
-
Olaf Dabrunz