[zypp-devel] [PATCH] re-submit: add missing libsatsolver Perl bindings

11 Nov 2008

This re-sumission removed the operator overloading for "==" (et al),
after consulting with Michael Schroeder.

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)

  - 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              |    9 ++
 4 files changed, 257 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 () {
+  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 20:04:15.000000000 +0100
@@ -93,6 +93,15 @@ typedef struct _Solvable {} XSolvable; /
     return i;
   }
 
+  int identical( XSolvable *xs )
+  {
+    if ($self->pool != xs->pool)
+      return 0;
+
+    return solvable_identical($self->pool,
+                    xsolvable_solvable($self), xsolvable_solvable(xs));
+  }
+
   /*
    * 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

    