changeset 6678:eb95f31fa4eb

[gaim-migrate @ 7203] The perl plugin should now work with perl v5.6.0. This is not tested yet, but it compiles and should work now. committer: Tailor Script <[e-mail]>

--- a/plugins/perl/Makefile.am	Mon Sep 01 20:34:53 2003 +0000
+++ b/plugins/perl/Makefile.am	Mon Sep 01 22:16:10 2003 +0000
@@ -36,6 +36,8 @@
 	fi
 
 common_sources = \
+	common/fallback/const-c.inc \
+	common/fallback/const-xs.inc \
 	common/Account.xs \
 	common/BuddyList.xs \
 	common/BuddyList_Buddy.xs \

--- a/plugins/perl/common/Makefile.PL.in	Mon Sep 01 20:34:53 2003 +0000
+++ b/plugins/perl/common/Makefile.PL.in	Mon Sep 01 22:16:10 2003 +0000
@@ -1,4 +1,4 @@
-use 5.008;
+use 5.006;
 use ExtUtils::MakeMaker;
 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
 # the contents of the Makefile that is written.
@@ -22,7 +22,18 @@
 	}
 
 	ExtUtils::Constant::WriteConstants(
-		NAME  => 'Gaim::DebugLevel',
-		NAMES => \@names
+		NAME    => 'Gaim::DebugLevel',
+		NAMES   => \@names,
+		C_FILE  => 'const-c.inc',
+		XS_FILE => 'const-xs.inc'
 	);
 }
