package option for perl5

git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@10393 626c5289-ae23-0410-ae9c-e8d60b6d4f22

Doc/Manual/Perl5.html

@@ -1298,6 +1298,34 @@ nested namespace simply provide the fully qualified name in your
 <b>NOTE:</b> the double quotes are necessary.
 </p>
 
+<p>
+      Using the <tt>package</tt> option of the <tt>%module</tt> directive allows
+      you to specify what Perl namespace that the module will be living in when
+      installed.  This is useful in the situation where a module maintainer
+      wants to split a large module into smaller pieces to make maintenance
+      easier, but doesn't want to have that affect the module name used by
+      applications. So for example, if I wanted to split <tt>XML::Xerces</tt>
+      into <tt>XML::Xerces::SAX</tt>, etc. , but I wanted all the applications
+      to be able to access the classes using the <tt>XML::Xerces</tt> namespace
+      I could use:
+
+</p>
+
+<div class="code">
+<pre>
+%module(package="XML::Xerces") "XML::Xerces::SAX
+</pre>
+</div>
+
+<p>
+      And now all the applications could use the class
+      <tt>XML::Xerces::SAXParser</tt>. Without the <tt>package</tt> directive
+      splitting the module would force applications to use the class
+      <tt>XML::Xerces::SAX::SAXParser</tt>. This could break compatibility for
+      existing applications that are already using the class under the name
+      <tt>XML::Xerces::SAXParser</tt>.
+    </p>
+
 <!--
 <p>
 This can be changed by giving SWIG the -package

Examples/test-suite/common.mk

@@ -422,6 +422,7 @@ C_TEST_CASES += \
 MULTI_CPP_TEST_CASES += \
 	clientdata_prop \
 	imports \
+	package \
 	mod \
 	template_typedef_import \
 	multi_import

Examples/test-suite/package.h

@@ -0,0 +1,5 @@
+class A
+{
+ public:
+  int testInt() { return 2;}
+};

Examples/test-suite/package.list

@@ -0,0 +1,2 @@
+package_a
+package_b

Examples/test-suite/package_a.i

@@ -0,0 +1,10 @@
+%module(package="C") "package_a";
+
+%inline %{
+class A
+{
+ public:
+  int testInt() { return 2;}
+};
+
+%}

Examples/test-suite/package_b.i

@@ -0,0 +1,10 @@
+%module(package="C") "package_b";
+
+%inline %{
+class B
+{
+ public:
+  int testInt() { return 4; }
+};
+
+%}

Examples/test-suite/perl5/README

@@ -12,4 +12,6 @@ adding a new test to this suite, please use Test::More.
 Currently converted test cases include:
 
 * operator_overload
+* operator_overload_break
+* package
 * overload_simple

Examples/test-suite/perl5/package_runme.pl

@@ -0,0 +1,24 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More tests => 4;
+
+BEGIN { use_ok('package_a'); }
+BEGIN { use_ok('package_b'); }
+
+# Workaround for 
+#   ok( not (expression) , "test description" );
+# does not working in older versions of Perl, eg 5.004_04
+sub ok_not ($;$) {
+    my($test, $name) = @_;
+    $test = not $test;
+    ok($test, $name);
+}
+
+my $a = C::A->new();
+
+isa_ok($a, 'C::A');
+
+my $b = C::B->new();
+
+isa_ok($b, 'C::B');
+       

Source/Modules/perl5.cxx

@@ -45,17 +45,21 @@ static String *pmfile = 0;
 /*
  * module
  *   set by the %module directive, e.g. "Xerces". It will determine
- *   the name of the .pm file, and the dynamic library.
+ *   the name of the .pm file, and the dynamic library, and the name
+ *   used by any module wanting to %import the module.
  */
 static String *module = 0;
 
 /*
- * fullmodule
+ * namespace_module
- *   the fully namespace qualified name of the module, e.g. "XML::Xerces"
+ *   the fully namespace qualified name of the module. It will be used
- *   it will be used to set the package namespace in the .pm file, as
+ *   to set the package namespace in the .pm file, as well as the name
- *   well as the name of the initialization methods in the glue library
+ *   of the initialization methods in the glue library. This will be
+ *   the same as module, above, unless the %module directive is given
+ *   the 'package' option, e.g. %module(package="Foo::Bar") "baz"
  */
-static String *fullmodule = 0;
+static String       *namespace_module = 0;
+
 /*
  * cmodule
  *   the namespace of the internal glue code, set to the value of
@@ -63,6 +67,13 @@ static String *fullmodule = 0;
  */
 static String *cmodule = 0;
 
+/*
+ * dest_package
+ *   an optional namespace to put all classes into. Specified by using
+ *   the %module(package="Foo::Bar") "baz" syntax
+ */
+static String       *dest_package = 0;
+
 static String *command_tab = 0;
 static String *constant_tab = 0;
 static String *variable_tab = 0;
@@ -77,6 +88,9 @@ static String *magic;		/* Magic variable wrappers     */
 
 static int staticoption = 0;
 
