PageRenderTime 87ms CodeModel.GetById 15ms app.highlight 61ms RepoModel.GetById 0ms app.codeStats 0ms

/tags/rel-1-3-24/SWIG/Source/Modules/perl5.cxx

#
C++ | 1541 lines | 1068 code | 232 blank | 241 comment | 242 complexity | c01155f1158bf9ced2d89b968b62127e MD5 | raw file
Possible License(s): LGPL-2.1, Cube, GPL-3.0, 0BSD, GPL-2.0
   1/* ----------------------------------------------------------------------------
   2 * perl5.cxx
   3 *
   4 *     Generate Perl5 wrappers
   5 *
   6 * Author(s) : David Beazley (beazley@cs.uchicago.edu)
   7 *             Loic Dachary (loic@ceic.com)
   8 *             David Fletcher
   9 *             Gary Holt
  10 *             Jason Stewart (jason@openinformatics.com)
  11 *
  12 * Copyright (C) 1999-2000.  The University of Chicago
  13 * See the file LICENSE for information on usage and redistribution.
  14 * ------------------------------------------------------------------------- */
  15
  16char cvsroot_perl5_cxx[] = "$Header$";
  17
  18#include "swigmod.h"
  19
  20#include <ctype.h>
  21
  22static const char *usage = (char*)"\
  23Perl5 Options (available with -perl5)\n\
  24     -static         - Omit code related to dynamic loading\n\
  25     -nopm           - Do not generate the .pm file\n\
  26     -proxy          - Create proxy classes\n\
  27     -noproxy        - Don't create proxy classes\n\
  28     -const          - Wrap constants as constants and not variables (implies -proxy)\n\
  29     -compat         - Compatibility mode\n\n";
  30
  31static int     compat = 0;
  32
  33static int     no_pmfile = 0;
  34
  35static int     export_all = 0;
  36
  37/*
  38 * pmfile
  39 *   set by the -pm flag, overrides the name of the .pm file
  40 */
  41static String *pmfile = 0;
  42
  43/*
  44 * module
  45 *   set by the %module directive, e.g. "Xerces". It will determine
  46 *   the name of the .pm file, and the dynamic library.
  47 */
  48static String       *module = 0;
  49
  50/*
  51 * fullmodule
  52 *   the fully namespace qualified name of the module, e.g. "XML::Xerces"
  53 *   it will be used to set the package namespace in the .pm file, as
  54 *   well as the name of the initialization methods in the glue library
  55 */
  56static String       *fullmodule = 0;
  57/*
  58 * cmodule
  59 *   the namespace of the internal glue code, set to the value of
  60 *   module with a 'c' appended
  61 */
  62static String       *cmodule = 0; 
  63
  64static String       *command_tab = 0;
  65static String       *constant_tab = 0;
  66static String       *variable_tab = 0;
  67
  68static File        *f_runtime = 0;
  69static File        *f_header = 0;
  70static File        *f_wrappers = 0;
  71static File        *f_init = 0;
  72static File        *f_pm = 0;
  73static String       *pm;                   /* Package initialization code */
  74static String       *magic;                /* Magic variable wrappers     */
  75
  76static int          is_static = 0;
  77
  78/* The following variables are used to manage Perl5 classes */
  79
  80static  int        blessed = 1;                /* Enable object oriented features */
  81static  int        do_constants = 0;           /* Constant wrapping */
  82static  List       *classlist = 0;             /* List of classes */
  83static  int        have_constructor = 0;
  84static  int        have_destructor= 0;
  85static  int        have_data_members = 0;
  86static  String    *class_name = 0;            /* Name of the class (what Perl thinks it is) */
  87static  String    *real_classname = 0;        /* Real name of C/C++ class */
  88static  String   *fullclassname = 0;
  89
  90static  String   *pcode = 0;                 /* Perl code associated with each class */
  91/* static  String   *blessedmembers = 0;     */   /* Member data associated with each class */
  92static  int      member_func = 0;            /* Set to 1 when wrapping a member function */
  93static  String   *func_stubs = 0;            /* Function stubs */
  94static  String   *const_stubs = 0;           /* Constant stubs */
  95static  int       num_consts = 0;            /* Number of constants */
  96static  String   *var_stubs = 0;             /* Variable stubs */
  97static  String   *exported = 0;              /* Exported symbols */
  98static  String   *pragma_include = 0;
  99static  String   *additional_perl_code = 0;  /* Additional Perl code from %perlcode %{ ... %} */
 100static  Hash     *operators = 0;
 101static  int       have_operators = 0;
 102
 103class PERL5 : public Language {
 104public:
 105
 106  /* Test to see if a type corresponds to something wrapped with a shadow class */
 107  Node *is_shadow(SwigType *t) {
 108    Node *n;
 109    n = classLookup(t);
 110    /*  Printf(stdout,"'%s' --> '%x'\n", t, n); */
 111    if (n) {
 112      if (!Getattr(n,"perl5:proxy")) {
 113	setclassname(n);
 114      }
 115      return Getattr(n,"perl5:proxy");
 116    }
 117    return 0;
 118  }
 119
 120  /* ------------------------------------------------------------
 121   * main()
 122   * ------------------------------------------------------------ */
 123
 124  virtual void main(int argc, char *argv[]) {
 125    int i = 1;
 126
 127    SWIG_library_directory("perl5");
 128    for (i = 1; i < argc; i++) {
 129      if (argv[i]) {
 130	if(strcmp(argv[i],"-package") == 0) {
 131	  Printf(stderr,"*** -package is no longer supported\n*** use the directive '%module A::B::C' in your interface file instead\n*** see the Perl section in the manual for details.\n");
 132	  SWIG_exit(EXIT_FAILURE);
 133	} else if(strcmp(argv[i],"-interface") == 0) {
 134	  Printf(stderr,"*** -interface is no longer supported\n*** use the directive '%module A::B::C' in your interface file instead\n*** see the Perl section in the manual for details.\n");
 135	  SWIG_exit(EXIT_FAILURE);
 136	} else if (strcmp(argv[i],"-exportall") == 0) {
 137	  export_all = 1;
 138	  Swig_mark_arg(i);
 139	} else if (strcmp(argv[i],"-static") == 0) {
 140	  is_static = 1;
 141	  Swig_mark_arg(i);
 142	} else if ((strcmp(argv[i],"-shadow") == 0) || ((strcmp(argv[i],"-proxy") == 0))) {
 143	  blessed = 1;
 144	  Swig_mark_arg(i);
 145	} else if ((strcmp(argv[i],"-noproxy") == 0)) {
 146	  blessed =0;
 147	  Swig_mark_arg(i);
 148	} else if (strcmp(argv[i],"-const") == 0) {
 149	  do_constants = 1;
 150	  blessed = 1;
 151	  Swig_mark_arg(i);
 152	} else if (strcmp(argv[i],"-nopm") == 0) {
 153	    no_pmfile = 1;
 154	    Swig_mark_arg(i);
 155	} else if (strcmp(argv[i],"-pm") == 0) {
 156	    Swig_mark_arg(i);
 157	    i++;
 158	    pmfile = NewString(argv[i]);
 159	    Swig_mark_arg(i);
 160	} else if (strcmp(argv[i],"-compat") == 0) {
 161	  compat = 1;
 162	  Swig_mark_arg(i);
 163	} else if (strcmp(argv[i],"-help") == 0) {
 164	  fputs(usage,stderr);
 165	}
 166      }
 167    }
 168
 169    Preprocessor_define("SWIGPERL 1", 0);
 170    Preprocessor_define("SWIGPERL5 1", 0);
 171    SWIG_typemap_lang("perl5");
 172    SWIG_config_file("perl5.swg");
 173    allow_overloading();
 174  }
 175
 176  /* ------------------------------------------------------------
 177   * top()
 178   * ------------------------------------------------------------ */
 179
 180  virtual int top(Node *n) {
 181
 182    /* Initialize all of the output files */
 183    String *outfile = Getattr(n,"outfile");
 184
 185    f_runtime = NewFile(outfile,"w");
 186    if (!f_runtime) {
 187      Printf(stderr,"*** Can't open '%s'\n", outfile);
 188      SWIG_exit(EXIT_FAILURE);
 189    }
 190    f_init = NewString("");
 191    f_header = NewString("");
 192    f_wrappers = NewString("");
 193
 194  /* Register file targets with the SWIG file handler */
 195    Swig_register_filebyname("header",f_header);
 196    Swig_register_filebyname("wrapper",f_wrappers);
 197    Swig_register_filebyname("runtime",f_runtime);
 198    Swig_register_filebyname("init",f_init);
 199
 200    classlist = NewList();
 201
 202    pm             = NewString("");
 203    func_stubs     = NewString("");
 204    var_stubs      = NewString("");
 205    const_stubs    = NewString("");
 206    exported       = NewString("");
 207    magic          = NewString("");
 208    pragma_include = NewString("");
 209    additional_perl_code = NewString("");
 210
 211    command_tab    = NewString("static swig_command_info swig_commands[] = {\n");
 212    constant_tab   = NewString("static swig_constant_info swig_constants[] = {\n");
 213    variable_tab   = NewString("static swig_variable_info swig_variables[] = {\n");
 214
 215    Swig_banner(f_runtime);
 216  
 217    module = Copy(Getattr(n,"name"));
 218
 219  /* If we're in blessed mode, change the package name to "packagec" */
 220
 221    if (blessed) {
 222      cmodule = NewStringf("%sc",module);
 223    } else {
 224      cmodule = NewString(module);
 225    }
 226    fullmodule = NewString(module);
 227
 228  /* Create a .pm file
 229   * Need to strip off any prefixes that might be found in
 230   * the module name */
 231
 232    if (no_pmfile) {
 233      f_pm = NewString(0);
 234    } else {
 235      if (pmfile == NULL) {
 236	char *m = Char(module) + Len(module);
 237	while (m != Char(module)) {
 238	  if (*m == ':') {
 239	    m++;
 240	    break;
 241	  }
 242	  m--;
 243	}
 244	pmfile = NewStringf("%s.pm", m);
 245      }
 246      String *filen = NewStringf("%s%s", SWIG_output_directory(),pmfile);
 247      if ((f_pm = NewFile(filen,"w")) == 0) {
 248	Printf(stderr,"Unable to open %s\n", filen);
 249	SWIG_exit (EXIT_FAILURE);
 250      }
 251      Delete(filen); filen = NULL;
 252      Swig_register_filebyname("pm",f_pm);
 253      Swig_register_filebyname("perl",f_pm);
 254    }
 255    {
 256      String *tmp = NewString(fullmodule);
 257      Replaceall(tmp,":","_");
 258      Printf(f_header,"#define SWIG_init    boot_%s\n\n", tmp);
 259      Printf(f_header,"#define SWIG_name   \"%s::boot_%s\"\n", cmodule, tmp);
 260      Printf(f_header,"#define SWIG_prefix \"%s::\"\n", cmodule);
 261      Delete(tmp);
 262    }
 263
 264    Printf(f_pm,"# This file was automatically generated by SWIG\n");
 265    Printf(f_pm,"package %s;\n",fullmodule);
 266
 267    Printf(f_pm,"require Exporter;\n");
 268    if (!is_static) {
 269      Printf(f_pm,"require DynaLoader;\n");
 270      Printf(f_pm,"@ISA = qw(Exporter DynaLoader);\n");
 271    } else {
 272      Printf(f_pm,"@ISA = qw(Exporter);\n");
 273    }
 274
 275    /* Start creating magic code */
 276
 277    Printv(magic,
 278	   "#ifdef PERL_OBJECT\n",
 279	   "#define MAGIC_CLASS _wrap_", module, "_var::\n",
 280	   "class _wrap_", module, "_var : public CPerlObj {\n",
 281	   "public:\n",
 282	   "#else\n",
 283	   "#define MAGIC_CLASS\n",
 284	   "#endif\n",
 285	   "SWIGCLASS_STATIC int swig_magic_readonly(pTHX_ SV *sv, MAGIC *mg) {\n",
 286	   tab4, "MAGIC_PPERL\n",
 287	   tab4, "sv = sv; mg = mg;\n",
 288	   tab4, "croak(\"Value is read-only.\");\n",
 289	   tab4, "return 0;\n",
 290	   "}\n",
 291	   NIL);
 292
 293    Printf(f_wrappers,"#ifdef __cplusplus\nextern \"C\" {\n#endif\n");
 294
 295  /* emit wrappers */
 296    Language::top(n);
 297
 298    String *base = NewString("");
 299  
 300  /* Dump out variable wrappers */
 301
 302    Printv(magic,
 303	   "\n\n#ifdef PERL_OBJECT\n",
 304	   "};\n",
 305	   "#endif\n",
 306	   NIL);
 307
 308    Printf(f_header,"%s\n", magic);
 309
 310    String *type_table = NewString("");
 311    SwigType_emit_type_table(f_runtime,type_table);
 312
 313  /* Patch the type table to reflect the names used by shadow classes */
 314    if (blessed) {
 315      Iterator  cls;
 316      for (cls = First(classlist); cls.item; cls = Next(cls)) {
 317	if (Getattr(cls.item,"perl5:proxy")) {
 318	  SwigType *type = Copy(Getattr(cls.item,"classtype"));
 319
 320	  if (!type) continue;   /* If unnamed class, no type will be found */
 321
 322	  SwigType_add_pointer(type);
 323	  String *mangle = NewStringf("\"%s\"", SwigType_manglestr(type));
 324	  String *rep = NewStringf("\"%s\"", Getattr(cls.item,"perl5:proxy"));
 325	  Replaceall(type_table,mangle,rep);
 326	  Delete(mangle);
 327	  Delete(rep);
 328	  Delete(type);
 329	}
 330      }
 331    }
 332
 333    Printf(f_wrappers,"%s",type_table);
 334    Delete(type_table);
 335
 336    Printf(constant_tab,"{0,0,0,0,0,0}\n};\n");
 337    Printv(f_wrappers,constant_tab,NIL);
 338
 339    Printf(f_wrappers,"#ifdef __cplusplus\n}\n#endif\n");
 340
 341    Printf(f_init,"\t ST(0) = &PL_sv_yes;\n");
 342    Printf(f_init,"\t XSRETURN(1);\n");
 343    Printf(f_init,"}\n");
 344
 345    /* Finish off tables */
 346    Printf(variable_tab, "{0,0,0,0}\n};\n");
 347    Printv(f_wrappers,variable_tab,NIL);
 348
 349    Printf(command_tab,"{0,0}\n};\n");
 350    Printv(f_wrappers,command_tab,NIL);
 351
 352
 353    Printf(f_pm,"package %s;\n", cmodule);
 354
 355    if (!is_static) {
 356      Printf(f_pm,"bootstrap %s;\n", fullmodule);
 357    } else {
 358      String *tmp = NewString(fullmodule);
 359      Replaceall(tmp,":","_");
 360      Printf(f_pm,"boot_%s();\n", tmp);
 361      Delete(tmp);
 362    }
 363    Printf(f_pm,"package %s;\n", fullmodule);
 364    Printf(f_pm,"@EXPORT = qw( %s);\n",exported);
 365    Printf(f_pm,"%s",pragma_include);
 366
 367    if (blessed) {
 368
 369      Printv(base,
 370	     "\n# ---------- BASE METHODS -------------\n\n",
 371	     "package ", fullmodule, ";\n\n",
 372	     NIL);
 373
 374      /* Write out the TIE method */
 375
 376      Printv(base,
 377	     "sub TIEHASH {\n",
 378	     tab4, "my ($classname,$obj) = @_;\n",
 379	     tab4, "return bless $obj, $classname;\n",
 380	     "}\n\n",
 381	     NIL);
 382
 383      /* Output a CLEAR method.   This is just a place-holder, but by providing it we
 384       * can make declarations such as
 385       *     %$u = ( x => 2, y=>3, z =>4 );
 386       *
 387       * Where x,y,z are the members of some C/C++ object. */
 388
 389      Printf(base,"sub CLEAR { }\n\n");
 390
 391      /* Output default firstkey/nextkey methods */
 392
 393      Printf(base, "sub FIRSTKEY { }\n\n");
 394      Printf(base, "sub NEXTKEY { }\n\n");
 395
 396      /* Output a FETCH method.  This is actually common to all classes */
 397      Printv(base,
 398	     "sub FETCH {\n",
 399	     tab4, "my ($self,$field) = @_;\n",
 400	     tab4, "my $member_func = \"swig_${field}_get\";\n",
 401	     tab4, "$self->$member_func();\n",
 402	     "}\n\n",
 403	     NIL);
 404
 405      /* Output a STORE method.   This is also common to all classes (might move to base class) */
 406
 407      Printv(base,
 408	     "sub STORE {\n",
 409	     tab4, "my ($self,$field,$newval) = @_;\n",
 410	     tab4, "my $member_func = \"swig_${field}_set\";\n",
 411	     tab4, "$self->$member_func($newval);\n",
 412	     "}\n\n",
 413	     NIL);
 414
 415      /* Output a 'this' method */
 416
 417      Printv(base,
 418	     "sub this {\n",
 419	     tab4, "my $ptr = shift;\n",
 420	     tab4, "return tied(%$ptr);\n",
 421	     "}\n\n",
 422	     NIL);
 423
 424      Printf(f_pm,"%s",base);
 425
 426      /* Emit function stubs for stand-alone functions */
 427
 428      Printf(f_pm,"\n# ------- FUNCTION WRAPPERS --------\n\n");
 429      Printf(f_pm,"package %s;\n\n",fullmodule);
 430      Printf(f_pm,"%s",func_stubs);
 431
 432      /* Emit package code for different classes */
 433      Printf(f_pm,"%s",pm);
 434
 435      if (num_consts > 0) {
 436	/* Emit constant stubs */
 437	Printf(f_pm,"\n# ------- CONSTANT STUBS -------\n\n");
 438	Printf(f_pm,"package %s;\n\n",fullmodule);
 439	Printf(f_pm,"%s",const_stubs);
 440      }
 441
 442      /* Emit variable stubs */
 443
 444      Printf(f_pm,"\n# ------- VARIABLE STUBS --------\n\n");
 445      Printf(f_pm,"package %s;\n\n",fullmodule);
 446      Printf(f_pm,"%s",var_stubs);
 447    }
 448
 449    /* Add additional Perl code at the end */
 450    Printf(f_pm,"%s",additional_perl_code);
 451
 452    Printf(f_pm,"1;\n");
 453    Close(f_pm);
 454    Delete(f_pm);
 455    Delete(base);
 456
 457    /* Close all of the files */
 458    Dump(f_header,f_runtime);
 459    Dump(f_wrappers,f_runtime);
 460    Wrapper_pretty_print(f_init,f_runtime);
 461    Delete(f_header);
 462    Delete(f_wrappers);
 463    Delete(f_init);
 464    Close(f_runtime);
 465    Delete(f_runtime);
 466    return SWIG_OK;
 467  }
 468
 469  /* ------------------------------------------------------------
 470   * importDirective(Node *n)
 471   * ------------------------------------------------------------ */
 472
 473  virtual int importDirective(Node *n) {
 474    if (blessed) {
 475      String *modname = Getattr(n,"module");
 476      if (modname) {
 477	Printf(f_pm,"require %s;\n", modname);
 478      }
 479    }
 480    return Language::importDirective(n);
 481  }
 482
 483  /* ------------------------------------------------------------
 484   * functionWrapper()
 485   * ------------------------------------------------------------ */
 486
 487  virtual int functionWrapper(Node *n)  {
 488    String *name = Getattr(n,"name");
 489    String *iname = Getattr(n,"sym:name");
 490    SwigType *d = Getattr(n,"type");
 491    ParmList *l = Getattr(n,"parms");
 492    String   *overname = 0;
 493
 494    Parm *p;
 495    int   i;
 496    Wrapper *f;
 497    char  source[256],target[256],temp[256];
 498    String  *tm;
 499    String *cleanup, *outarg;
 500    int    num_saved = 0;
 501    int    num_arguments, num_required;
 502    int    varargs = 0;
 503
 504    if (Getattr(n,"sym:overloaded")) {
 505      overname = Getattr(n,"sym:overname");
 506    } else {
 507      if (!addSymbol(iname,n)) return SWIG_ERROR;
 508    }
 509
 510    f       = NewWrapper();
 511    cleanup = NewString("");
 512    outarg  = NewString("");
 513
 514    String *wname = Swig_name_wrapper(iname);
 515    if (overname) {
 516      Append(wname,overname);
 517    }
 518    Setattr(n,"wrap:name",wname);
 519    Printv(f->def,
 520	   "XS(", wname, ") {\n",
 521	   "{\n", /* scope to destroy C++ objects before croaking */
 522	   NIL );
 523
 524    emit_args(d, l, f);
 525    emit_attach_parmmaps(l,f);
 526    Setattr(n,"wrap:parms",l);
 527
 528    num_arguments = emit_num_arguments(l);
 529    num_required  = emit_num_required(l);
 530    varargs       = emit_isvarargs(l);
 531
 532    Wrapper_add_local(f,"argvi","int argvi = 0");
 533
 534    /* Check the number of arguments */
 535    if (!varargs) {
 536      Printf(f->code,"    if ((items < %d) || (items > %d)) {\n", num_required, num_arguments);
 537    } else {
 538      Printf(f->code,"    if (items < %d) {\n", num_required);
 539    }
 540    Printf(f->code,"        SWIG_croak(\"Usage: %s\");\n", usage_func(Char(iname),d,l));
 541    Printf(f->code,"}\n");
 542
 543    /* Write code to extract parameters. */
 544    i = 0;
 545    for (i = 0, p = l; i < num_arguments; i++) {
 546    
 547      /* Skip ignored arguments */
 548    
 549      while (checkAttribute(p,"tmap:in:numinputs","0")) {
 550	p = Getattr(p,"tmap:in:next");
 551      }
 552
 553      SwigType *pt = Getattr(p,"type");
 554      String   *ln = Getattr(p,"lname");
 555
 556      /* Produce string representation of source and target arguments */
 557      sprintf(source,"ST(%d)",i);
 558      sprintf(target,"%s", Char(ln));
 559
 560      if (i >= num_required) {
 561	Printf(f->code,"    if (items > %d) {\n", i);
 562      }
 563      if ((tm = Getattr(p,"tmap:in"))) {
 564	Replaceall(tm,"$target",target);
 565	Replaceall(tm,"$source",source);
 566	Replaceall(tm,"$input", source);
 567	Setattr(p,"emit:input",source);       /* Save input location */
 568	Printf(f->code,"%s\n",tm);
 569	p = Getattr(p,"tmap:in:next");
 570      } else {
 571	Swig_warning(WARN_TYPEMAP_IN_UNDEF, input_file, line_number,
 572		     "Unable to use type %s as a function argument.\n",SwigType_str(pt,0));
 573	p = nextSibling(p);
 574      }
 575      if (i >= num_required) {
 576	Printf(f->code,"    }\n");
 577      }
 578    }
 579
 580    if (varargs) {
 581      if (p && (tm = Getattr(p,"tmap:in"))) {
 582	sprintf(source,"ST(%d)",i);
 583	Replaceall(tm,"$input", source);
 584	Setattr(p,"emit:input", source);
 585	Printf(f->code,"if (items >= %d) {\n", i);
 586	Printv(f->code, tm, "\n", NIL);
 587	Printf(f->code,"}\n");
 588      }
 589    }
 590
 591    /* Insert constraint checking code */
 592    for (p = l; p;) {
 593      if ((tm = Getattr(p,"tmap:check"))) {
 594	Replaceall(tm,"$target",Getattr(p,"lname"));
 595	Printv(f->code,tm,"\n",NIL);
 596	p = Getattr(p,"tmap:check:next");
 597      } else {
 598	p = nextSibling(p);
 599      }
 600    }
 601  
 602    /* Insert cleanup code */
 603    for (i = 0, p = l; p; i++) {
 604      if ((tm = Getattr(p,"tmap:freearg"))) {
 605	Replaceall(tm,"$source",Getattr(p,"lname"));
 606	Replaceall(tm,"$arg",Getattr(p,"emit:input"));
 607	Replaceall(tm,"$input",Getattr(p,"emit:input"));
 608	Printv(cleanup,tm,"\n",NIL);
 609	p = Getattr(p,"tmap:freearg:next");
 610      } else {
 611	p = nextSibling(p);
 612      }
 613    }
 614
 615    /* Insert argument output code */
 616    num_saved = 0;
 617    for (i=0,p = l; p;i++) {
 618      if ((tm = Getattr(p,"tmap:argout"))) {
 619	Replaceall(tm,"$source",Getattr(p,"lname"));
 620	Replaceall(tm,"$target","ST(argvi)");
 621	Replaceall(tm,"$result","ST(argvi)");
 622	String *in = Getattr(p,"emit:input");
 623	if (in) {
 624	  sprintf(temp,"_saved[%d]", num_saved);
 625	  Replaceall(tm,"$arg",temp);
 626	  Replaceall(tm,"$input",temp);
 627	  Printf(f->code,"_saved[%d] = %s;\n", num_saved, in);
 628	  num_saved++;
 629	}
 630	Printv(outarg,tm,"\n",NIL);
 631	p = Getattr(p,"tmap:argout:next");
 632      } else {
 633	p = nextSibling(p);
 634      }
 635    }
 636
 637    /* If there were any saved arguments, emit a local variable for them */
 638    if (num_saved) {
 639      sprintf(temp,"_saved[%d]",num_saved);
 640      Wrapper_add_localv(f,"_saved","SV *",temp,NIL);
 641    }
 642
 643    /* Now write code to make the function call */
 644
 645    emit_action(n,f);
 646
 647    if ((tm = Swig_typemap_lookup_new("out",n,"result",0))) {
 648      SwigType *t = Getattr(n,"type");
 649      Replaceall(tm,"$source","result");
 650      Replaceall(tm,"$target","ST(argvi)");
 651      Replaceall(tm,"$result", "ST(argvi)");
 652      if (is_shadow(t)) {
 653	Replaceall(tm, "$shadow", "SWIG_SHADOW");
 654      } else {
 655	Replaceall(tm, "$shadow", "0");
 656      }
 657      if ((!SwigType_ispointer(t) && !SwigType_isreference(t))
 658	  || Getattr(n,"feature:new")) {
 659	Replaceall(tm,"$owner","SWIG_OWNER");
 660      } else {
 661	Replaceall(tm,"$owner","0");
 662      }
 663      Printf(f->code, "%s\n", tm);
 664    } else {
 665      Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number,
 666		   "Unable to use return type %s in function %s.\n", SwigType_str(d,0), name);
 667    }
 668
 669    /* If there were any output args, take care of them. */
 670
 671    Printv(f->code,outarg,NIL);
 672
 673    /* If there was any cleanup, do that. */
 674
 675    Printv(f->code,cleanup,NIL);
 676
 677    if (Getattr(n,"feature:new"))  {
 678      if ((tm = Swig_typemap_lookup_new("newfree",n,"result",0))) {
 679	Replaceall(tm,"$source","result");
 680	Printf(f->code,"%s\n",tm);
 681      }
 682    }
 683
 684    if ((tm = Swig_typemap_lookup_new("ret",n,"result", 0))) {
 685      Replaceall(tm,"$source","result");
 686      Printf(f->code,"%s\n", tm);
 687    }
 688
 689    Printv(f->code,
 690	   "XSRETURN(argvi);\n",
 691	   "fail:\n",
 692	   cleanup,
 693	   ";\n", /* empty statement */
 694	   "}\n",
 695	   "croak(Nullch);\n"
 696	   "}\n",
 697	   NIL);
 698	   
 699  /* Add the dXSARGS last */
 700
 701    Wrapper_add_local(f,"dXSARGS","dXSARGS");
 702
 703    /* Substitute the cleanup code */
 704    Replaceall(f->code,"$cleanup",cleanup);
 705    Replaceall(f->code,"$symname",iname);
 706
 707  /* Dump the wrapper function */
 708
 709    Wrapper_print(f,f_wrappers);
 710
 711    /* Now register the function */
 712
 713    if (!Getattr(n,"sym:overloaded")) {
 714      Printf(command_tab,"{\"%s::%s\", %s},\n", cmodule, iname, wname);
 715    } else if (!Getattr(n,"sym:nextSibling")) {
 716      /* Generate overloaded dispatch function */
 717      int maxargs, ii;
 718      String *dispatch = Swig_overload_dispatch(n,"(*PL_markstack_ptr++);SWIG_CALLXS(%s); return;",&maxargs);
 719	
 720      /* Generate a dispatch wrapper for all overloaded functions */
 721
 722      Wrapper *df       = NewWrapper();
 723      String  *dname    = Swig_name_wrapper(iname);
 724
 725      Printv(df->def,	
 726	     "XS(", dname, ") {\n", NIL);
 727    
 728      Wrapper_add_local(df,"dXSARGS", "dXSARGS");
 729      Replaceid(dispatch,"argc","items");
 730      for (ii = 0; ii < maxargs; ii++) {
 731	char pat[128];
 732	char rep[128];
 733	sprintf(pat,"argv[%d]",ii);
 734	sprintf(rep,"ST(%d)",ii);
 735	Replaceall(dispatch,pat,rep);
 736      }
 737      Printv(df->code,dispatch,"\n",NIL);
 738      Printf(df->code,"croak(\"No matching function for overloaded '%s'\");\n", iname);
 739      Printf(df->code,"XSRETURN(0);\n");
 740      Printv(df->code,"}\n",NIL);
 741      Wrapper_print(df,f_wrappers);
 742      Printf(command_tab,"{\"%s::%s\", %s},\n", cmodule, iname, dname);
 743      DelWrapper(df);
 744      Delete(dispatch);
 745      Delete(dname);
 746    }
 747    if (!Getattr(n,"sym:nextSibling")) {
 748      if (export_all) {
 749	Printf(exported,"%s ", iname);
 750      }
 751      
 752      /* --------------------------------------------------------------------
 753       * Create a stub for this function, provided it's not a member function
 754       * -------------------------------------------------------------------- */
 755      
 756      if ((blessed) && (!member_func)) {
 757	Printv(func_stubs,"*", iname, " = *", cmodule, "::", iname, ";\n", NIL);
 758      }
 759
 760    }
 761    Delete(cleanup);
 762    Delete(outarg);
 763    DelWrapper(f);
 764    return SWIG_OK;
 765  }
 766
 767  /* ------------------------------------------------------------
 768   * variableWrapper()
 769   * ------------------------------------------------------------ */
 770
 771  virtual int variableWrapper(Node *n) {
 772    String *name  = Getattr(n,"name");
 773    String *iname = Getattr(n,"sym:name");
 774    SwigType *t   = Getattr(n,"type");
 775    Wrapper  *getf, *setf;
 776    String  *tm;
 777
 778    String *set_name = NewStringf("_wrap_set_%s", iname);
 779    String *val_name = NewStringf("_wrap_val_%s", iname);
 780
 781    if (!addSymbol(iname,n)) return SWIG_ERROR;
 782
 783    getf = NewWrapper();
 784    setf = NewWrapper();
 785
 786    /* Create a Perl function for setting the variable value */
 787
 788    if (!Getattr(n,"feature:immutable")) {
 789      Printf(setf->def,"SWIGCLASS_STATIC int %s(pTHX_ SV* sv, MAGIC *mg) {\n", set_name);
 790      Printv(setf->code,
 791	     tab4, "MAGIC_PPERL\n",
 792	     tab4, "mg = mg;\n",
 793	     NIL);
 794
 795      /* Check for a few typemaps */
 796      tm = Swig_typemap_lookup_new("varin",n,name,0);
 797      if (tm) {
 798	Replaceall(tm,"$source","sv");
 799	Replaceall(tm,"$target",name);
 800	Replaceall(tm,"$input","sv");
 801	Printf(setf->code,"%s\n", tm);
 802      } else {
 803	Swig_warning(WARN_TYPEMAP_VARIN_UNDEF, input_file, line_number, 
 804		     "Unable to set variable of type %s.\n", SwigType_str(t,0));
 805	return SWIG_NOWRAP;
 806      }
 807      Printf(setf->code,"    return 1;\n}\n");
 808      Replaceall(setf->code,"$symname",iname);
 809      Wrapper_print(setf,magic);
 810    }
 811
 812    /* Now write a function to evaluate the variable */
 813
 814    Printf(getf->def,"SWIGCLASS_STATIC int %s(pTHX_ SV *sv, MAGIC *mg) {\n", val_name);
 815    Printv(getf->code,
 816	   tab4, "MAGIC_PPERL\n",
 817	   tab4, "mg = mg;\n",
 818	   NIL);
 819
 820    if ((tm = Swig_typemap_lookup_new("varout",n,name,0))) {
 821      Replaceall(tm,"$target","sv");
 822      Replaceall(tm,"$result","sv");
 823      Replaceall(tm,"$source",name);
 824      Printf(getf->code,"%s\n", tm);
 825    } else {
 826      Swig_warning(WARN_TYPEMAP_VAROUT_UNDEF, input_file, line_number,
 827		   "Unable to read variable of type %s\n", SwigType_str(t,0));
 828      return SWIG_NOWRAP;
 829    }
 830    Printf(getf->code,"    return 1;\n}\n");
 831
 832    Replaceall(getf->code,"$symname",iname);
 833    Wrapper_print(getf,magic);
 834
 835    String *tt = Getattr(n,"tmap:varout:type");
 836    if (tt) {
 837      String *tm = NewStringf("&SWIGTYPE%s", SwigType_manglestr(t));
 838      if (Replaceall(tt,"$1_descriptor", tm)) {
 839	SwigType_remember(t);
 840      }
 841      Delete(tm);
 842      SwigType *st = Copy(t);
 843      SwigType_add_pointer(st);
 844      tm = NewStringf("&SWIGTYPE%s", SwigType_manglestr(st));
 845      if (Replaceall(tt,"$&1_descriptor", tm)) {
 846	SwigType_remember(st);
 847      }
 848      Delete(tm);
 849      Delete(st);
 850    } else {
 851      tt = (String *) "0";
 852    }
 853    /* Now add symbol to the PERL interpreter */
 854    if (Getattr(n,"feature:immutable")) {
 855      Printv(variable_tab, tab4, "{ \"", cmodule, "::", iname, "\", MAGIC_CLASS swig_magic_readonly, MAGIC_CLASS ", val_name,",", tt, " },\n",NIL);
 856
 857    } else {
 858      Printv(variable_tab, tab4, "{ \"", cmodule, "::", iname, "\", MAGIC_CLASS ", set_name, ", MAGIC_CLASS ", val_name, ",", tt, " },\n",NIL);
 859    }
 860
 861    /* If we're blessed, try to figure out what to do with the variable
 862       1.  If it's a Perl object of some sort, create a tied-hash
 863           around it.
 864	   2.  Otherwise, just hack Perl's symbol table */
 865
 866    if (blessed) {
 867      if (is_shadow(t)) {
 868	Printv(var_stubs,
 869	       "\nmy %__", iname, "_hash;\n",
 870	       "tie %__", iname, "_hash,\"", is_shadow(t), "\", $",
 871	       cmodule, "::", iname, ";\n",
 872	       "$", iname, "= \\%__", iname, "_hash;\n",
 873	       "bless $", iname, ", ", is_shadow(t), ";\n",
 874	       NIL);
 875      } else {
 876	Printv(var_stubs, "*", iname, " = *", cmodule, "::", iname, ";\n", NIL);
 877      }
 878    }
 879    if (export_all)
 880      Printf(exported,"$%s ", iname);
 881
 882    DelWrapper(setf);
 883    DelWrapper(getf);
 884    Delete(set_name);
 885    Delete(val_name);
 886    return SWIG_OK;
 887  }
 888
 889  /* ------------------------------------------------------------
 890   * constantWrapper()
 891   * ------------------------------------------------------------ */
 892
 893  virtual int constantWrapper(Node *n) {
 894    String *name      = Getattr(n,"name");
 895    String *iname     = Getattr(n,"sym:name");
 896    SwigType *type  = Getattr(n,"type");
 897    String   *value = Getattr(n,"value");
 898    String   *tm;
 899
 900    if (!addSymbol(iname,n)) return SWIG_ERROR;
 901
 902    /* Special hook for member pointer */
 903    if (SwigType_type(type) == T_MPOINTER) {
 904      String *wname = Swig_name_wrapper(iname);
 905      Printf(f_wrappers, "static %s = %s;\n", SwigType_str(type,wname), value);
 906      value = Char(wname);
 907    }
 908
 909    if ((tm = Swig_typemap_lookup_new("consttab",n,name,0))) {
 910      Replaceall(tm,"$source",value);
 911      Replaceall(tm,"$target",name);
 912      Replaceall(tm,"$value",value);
 913      Printf(constant_tab,"%s,\n", tm);
 914    } else if ((tm = Swig_typemap_lookup_new("constcode", n, name, 0))) {
 915      Replaceall(tm,"$source", value);
 916      Replaceall(tm,"$target", name);
 917      Replaceall(tm,"$value",value);
 918      Printf(f_init, "%s\n", tm);
 919    } else {
 920      Swig_warning(WARN_TYPEMAP_CONST_UNDEF, input_file, line_number,
 921		   "Unsupported constant value.\n");
 922      return SWIG_NOWRAP;
 923    }
 924
 925    if (blessed) {
 926      if (is_shadow(type)) {
 927	Printv(var_stubs,
 928	       "\nmy %__", iname, "_hash;\n",
 929	       "tie %__", iname, "_hash,\"", is_shadow(type), "\", $",
 930	       cmodule, "::", iname, ";\n",
 931	       "$", iname, "= \\%__", iname, "_hash;\n",
 932	       "bless $", iname, ", ", is_shadow(type), ";\n",
 933	       NIL);
 934      } else if (do_constants) {
 935	Printv(const_stubs,"sub ", name, " () { $",
 936	       cmodule, "::", name, " }\n", NIL);
 937	num_consts++;
 938      } else {
 939	Printv(var_stubs, "*",iname," = *", cmodule, "::", iname, ";\n", NIL);
 940      }
 941    }
 942    if (export_all) {
 943      if (do_constants && !is_shadow(type)) {
 944	Printf(exported,"%s ",name);
 945      } else {
 946	Printf(exported,"$%s ",iname);
 947      }
 948    }
 949    return SWIG_OK;
 950  }
 951
 952  /* ------------------------------------------------------------
 953   * usage_func()
 954   * ------------------------------------------------------------ */
 955  char *usage_func(char *iname, SwigType *, ParmList *l) {
 956    static String *temp = 0;
 957    Parm  *p;
 958    int    i;
 959
 960    if (!temp) temp = NewString("");
 961    Clear(temp);
 962    Printf(temp,"%s(",iname);
 963
 964    /* Now go through and print parameters */
 965    p = l;
 966    i = 0;
 967    while (p != 0) {
 968      SwigType *pt = Getattr(p,"type");
 969      String   *pn = Getattr(p,"name");
 970      if (!Getattr(p,"ignore")) {
 971	/* If parameter has been named, use that.   Otherwise, just print a type  */
 972	if (SwigType_type(pt) != T_VOID) {
 973	  if (Len(pn) > 0) {
 974	    Printf(temp,"%s",pn);
 975	  } else {
 976	    Printf(temp,"%s",SwigType_str(pt,0));
 977	  }
 978	}
 979	i++;
 980	p = nextSibling(p);
 981	if (p)
 982	  if (!Getattr(p,"ignore"))
 983	    Putc(',',temp);
 984      } else {
 985	p = nextSibling(p);
 986	if (p)
 987	  if ((i>0) && (!Getattr(p,"ignore")))
 988	    Putc(',',temp);
 989      }
 990    }
 991    Printf(temp,");");
 992    return Char(temp);
 993  }
 994
 995  /* ------------------------------------------------------------
 996   * nativeWrapper()
 997   * ------------------------------------------------------------ */
 998  
 999  virtual int nativeWrapper(Node *n) {
1000    String *name = Getattr(n,"sym:name");
1001    String *funcname = Getattr(n,"wrap:name");
1002
1003    if (!addSymbol(funcname,n)) return SWIG_ERROR;
1004
1005    Printf(command_tab,"{\"%s::%s\", %s},\n", cmodule,name,funcname);
1006    if (export_all)
1007      Printf(exported,"%s ",name);
1008    if (blessed) {
1009      Printv(func_stubs,"*", name, " = *", cmodule, "::", name, ";\n", NIL);
1010    }
1011    return SWIG_OK;
1012  }
1013
1014  /****************************************************************************
1015   ***                      OBJECT-ORIENTED FEATURES
1016   ****************************************************************************
1017   *** These extensions provide a more object-oriented interface to C++
1018   *** classes and structures.    The code here is based on extensions
1019   *** provided by David Fletcher and Gary Holt.
1020   ***
1021   *** I have generalized these extensions to make them more general purpose
1022   *** and to resolve object-ownership problems.
1023   ***
1024   *** The approach here is very similar to the Python module :
1025   ***       1.   All of the original methods are placed into a single
1026   ***            package like before except that a 'c' is appended to the
1027   ***            package name.
1028   ***
1029   ***       2.   All methods and function calls are wrapped with a new
1030   ***            perl function.   While possibly inefficient this allows
1031   ***            us to catch complex function arguments (which are hard to
1032   ***            track otherwise).
1033   ***
1034   ***       3.   Classes are represented as tied-hashes in a manner similar
1035   ***            to Gary Holt's extension.   This allows us to access
1036   ***            member data.
1037   ***
1038   ***       4.   Stand-alone (global) C functions are modified to take
1039   ***            tied hashes as arguments for complex datatypes (if
1040   ***            appropriate).
1041   ***
1042   ***       5.   Global variables involving a class/struct is encapsulated
1043   ***            in a tied hash.
1044   ***
1045   ****************************************************************************/
1046  
1047  
1048  void setclassname(Node *n) {
1049    String *symname = Getattr(n,"sym:name");
1050    String *fullname;
1051    String *actualpackage;
1052    Node   *clsmodule = Getattr(n,"module");
1053    
1054    if (!clsmodule) {
1055      /* imported module does not define a module name.   Oh well */
1056      return;
1057    }
1058
1059    /* Do some work on the class name */
1060    actualpackage = Getattr(clsmodule,"name");
1061    if ((!compat) && (!Strchr(symname,':'))) {
1062      fullname = NewStringf("%s::%s",actualpackage,symname);
1063    } else {
1064      fullname = NewString(symname);
1065    }
1066    Setattr(n,"perl5:proxy", fullname);
1067  }
1068  
1069  /* ------------------------------------------------------------
1070   * classDeclaration()
1071   * ------------------------------------------------------------ */
1072  virtual int classDeclaration(Node *n) {
1073    /* Do some work on the class name */
1074    if (!Getattr(n,"feature:onlychildren")) {
1075      if (blessed) {
1076	setclassname(n);
1077	Append(classlist,n);
1078      }
1079    }
1080    
1081    return Language::classDeclaration(n);
1082  }
1083  
1084  /* ------------------------------------------------------------
1085   * classHandler()
1086   * ------------------------------------------------------------ */
1087
1088  virtual int classHandler(Node *n) {
1089
1090    if (blessed) {
1091      have_constructor = 0;
1092      have_operators = 0;
1093      have_destructor = 0;
1094      have_data_members = 0;
1095      operators = NewHash();
1096
1097      class_name = Getattr(n,"sym:name");
1098
1099      if (!addSymbol(class_name,n)) return SWIG_ERROR;
1100
1101      /* Use the fully qualified name of the Perl class */
1102      if (!compat) {
1103	fullclassname = NewStringf("%s::%s",fullmodule,class_name);
1104      } else {
1105	fullclassname = NewString(class_name);
1106      }
1107      real_classname = Getattr(n,"name");
1108      pcode = NewString("");
1109      // blessedmembers = NewString("");
1110    }
1111
1112    /* Emit all of the members */
1113    Language::classHandler(n);
1114
1115
1116    /* Finish the rest of the class */
1117    if (blessed) {
1118      /* Generate a client-data entry */
1119      SwigType *ct = NewStringf("p.%s", real_classname);
1120      Printv(f_init,"SWIG_TypeClientData(SWIGTYPE", SwigType_manglestr(ct),", (void*) \"",
1121	     fullclassname, "\");\n", NIL);
1122      SwigType_remember(ct);
1123      Delete(ct);
1124
1125      Printv(pm,
1126	     "\n############# Class : ", fullclassname, " ##############\n",
1127	     "\npackage ", fullclassname, ";\n",
1128	     NIL);
1129
1130      if (have_operators) {
1131	Printf(pm, "use overload\n");
1132	Iterator ki;
1133	for (ki = First(operators); ki.key; ki = Next(ki)) {
1134	  char *name = Char(ki.key);
1135	  //	    fprintf(stderr,"found name: <%s>\n", name);
1136	  if (strstr(name, "operator_equal_to")) {
1137	    Printv(pm, tab4, "\"==\" => sub { $_[0]->operator_equal_to($_[1])},\n",NIL);
1138	  } else if (strstr(name, "operator_not_equal_to")) {
1139	    Printv(pm, tab4, "\"!=\" => sub { $_[0]->operator_not_equal_to($_[1])},\n",NIL);
1140	  } else if (strstr(name, "operator_assignment")) {
1141	    Printv(pm, tab4, "\"=\" => sub { $_[0]->operator_assignment($_[1])},\n",NIL);
1142	  } else {
1143	    fprintf(stderr,"Unknown operator: %s\n", name);
1144	  }
1145	}
1146	Printv(pm, tab4, "\"fallback\" => 1;\n",NIL);	    
1147      }
1148      /* If we are inheriting from a base class, set that up */
1149
1150
1151      Printv(pm, "@ISA = qw( ", NIL);
1152      if (!compat || Cmp(fullmodule, fullclassname)) {
1153	Printv(pm, fullmodule, NIL);
1154      }
1155
1156      /* Handle inheritance */
1157      List *baselist = Getattr(n,"bases");
1158      if (baselist && Len(baselist)) {
1159	Iterator b;
1160	b = First(baselist);
1161	while (b.item) {
1162	  String *bname = Getattr(b.item, "perl5:proxy");
1163	  if (!bname) {
1164	    b = Next(b);
1165	    continue;
1166	  }
1167	  Printv(pm," ", bname, NIL);
1168	  b = Next(b);
1169	}
1170      }
1171      Printf(pm, " );\n");
1172
1173      /* Dump out a hash table containing the pointers that we own */
1174      Printf(pm, "%%OWNER = ();\n");
1175      if (have_data_members || have_destructor)
1176	Printf(pm, "%%ITERATORS = ();\n");
1177
1178      /* Dump out the package methods */
1179
1180      Printv(pm,pcode,NIL);
1181      Delete(pcode);
1182
1183      /* Output methods for managing ownership */
1184
1185      Printv(pm,
1186	     "sub DISOWN {\n",
1187	     tab4, "my $self = shift;\n",
1188	     tab4, "my $ptr = tied(%$self);\n",
1189	     tab4, "delete $OWNER{$ptr};\n",
1190	     "}\n\n",
1191	     "sub ACQUIRE {\n",
1192	     tab4, "my $self = shift;\n",
1193	     tab4, "my $ptr = tied(%$self);\n",
1194	     tab4, "$OWNER{$ptr} = 1;\n",
1195	     "}\n\n",
1196	     NIL);
1197
1198      /* Only output the following methods if a class has member data */
1199
1200      Delete(operators);     operators = 0;
1201    }
1202    return SWIG_OK;
1203  }
1204
1205  /* ------------------------------------------------------------
1206   * memberfunctionHandler()
1207   * ------------------------------------------------------------ */
1208
1209  virtual int memberfunctionHandler(Node *n) {
1210    String   *symname = Getattr(n,"sym:name");
1211
1212    member_func = 1;
1213    Language::memberfunctionHandler(n);
1214    member_func = 0;
1215
1216    if ((blessed) && (!Getattr(n,"sym:nextSibling"))) {
1217  
1218      if (Strstr(symname, "operator") == symname) {
1219	if (Strstr(symname, "operator_equal_to")) {
1220	  DohSetInt(operators,"operator_equal_to",1);
1221	  have_operators = 1;
1222	} else if (Strstr(symname, "operator_not_equal_to")) {
1223	  DohSetInt(operators,"operator_not_equal_to",1);
1224	  have_operators = 1;
1225	} else if (Strstr(symname, "operator_assignment")) {
1226	  DohSetInt(operators,"operator_assignment",1);
1227	  have_operators = 1;
1228	} else {
1229	  Printf(stderr,"Unknown operator: %s\n", symname);
1230	}
1231	//      fprintf(stderr,"Found member_func operator: %s\n", symname);
1232      }
1233
1234      if (Getattr(n,"feature:shadow")) {
1235	String *plcode = perlcode(Getattr(n,"feature:shadow"),0);
1236	String *plaction = NewStringf("%s::%s", module, Swig_name_member(class_name,symname));
1237	Replaceall(plcode,"$action" ,plaction);
1238	Delete(plaction);
1239	Printv(pcode,plcode,NIL);
1240      } else {
1241	Printv(pcode,"*",symname," = *", cmodule, "::", Swig_name_member(class_name,symname), ";\n", NIL);
1242      }
1243    }
1244    return SWIG_OK;
1245  }
1246
1247  /* ------------------------------------------------------------
1248   * membervariableHandler()
1249   *
1250   * Adds an instance member.
1251   * ----------------------------------------------------------------------------- */
1252
1253  virtual int membervariableHandler(Node *n) {
1254
1255    String   *symname = Getattr(n,"sym:name");
1256    /* SwigType *t  = Getattr(n,"type"); */
1257
1258    /* Emit a pair of get/set functions for the variable */
1259
1260    member_func = 1;
1261    Language::membervariableHandler(n);
1262    member_func = 0;
1263
1264    if (blessed) {
1265
1266      Printv(pcode,"*swig_", symname, "_get = *", cmodule, "::", Swig_name_get(Swig_name_member(class_name,symname)), ";\n", NIL);
1267      Printv(pcode,"*swig_", symname, "_set = *", cmodule, "::", Swig_name_set(Swig_name_member(class_name,symname)), ";\n", NIL);
1268
1269      /* Now we need to generate a little Perl code for this */
1270
1271      /* if (is_shadow(t)) {
1272
1273      *//* This is a Perl object that we have already seen.  Add an
1274	   entry to the members list*//*
1275	Printv(blessedmembers,
1276	       tab4, symname, " => '", is_shadow(t), "',\n",
1277	       NIL);
1278
1279      }
1280				      */
1281    }
1282    have_data_members++;
1283    return SWIG_OK;
1284  }
1285
1286  /* ------------------------------------------------------------
1287   * constructorDeclaration()
1288   *
1289   * Emits a blessed constructor for our class.    In addition to our construct
1290   * we manage a Perl hash table containing all of the pointers created by
1291   * the constructor.   This prevents us from accidentally trying to free
1292   * something that wasn't necessarily allocated by malloc or new
1293   * ------------------------------------------------------------ */
1294
1295  virtual int constructorHandler(Node *n) {
1296
1297    String *symname = Getattr(n,"sym:name");
1298
1299    member_func = 1;
1300    Language::constructorHandler(n);
1301
1302    if ((blessed) && (!Getattr(n,"sym:nextSibling"))) {
1303      if (Getattr(n,"feature:shadow")) {
1304        String *plcode = perlcode(Getattr(n,"feature:shadow"),0);
1305        String *plaction = NewStringf("%s::%s", module, Swig_name_member(class_name,symname));
1306	Replaceall(plcode,"$action" ,plaction);
1307        Delete(plaction);
1308        Printv(pcode,plcode,NIL);
1309      } else {
1310	if ((Cmp(symname,class_name) == 0)) {
1311	  /* Emit a blessed constructor  */
1312	  Printf(pcode, "sub new {\n");
1313	} else {
1314	  /* Constructor doesn't match classname so we'll just use the normal name  */
1315	  Printv(pcode, "sub ", Swig_name_construct(symname), " () {\n", NIL);
1316	}
1317
1318	Printv(pcode,
1319	       tab4, "my $pkg = shift;\n",
1320	       tab4, "my $self = ", cmodule, "::", Swig_name_construct(symname), "(@_);\n",
1321	       tab4, "bless $self, $pkg if defined($self);\n",
1322	       "}\n\n",
1323	       NIL);
1324
1325	have_constructor = 1;
1326      }
1327    }
1328    member_func = 0;
1329    return SWIG_OK;
1330  }
1331
1332  /* ------------------------------------------------------------ 
1333   * destructorHandler()
1334   * ------------------------------------------------------------ */
1335  
1336  virtual int destructorHandler(Node *n) {
1337    String *symname = Getattr(n,"sym:name");
1338    member_func = 1;
1339    Language::destructorHandler(n);
1340    if (blessed) {
1341      if (Getattr(n,"feature:shadow")) {
1342        String *plcode = perlcode(Getattr(n,"feature:shadow"),0);
1343        String *plaction = NewStringf("%s::%s", module, Swig_name_member(class_name,symname));
1344	Replaceall(plcode,"$action" ,plaction);
1345        Delete(plaction);
1346        Printv(pcode,plcode,NIL);
1347      } else {
1348	Printv(pcode,
1349	       "sub DESTROY {\n",
1350	       tab4, "return unless $_[0]->isa('HASH');\n",
1351	       tab4, "my $self = tied(%{$_[0]});\n",
1352	       tab4, "return unless defined $self;\n",
1353	       tab4, "delete $ITERATORS{$self};\n",
1354	       tab4, "if (exists $OWNER{$self}) {\n",
1355	       tab8,  cmodule, "::", Swig_name_destroy(symname), "($self);\n",
1356	       tab8, "delete $OWNER{$self};\n",
1357	       tab4, "}\n}\n\n",
1358	       NIL);
1359	have_destructor = 1;
1360      }
1361    }
1362    member_func = 0;
1363    return SWIG_OK;
1364  }
1365
1366  /* ------------------------------------------------------------
1367   * staticmemberfunctionHandler()
1368   * ------------------------------------------------------------ */
1369
1370  virtual int staticmemberfunctionHandler(Node *n) {
1371    member_func = 1;
1372    Language::staticmemberfunctionHandler(n);
1373    member_func = 0;
1374    if ((blessed) && (!Getattr(n,"sym:nextSibling"))) {
1375      String *symname = Getattr(n,"sym:name");
1376      Printv(pcode,"*",symname," = *", cmodule, "::", Swig_name_member(class_name,symname), ";\n", NIL);
1377    }
1378    return SWIG_OK;
1379  }
1380
1381  /* ------------------------------------------------------------
1382   * staticmembervariableHandler()
1383   * ------------------------------------------------------------ */
1384
1385  virtual int staticmembervariableHandler(Node *n) {
1386    Language::staticmembervariableHandler(n);
1387    if (blessed) {
1388      String *symname = Getattr(n,"sym:name");
1389      Printv(pcode,"*",symname," = *", cmodule, "::", Swig_name_member(class_name,symname), ";\n", NIL);
1390    }
1391    return SWIG_OK;
1392  }
1393  
1394  /* ------------------------------------------------------------
1395   * memberconstantHandler()
1396   * ------------------------------------------------------------ */
1397
1398  virtual int memberconstantHandler(Node *n) {
1399    String *symname = Getattr(n,"sym:name");
1400    int   oldblessed = blessed;
1401    
1402    /* Create a normal constant */
1403    blessed = 0;
1404    Language::memberconstantHandler(n);
1405    blessed = oldblessed;
1406    
1407    if (blessed) {
1408      Printv(pcode, "*", symname, " = *", cmodule, "::", Swig_name_member(class_name,symname), ";\n", NIL);
1409    }
1410    return SWIG_OK;
1411  }
1412
1413  /* ------------------------------------------------------------
1414   * pragma()
1415   *
1416   * Pragma directive.
1417   *
1418   * %pragma(perl5) code="String"              # Includes a string in the .pm file
1419   * %pragma(perl5) include="file.pl"          # Includes a file in the .pm file
1420   * ------------------------------------------------------------ */
1421
1422  virtual int pragmaDirective(Node *n) {
1423    String *lang;
1424    String *code;
1425    String *value;
1426    if (!ImportMode) {
1427      lang = Getattr(n,"lang");
1428      code = Getattr(n,"name");
1429      value = Getattr(n,"value");
1430      if (Strcmp(lang,"perl5") == 0) {
1431	if (Strcmp(code,"code") == 0) {
1432	  /* Dump the value string into the .pm file */
1433	  if (value) {
1434	    Printf(pragma_include, "%s\n", value);
1435	  }
1436	} else if (Strcmp(code,"include") == 0) {
1437	  /* Include a file into the .pm file */
1438	  if (value) {
1439	    FILE *f = Swig_open(value);
1440	    if (!f) {
1441	      Printf(stderr,"%s : Line %d. Unable to locate file %s\n", input_file, line_number,value);
1442	    } else {
1443	      char buffer[4096];
1444	      while (fgets(buffer,4095,f)) {
1445		Printf(pragma_include,"%s",buffer);
1446	      }
1447	    }
1448	  }
1449	} else {
1450	  Printf(stderr,"%s : Line %d. Unrecognized pragma.\n", input_file,line_number);
1451	}
1452      }
1453    }
1454    return Language::pragmaDirective(n);
1455  }
1456
1457  /* ------------------------------------------------------------
1458   * perlcode()     - Output perlcode code into the shadow file
1459   * ------------------------------------------------------------ */
1460
1461  String *perlcode(String *code, const String *indent) {
1462    String *out = NewString("");
1463    String *temp;
1464    char   *t;
1465    if (!indent) indent = "";
1466
1467    temp = NewString(code);
1468
1469    t = Char(temp);
1470    if (*t == '{') {
1471      Delitem(temp,0);
1472      Delitem(temp,DOH_END);
1473    }
1474
1475    /* Split the input text into lines */
1476    List *clist = DohSplitLines(temp);
1477    Delete(temp);
1478    int   initial = 0;
1479    String *s = 0;
1480    Iterator si;
1481    /* Get the initial indentation */
1482    
1483    for (si = First(clist); si.item; si = Next(si)) {
1484      s = si.item;
1485      if (Len(s)) {
1486	char *c = Char(s);
1487	while (*c) {
1488	  if (!isspace(*c)) break;
1489	  initial++;
1490	  c++;
1491	}
1492	if (*c && !isspace(*c)) break;
1493	else {
1494	  initial = 0;
1495	}
1496      }
1497    }
1498    while (si.item) {
1499      s = si.item;
1500      if (Len(s) > initial) {
1501	char *c = Char(s);
1502	c += initial;
1503	Printv(out,indent,c,"\n",NIL);
1504      } else {
1505	Printv(out,"\n",NIL);
1506      }
1507      si = Next(si);
1508    }
1509    Delete(clist);
1510    return out;
1511  }
1512  
1513  /* ------------------------------------------------------------
1514   * insertDirective()
1515   * 
1516   * Hook for %insert directive.
1517   * ------------------------------------------------------------ */
1518
1519  virtual int insertDirective(Node *n) {
1520    String *code = Getattr(n,"code");
1521    String *section = Getattr(n,"section");
1522
1523    if ((!ImportMode) && (Cmp(section,"perl") == 0)) {
1524	Printv(additional_perl_code, code, NIL);
1525    } else {
1526      Language::insertDirective(n);
1527    }
1528    return SWIG_OK;
1529  }
1530};
1531  
1532/* -----------------------------------------------------------------------------
1533 * swig_perl5()    - Instantiate module
1534 * ----------------------------------------------------------------------------- */
1535
1536static Language * new_swig_perl5() {
1537  return new PERL5();
1538}
1539extern "C" Language * swig_perl5(void) {
1540  return new_swig_perl5();
1541}