+else {
+	use File::Copy;
+	use File::Spec;
+
+	foreach my $file ('const-c.inc', 'const-xs.inc') {
+		my $fallback = File::Spec->catfile('fallback', $file);
+		copy ($fallback, $file) or die "Can't copy $fallback to $file: $!";
+	}
+}

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/common/fallback/const-c.inc	Mon Sep 01 22:16:10 2003 +0000
@@ -0,0 +1,115 @@
+#define PERL_constant_NOTFOUND	1
+#define PERL_constant_NOTDEF	2
+#define PERL_constant_ISIV	3
+#define PERL_constant_ISNO	4
+#define PERL_constant_ISNV	5
+#define PERL_constant_ISPV	6
+#define PERL_constant_ISPVN	7
+#define PERL_constant_ISSV	8
+#define PERL_constant_ISUNDEF	9
+#define PERL_constant_ISUV	10
+#define PERL_constant_ISYES	11
+
+#ifndef NVTYPE
+typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it.  */
+#endif
+#ifndef aTHX_
+#define aTHX_ /* 5.6 or later define this for threading support.  */
+#endif
+#ifndef pTHX_
+#define pTHX_ /* 5.6 or later define this for threading support.  */
+#endif
+
+static int
+constant (pTHX_ const char *name, STRLEN len, IV *iv_return) {
+  /* Initially switch on the length of the name.  */
+  /* When generated this function returned values for the list of names given
+     in this section of perl code.  Rather than manually editing these functions
+     to add or remove constants, which would result in this comment and section
+     of code becoming inaccurate, we recommend that you edit this section of
+     code, and use it to regenerate a new set of constant functions which you
+     then use to replace the originals.
+
+     Regenerate these constant functions by feeding this entire source file to
+     perl -x
+
+#!/usr/bin/perl -w
+use ExtUtils::Constant qw (constant_types C_constant XS_constant);
+
+my $types = {map {($_, 1)} qw(IV)};
+my @names = (qw(),
+            {name=>"GAIM_DEBUG_ALL", type=>"IV", macro=>"1"},
+            {name=>"GAIM_DEBUG_ERROR", type=>"IV", macro=>"1"},
+            {name=>"GAIM_DEBUG_FATAL", type=>"IV", macro=>"1"},
+            {name=>"GAIM_DEBUG_INFO", type=>"IV", macro=>"1"},
+            {name=>"GAIM_DEBUG_MISC", type=>"IV", macro=>"1"},
+            {name=>"GAIM_DEBUG_WARNING", type=>"IV", macro=>"1"});
+
+print constant_types(); # macro defs
+foreach (C_constant ("Gaim::DebugLevel", 'constant', 'IV', $types, undef, 3, @names) ) {
+    print $_, "\n"; # C constant subs
+}
+print "#### XS Section:\n";
+print XS_constant ("Gaim::DebugLevel", $types);
+__END__
+   */
+
+  switch (len) {
+  case 14:
+    if (memEQ(name, "GAIM_DEBUG_ALL", 14)) {
+      *iv_return = GAIM_DEBUG_ALL;
+      return PERL_constant_ISIV;
+    }
+    break;
+  case 15:
+    /* Names all of length 15.  */
+    /* GAIM_DEBUG_INFO GAIM_DEBUG_MISC */
+    /* Offset 11 gives the best switch position.  */
+    switch (name[11]) {
+    case 'I':
+      if (memEQ(name, "GAIM_DEBUG_INFO", 15)) {
+      /*                          ^          */
+        *iv_return = GAIM_DEBUG_INFO;
+        return PERL_constant_ISIV;
+      }
+      break;
+    case 'M':
+      if (memEQ(name, "GAIM_DEBUG_MISC", 15)) {
+      /*                          ^          */
+        *iv_return = GAIM_DEBUG_MISC;
+        return PERL_constant_ISIV;
+      }
+      break;
+    }
+    break;
+  case 16:
+    /* Names all of length 16.  */
+    /* GAIM_DEBUG_ERROR GAIM_DEBUG_FATAL */
+    /* Offset 11 gives the best switch position.  */
+    switch (name[11]) {
+    case 'E':
+      if (memEQ(name, "GAIM_DEBUG_ERROR", 16)) {
+      /*                          ^           */
+        *iv_return = GAIM_DEBUG_ERROR;
+        return PERL_constant_ISIV;
+      }
+      break;
+    case 'F':
+      if (memEQ(name, "GAIM_DEBUG_FATAL", 16)) {
+      /*                          ^           */
+        *iv_return = GAIM_DEBUG_FATAL;
+        return PERL_constant_ISIV;
+      }
+      break;
+    }
+    break;
+  case 18:
+    if (memEQ(name, "GAIM_DEBUG_WARNING", 18)) {
+      *iv_return = GAIM_DEBUG_WARNING;
+      return PERL_constant_ISIV;
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/common/fallback/const-xs.inc	Mon Sep 01 22:16:10 2003 +0000
@@ -0,0 +1,88 @@
+void
+constant(sv)
+    PREINIT:
+#ifdef dXSTARG
+	dXSTARG; /* Faster if we have it.  */
+#else
+	dTARGET;
+#endif
+	STRLEN		len;
+        int		type;
+	IV		iv;
+	/* NV		nv;	Uncomment this if you need to return NVs */
+	/* const char	*pv;	Uncomment this if you need to return PVs */
+    INPUT:
+	SV *		sv;
+        const char *	s = SvPV(sv, len);
+    PPCODE:
+        /* Change this to constant(aTHX_ s, len, &iv, &nv);
+           if you need to return both NVs and IVs */
+	type = constant(aTHX_ s, len, &iv);
+      /* Return 1 or 2 items. First is error message, or undef if no error.
+           Second, if present, is found value */
+        switch (type) {
+        case PERL_constant_NOTFOUND:
+          sv = sv_2mortal(newSVpvf("%s is not a valid Gaim::DebugLevel macro", s));
+          PUSHs(sv);
+          break;
+        case PERL_constant_NOTDEF:
+          sv = sv_2mortal(newSVpvf(
+	    "Your vendor has not defined Gaim::DebugLevel macro %s, used", s));
+          PUSHs(sv);
+          break;
+        case PERL_constant_ISIV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHi(iv);
+          break;
+	/* Uncomment this if you need to return NOs
+        case PERL_constant_ISNO:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHs(&PL_sv_no);
+          break; */
+	/* Uncomment this if you need to return NVs
+        case PERL_constant_ISNV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHn(nv);
+          break; */
+	/* Uncomment this if you need to return PVs
+        case PERL_constant_ISPV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHp(pv, strlen(pv));
+          break; */
+	/* Uncomment this if you need to return PVNs
+        case PERL_constant_ISPVN:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHp(pv, iv);
+          break; */
+	/* Uncomment this if you need to return SVs
+        case PERL_constant_ISSV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHs(sv);
+          break; */
+	/* Uncomment this if you need to return UNDEFs
+        case PERL_constant_ISUNDEF:
+          break; */
+	/* Uncomment this if you need to return UVs
+        case PERL_constant_ISUV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHu((UV)iv);
+          break; */
+	/* Uncomment this if you need to return YESs
+        case PERL_constant_ISYES:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHs(&PL_sv_yes);
+          break; */
+        default:
+          sv = sv_2mortal(newSVpvf(
+	    "Unexpected return type %d while processing Gaim::DebugLevel macro %s, used",
+               type, s));
+          PUSHs(sv);
+        }

--- a/plugins/perl/common/typemap	Mon Sep 01 20:34:53 2003 +0000
+++ b/plugins/perl/common/typemap	Mon Sep 01 22:16:10 2003 +0000
@@ -1,5 +1,6 @@
 TYPEMAP
 gboolean                 T_BOOL
+const char *             T_PV
 Gaim::Account            T_GaimObj
 Gaim::BuddyList::Group   T_GaimObj
 Gaim::BuddyList::Buddy   T_GaimObj

--- a/plugins/perl/perl.c	Mon Sep 01 20:34:53 2003 +0000
+++ b/plugins/perl/perl.c	Mon Sep 01 22:16:10 2003 +0000
@@ -276,7 +276,7 @@
 			GaimPluginInfo *info;
 			GaimPerlScript *gps;
 			char *basename;
-			int len;
+			STRLEN len;
 
 			gaim_debug(GAIM_DEBUG_INFO, "perl", "Found plugin info\n");
 
@@ -370,7 +370,7 @@
 		SPAGAIN;
 
 		if (SvTRUE(ERRSV)) {
-			int len;
+			STRLEN len;
 
 			gaim_debug(GAIM_DEBUG_ERROR, "perl",
 					   "Perl function %s exited abnormally: %s\n",
@@ -429,7 +429,7 @@
 		SPAGAIN;
 
 		if (SvTRUE(ERRSV)) {
-			int len;
+			STRLEN len;
 
 			gaim_debug(GAIM_DEBUG_ERROR, "perl",
 					   "Perl function %s exited abnormally: %s\n",