+// controlling verbose output
+static int          verbose = 0;
+
 /* The following variables are used to manage Perl5 classes */
 
 static int blessed = 1;		/* Enable object oriented features */
@@ -170,6 +184,9 @@ public:
 	  i++;
 	  pmfile = NewString(argv[i]);
 	  Swig_mark_arg(i);
+	} else if (strcmp(argv[i],"-v") == 0) {
+	    Swig_mark_arg(i);
+	    verbose++;
 	} else if (strcmp(argv[i], "-cppcast") == 0) {
 	  cppcast = 1;
 	  Swig_mark_arg(i);
@@ -241,16 +258,43 @@ public:
     Printf(f_runtime, "#define SWIG_CASTRANK_MODE\n");
 
 
+    // Is the imported module in another package?  (IOW, does it use the
+    // %module(package="name") option and it's different than the package
+    // of this module.)
+    Node *mod = Getattr(n, "module");
+    Node *options = Getattr(mod, "options");
     module = Copy(Getattr(n,"name"));
 
+    if (verbose > 0) {
+      fprintf(stdout, "top: using module: %s\n", Char(module));
+    }
+
+    dest_package = options ? Getattr(options, "package") : 0;
+    if (dest_package) {
+      namespace_module = Copy(dest_package);
+      if (verbose > 0) {
+	fprintf(stdout, "top: Found package: %s\n",Char(dest_package));
+      }
+    } else {
+      namespace_module = Copy(module);
+      if (verbose > 0) {
+	fprintf(stdout, "top: No package found\n");
+      }
+    }
+    String *underscore_module = Copy(module);
+    Replaceall(underscore_module,":","_");
+
+    if (verbose > 0) {
+      fprintf(stdout, "top: using namespace_module: %s\n", Char(namespace_module));
+    }
+
     /* If we're in blessed mode, change the package name to "packagec" */
 
     if (blessed) {
-      cmodule = NewStringf("%sc", module);
+      cmodule = NewStringf("%sc",namespace_module);
     } else {
-      cmodule = NewString(module);
+      cmodule = NewString(namespace_module);
     }
-    fullmodule = NewString(module);
 
     /* Create a .pm file
      * Need to strip off any prefixes that might be found in
@@ -281,12 +325,11 @@ public:
       Swig_register_filebyname("perl", f_pm);
     }
     {
-      String *tmp = NewString(fullmodule);
+      String *boot_name = NewStringf("boot_%s", underscore_module);
-      Replaceall(tmp, ":", "_");
+      Printf(f_header,"#define SWIG_init    %s\n\n", boot_name);
-      Printf(f_header, "#define SWIG_init    boot_%s\n\n", tmp);
+      Printf(f_header,"#define SWIG_name   \"%s::%s\"\n", cmodule, boot_name);
-      Printf(f_header, "#define SWIG_name   \"%s::boot_%s\"\n", cmodule, tmp);
       Printf(f_header,"#define SWIG_prefix \"%s::\"\n", cmodule);
-      Delete(tmp);
+      Delete(boot_name);
     }
 
     Printf(f_pm, "# This file was automatically generated by SWIG (http://www.swig.org).\n");
@@ -295,14 +338,20 @@ public:
     Printf(f_pm, "# Don't modify this file, modify the SWIG interface instead.\n");
     Printf(f_pm, "\n");
 
-    Printf(f_pm, "package %s;\n", fullmodule);
+    Printf(f_pm, "package %s;\n", module);
 
-    Printf(f_pm, "require Exporter;\n");
+    /* 
-    if (!staticoption) {
+     * If the package option has been given we are placing our
-      Printf(f_pm, "require DynaLoader;\n");
+     *   symbols into some other packages namespace, so we do not
-      Printf(f_pm, "@ISA = qw(Exporter DynaLoader);\n");
+     *   mess with @ISA or require for that package
+     */
+    if (dest_package) {
+      Printf(f_pm,"use base qw(DynaLoader);\n");
     } else {
-      Printf(f_pm, "@ISA = qw(Exporter);\n");
+      Printf(f_pm,"use base qw(Exporter);\n");
+      if (!staticoption) {
+	Printf(f_pm,"use base qw(DynaLoader);\n");
+      }
     }
 
     /* Start creating magic code */
@@ -310,8 +359,8 @@ public:
     Printv(magic,
            "#ifdef __cplusplus\nextern \"C\" {\n#endif\n\n",
 	   "#ifdef PERL_OBJECT\n",
-	   "#define MAGIC_CLASS _wrap_", module, "_var::\n",
+	   "#define MAGIC_CLASS _wrap_", underscore_module, "_var::\n",
-	   "class _wrap_", module, "_var : public CPerlObj {\n",
+	   "class _wrap_", underscore_module, "_var : public CPerlObj {\n",
 	   "public:\n",
 	   "#else\n",
 	   "#define MAGIC_CLASS\n",
@@ -379,20 +428,32 @@ public:
     Printf(f_pm, "package %s;\n", cmodule);
 
     if (!staticoption) {
-      Printf(f_pm, "bootstrap %s;\n", fullmodule);
+      Printf(f_pm,"bootstrap %s;\n", module);
     } else {
-      String *tmp = NewString(fullmodule);
+      Printf(f_pm,"package %s;\n", cmodule);
-      Replaceall(tmp, ":", "_");
+      Printf(f_pm,"boot_%s();\n", underscore_module);
-      Printf(f_pm, "boot_%s();\n", tmp);
-      Delete(tmp);
     }
-    Printf(f_pm, "package %s;\n", fullmodule);
+
+    Printf(f_pm, "package %s;\n", module);
+    /* 
+     * If the package option has been given we are placing our
+     *   symbols into some other packages namespace, so we do not
+     *   mess with @EXPORT
+     */
+    if (!dest_package) {
       Printf(f_pm,"@EXPORT = qw(%s);\n", exported);
+    }
+
     Printf(f_pm, "%s", pragma_include);
 
     if (blessed) {
 
-      Printv(base, "\n# ---------- BASE METHODS -------------\n\n", "package ", fullmodule, ";\n\n", NIL);
+      /*
+       * These methods will be duplicated if package 
+       *   has been specified, so we do not output them
+       */
+      if (!dest_package) {
+	Printv(base, "\n# ---------- BASE METHODS -------------\n\n", "package ", namespace_module, ";\n\n", NIL);
 
 	/* Write out the TIE method */
 
@@ -428,11 +489,11 @@ public:
 	Printv(base, "sub this {\n", tab4, "my $ptr = shift;\n", tab4, "return tied(%$ptr);\n", "}\n\n", NIL);
 
 	Printf(f_pm, "%s", base);
+      }
 
       /* Emit function stubs for stand-alone functions */
-
       Printf(f_pm, "\n# ------- FUNCTION WRAPPERS --------\n\n");
-      Printf(f_pm, "package %s;\n\n", fullmodule);
+      Printf(f_pm, "package %s;\n\n", namespace_module);
       Printf(f_pm, "%s", func_stubs);
 
       /* Emit package code for different classes */
@@ -441,14 +502,14 @@ public:
       if (num_consts > 0) {
 	/* Emit constant stubs */
 	Printf(f_pm, "\n# ------- CONSTANT STUBS -------\n\n");
-	Printf(f_pm, "package %s;\n\n", fullmodule);
+	Printf(f_pm, "package %s;\n\n", namespace_module);
 	Printf(f_pm, "%s", const_stubs);
       }
 
       /* Emit variable stubs */
 
       Printf(f_pm, "\n# ------- VARIABLE STUBS --------\n\n");
-      Printf(f_pm, "package %s;\n\n", fullmodule);
+      Printf(f_pm, "package %s;\n\n", namespace_module);
       Printf(f_pm, "%s", var_stubs);
     }
 
@@ -459,6 +520,8 @@ public:
     Close(f_pm);
     Delete(f_pm);
     Delete(base);
+    Delete(dest_package);
+    Delete(underscore_module);
 
     /* Close all of the files */
     Dump(f_header, f_runtime);
@@ -1075,12 +1138,29 @@ public:
     }
 
     /* Do some work on the class name */
+    if (verbose > 0) {
+      fprintf(stdout, "setclassname: Found sym:name: %s\n", Char(symname));
+      fprintf(stdout, "setclassname: Found module: %s\n", Char(clsmodule));
+      fprintf(stdout, "setclassname: No package found\n");
+    }
+
+    if (dest_package) {
+      fullname = NewStringf("%s::%s", namespace_module, symname);
+    } else {
       actualpackage = Getattr(clsmodule,"name");
+
+      if (verbose > 0) {
+	fprintf(stdout, "setclassname: Found actualpackage: %s\n", Char(actualpackage));
+      }
       if ((!compat) && (!Strchr(symname,':'))) {
 	fullname = NewStringf("%s::%s",actualpackage,symname);
       } else {
 	fullname = NewString(symname);
       }
+    }
+    if (verbose > 0) {
+      fprintf(stdout, "setclassname: setting proxy: %s\n", Char(fullname));
+    }
     Setattr(n, "perl5:proxy", fullname);
   }
 
@@ -1119,7 +1199,7 @@ public:
 
       /* Use the fully qualified name of the Perl class */
       if (!compat) {
-	fullclassname = NewStringf("%s::%s", fullmodule, class_name);
+	fullclassname = NewStringf("%s::%s", namespace_module, class_name);
       } else {
 	fullclassname = NewString(class_name);
       }
@@ -1232,8 +1312,8 @@ public:
       }
 
       /* Module comes last */
-      if (!compat || Cmp(fullmodule, fullclassname)) {
+      if (!compat || Cmp(namespace_module, fullclassname)) {
-	Printv(pm, " ", fullmodule, NIL);
+	Printv(pm, " ", namespace_module, NIL);
       }
 
       Printf(pm, " );\n");