develooper Front page | perl.perl5.porters | Postings from March 2000

Playing with 5.6.0 and Apache and stuff

From:
Unknown Sender
Date:
March 5, 2000 11:38
Subject:
Playing with 5.6.0 and Apache and stuff
Message ID:
20000305203753.H21686@noris.de
I decided to be extremely foolish :-) and recompiled my whole
Apache/mod_perl setup today. With 64-bit and -DMULTIPLICITY and
... well, basically having fun.  ;-)
Anyway, this is a status report of sorts.

For now, I ingored all the size mismatch errors which the C compiler
invariably spewed out.

======================

mod_perl doesn't build with apxs if you use mod_ssl since it needs to
grab apxs's CFLAGS. It also seemed to require this patch:


Index: dev.38/src/modules/perl/apache_inc.h
--- dev.38/src/modules/perl/apache_inc.h Sat, 04 Mar 2000 14:36:51 +0100 smurf (net_www_perl/f/39_apache_inc 1.2 664)
+++ noris.10(w)/src/modules/perl/apache_inc.h Sat, 04 Mar 2000 15:10:25 +0100 smurf (net_www_perl/f/39_apache_inc 1.2 664)
@@ -39,7 +39,7 @@
 
 #endif
 
-#ifndef _INCLUDE_APACHE_FIRST
+/* #ifndef _INCLUDE_APACHE_FIRST */
 #ifdef __cplusplus
 extern "C" {
 #endif
@@ -77,7 +77,7 @@
 #ifdef __cplusplus
 }
 #endif
-#endif
+/* #endif */
 
 #ifdef JW_PERL_OBJECT
 

======================

DBI:

diff -rub /smurf/tmp/DBI-1.13/DBI.xs DBI-1.13/DBI.xs
--- /smurf/tmp/DBI-1.13/DBI.xs	Mon Jul 12 04:04:27 1999
+++ DBI-1.13/DBI.xs	Wed Mar  1 08:56:54 2000
@@ -1454,7 +1454,11 @@
 	fprintf(logfp," at unknown location!");
 	return;
     }
+#ifdef USE_ITHREADS
+    file = curcop->cop_file;
+#else
     file = SvPV(GvSV(curcop->cop_filegv), len);
+#endif
     if (trace_level<=4) {
 	if ( (sep=strrchr(file,'/')) || (sep=strrchr(file,'\\')))
 	    file = sep+1;
@@ -1743,6 +1747,7 @@
 	 */
 
 	/* SHORT-CUT ALERT! */
+#if 0 /* DOES NOT COMPILE */
 	if (xsbypass && isGV(imp_msv) && CvXSUB(GvCV(imp_msv))) {
 
 	    /* If we are calling an XSUB we jump directly to its C code and
@@ -1767,7 +1772,9 @@
 	    }
 
 	}
-	else {
+	else
+#endif
+	{
 	    outitems = perl_call_sv(isGV(imp_msv) ? (SV*)GvCV(imp_msv) : imp_msv, gimme);
 	}
 
diff -rub /smurf/tmp/DBI-1.13/DBIXS.h DBI-1.13/DBIXS.h
--- /smurf/tmp/DBI-1.13/DBIXS.h	Mon Jul 12 04:04:28 1999
+++ DBI-1.13/DBIXS.h	Wed Mar  1 08:51:40 2000
@@ -400,6 +400,7 @@
 static dbistate_t * get_dbistate() {
     return ((dbistate_t*)SvIVX(DBISTATE_ADDRSV));
 }
+# undef DBIS
 # define DBIS (get_dbistate())
 
 #else	/* plain and simple non perl object / multiplicity case */

======================

Index: base.12/dbd/dbdimp.c
--- base.12/dbd/dbdimp.c Wed, 01 Sep 1999 07:15:32 +0200 smurf (misc_perl_mysql/b/15_dbdimp.c 1.10 644)
+++ noris.6(w)/dbd/dbdimp.c Sun, 05 Mar 2000 19:58:22 +0100 smurf (misc_perl_mysql/b/15_dbdimp.c 1.13 644)
@@ -373,7 +373,9 @@
  **************************************************************************/
 
 void dbd_init(dbistate_t* dbistate) {
+#if 0 /* I don't know what to do about this one */
     DBIS = dbistate;
+#endif
 }
 
 
@@ -400,7 +402,7 @@
     sv_setiv(DBIc_ERR(imp_xxh), (IV)rc);	/* set err early	*/
     sv_setpv(errstr, what);
     DBIh_EVENT2(h, ERROR_event, DBIc_ERR(imp_xxh), errstr);
-    if (dbis->debug >= 2)
+    if (DBIS->debug >= 2)
 	PerlIO_printf(DBILOGFP, "%s error %d recorded: %s\n",
 		      what, rc, SvPV(errstr,lna));
 }
@@ -412,7 +414,7 @@
     sv_setiv(DBIc_ERR(imp_xxh), (IV)rc);	/* set err early	*/
     sv_setpv(errstr, what);
     DBIh_EVENT2(h, WARN_event, DBIc_ERR(imp_xxh), errstr);
-    if (dbis->debug >= 2)
+    if (DBIS->debug >= 2)
 	PerlIO_printf(DBILOGFP, "%s warning %d recorded: %s\n",
 		      what, rc, SvPV(errstr,lna));
     warn("%s", what);
@@ -465,7 +467,7 @@
     if (user && !*user) user = NULL;
     if (password && !*password) password = NULL;
 
-    if (dbis->debug >= 2)
+    if (DBIS->debug >= 2)
         PerlIO_printf(DBILOGFP,
 		      "imp_dbh->MyConnect: host = %s, port = %d, uid = %s," \
 		      " pwd = %s\n",
@@ -491,17 +493,17 @@
 
 		if ((svp = hv_fetch(hv, "mysql_compression", 17, FALSE))  &&
 		    *svp  &&  SvTRUE(*svp)) {
-		    if (dbis->debug >= 2)
+		    if (DBIS->debug >= 2)
 		        PerlIO_printf(DBILOGFP,
 				      "imp_dbh->MyConnect: Enabling" \
 				      " compression.\n");
 		    mysql_options(*sock, MYSQL_OPT_COMPRESS, NULL);
 		}
 		if ((svp = hv_fetch(hv, "mysql_read_default_file", 23,
 				    FALSE))  &&
 		    *svp  &&  SvTRUE(*svp)) {
 		    char* df = SvPV(*svp, lna);
-		    if (dbis->debug >= 2)
+		    if (DBIS->debug >= 2)
 		        PerlIO_printf(DBILOGFP,
 				      "imp_dbh->MyConnect: Reading" \
 				      " default file %s.\n", df);
@@ -511,7 +540,7 @@
 				    FALSE))  &&
 		    *svp  &&  SvTRUE(*svp)) {
 		    char* gr = SvPV(*svp, lna);
-		    if (dbis->debug >= 2)
+		    if (DBIS->debug >= 2)
 		        PerlIO_printf(DBILOGFP,
 				      "imp_dbh->MyConnect: Using" \
 				      " default group %s.\n", gr);
@@ -527,7 +556,7 @@
 		}
 	    }
         }
-	if (dbis->debug >= 2)
+	if (DBIS->debug >= 2)
 	  PerlIO_printf(DBILOGFP, "imp_dbh->MyConnect: client_flags = %d\n",
 			client_flag);
         return mysql_real_connect(*sock, host, user, password, dbname,
@@ -635,7 +664,7 @@
     if ((svp = hv_fetch(hv, "msql_configfile", 15, FALSE))  &&
         *svp  &&  SvOK(*svp)) {
         char* cf = SvPV(*svp, lna);
-        if (dbis->debug >= 2) {
+        if (DBIS->debug >= 2) {
             PerlIO_printf(DBILOGFP,
 			  "imp_dbh->MyLogin: Loading config file %s\n",
                     cf);
@@ -650,7 +679,7 @@
     }
 #endif
 
-    if (dbis->debug >= 2)
+    if (DBIS->debug >= 2)
         PerlIO_printf(DBILOGFP,
 		      "imp_dbh->MyLogin: dbname = %s, uid = %s, pwd = %s," \
 		      "host = %s, port = %s\n",
@@ -693,7 +722,7 @@
     dTHR;
 #endif
 
-    if (dbis->debug >= 2)
+    if (DBIS->debug >= 2)
         PerlIO_printf(DBILOGFP,
 		      "imp_dbh->connect: dsn = %s, uid = %s, pwd = %s\n",
 		      dbname ? dbname : "NULL",
@@ -773,7 +802,7 @@
     /* We assume that disconnect will always work       */
     /* since most errors imply already disconnected.    */
     DBIc_ACTIVE_off(imp_dbh);
-    if (dbis->debug >= 2)
+    if (DBIS->debug >= 2)
         PerlIO_printf(DBILOGFP, "imp_dbh->svsock: %lx\n",
 		      (long) &imp_dbh->svsock);
     MyClose(imp_dbh->svsock );
@@ -1024,7 +1053,7 @@
     {
         SV** svp = DBD_ATTRIB_GET_SVP(attribs, "mysql_use_result", 16);
         imp_sth->use_mysql_use_result = svp && SvTRUE(*svp);
-	if (dbis->debug >= 2)
+	if (DBIS->debug >= 2)
 	    PerlIO_printf(DBILOGFP, "Setting mysql_use_result to %d\n",
 			  imp_sth->use_mysql_use_result);
     }
@@ -1069,7 +1098,7 @@
 
     if (salloc) {
         sbuf = salloc;
-        if (dbis->debug >= 2) {
+        if (DBIS->debug >= 2) {
 	    PerlIO_printf(DBILOGFP, "      Binding parameters: %s\n", sbuf);
 	}
     }
@@ -1217,7 +1246,7 @@
     dTHR;
 #endif
 
-    if (dbis->debug >= 2) {
+    if (DBIS->debug >= 2) {
         PerlIO_printf(DBILOGFP,
 		      "    -> dbd_st_execute for %08lx\n", (u_long) sth);
     }
@@ -1261,7 +1290,7 @@
 	}
     }
 
-    if (dbis->debug >= 2) {
+    if (DBIS->debug >= 2) {
         PerlIO_printf(DBILOGFP, "    <- dbd_st_execute %d rows\n",
 		      imp_sth->row_num);
     }
@@ -1321,7 +1350,7 @@
 #endif
 
     ChopBlanks = DBIc_is(imp_sth, DBIcf_ChopBlanks);
-    if (dbis->debug >= 2) {
+    if (DBIS->debug >= 2) {
         PerlIO_printf(DBILOGFP,
 		      "    -> dbd_st_fetch for %08lx, chopblanks %d\n",
 		      (u_long) sth, ChopBlanks);
@@ -1367,7 +1396,7 @@
 		}
 	    }
 
-	    if (dbis->debug >= 2) {
+	    if (DBIS->debug >= 2) {
 		PerlIO_printf(DBILOGFP, "      Storing row %d (%s) in %08lx\n",
 			      i, col, (u_long) sv);
 	    }
@@ -1377,7 +1406,7 @@
 	}
     }
 
-    if (dbis->debug >= 2) {
+    if (DBIS->debug >= 2) {
         PerlIO_printf(DBILOGFP, "    <- dbd_st_fetch, %d cols\n", num_fields);
     }
     return av;
@@ -1479,7 +1508,7 @@
     char* key = SvPV(keysv, kl);
     int result = FALSE;
 
-    if (dbis->debug >= 2) {
+    if (DBIS->debug >= 2) {
         PerlIO_printf(DBILOGFP,
 		      "    -> dbd_st_STORE_attrib for %08lx, key %s\n",
 		      (u_long) sth, key);
@@ -1491,7 +1520,7 @@
     }
 #endif
 
-    if (dbis->debug >= 2) {
+    if (DBIS->debug >= 2) {
         PerlIO_printf(DBILOGFP,
 		      "    <- dbd_st_STORE_attrib for %08lx, result %d\n",
 		      (u_long) sth, result);
@@ -1670,7 +1699,7 @@
         return Nullsv;
     }
 
-    if (dbis->debug >= 2) {
+    if (DBIS->debug >= 2) {
         PerlIO_printf(DBILOGFP,
 		      "    -> dbd_st_FETCH_attrib for %08lx, key %s\n",
 		      (u_long) sth, key);
 
======================


Bit::Vector:

diff -rub /smurf/tmp/Bit-Vector-5.7/Vector.xs Bit-Vector-5.7/Vector.xs
--- /smurf/tmp/Bit-Vector-5.7/Vector.xs	Wed May 19 18:15:45 1999
+++ Bit-Vector-5.7/Vector.xs	Thu Mar  2 03:46:05 2000
@@ -38,11 +38,11 @@
     ( ref && !(SvROK(ref)) && ((var = (typ)SvIV(ref)) | 1) )
 
 #define BIT_VECTOR_STRING(ref,var) \
-    ( ref && !(SvROK(ref)) && (var = (charptr)SvPV(ref,na)) )
+    ( ref && !(SvROK(ref)) && (var = (charptr)SvPV(ref,PL_na)) )
 
 #define BIT_VECTOR_BUFFER(ref,var,len) \
     ( ref && !(SvROK(ref)) && SvPOK(ref) && \
-    (var = (charptr)SvPV(ref,na)) && \
+    (var = (charptr)SvPV(ref,PL_na)) && \
     ((len = (N_int)SvCUR(ref)) | 1) )
 
 
diff -rub /smurf/tmp/Bit-Vector-5.7/t/01________new.t Bit-Vector-5.7/t/01________new.t
--- /smurf/tmp/Bit-Vector-5.7/t/01________new.t	Wed May 19 18:15:45 1999
+++ Bit-Vector-5.7/t/01________new.t	Thu Mar  2 03:51:40 2000
@@ -367,35 +375,35 @@
 $n++;
 
 # test syntactically incorrect constructor calls:
 
 eval { $set = Bit::Vector::new(16); };
-if ($@ =~ /Usage: new\(class,bits\)/)
-{print "ok $n\n";} else {print "not ok $n\n";}
+if ($@ =~ /Usage: new\(class,\s?bits\)/)
+{print "ok $n\n";} else {print "not ok $n # $@\n";}
 $n++;
 
 eval { $set = Bit::Vector::new('main'); };
-if ($@ =~ /Usage: .*?new\(class,bits\)/)
-{print "ok $n\n";} else {print "not ok $n\n";}
+if ($@ =~ /Usage: .*?new\(class,\s?bits\)/)
+{print "ok $n\n";} else {print "not ok $n # $@\n";}
 $n++;
 
 eval { $set = Bit::Vector::new($set); };
-if ($@ =~ /Usage: .*?new\(class,bits\)/)
-{print "ok $n\n";} else {print "not ok $n\n";}
+if ($@ =~ /Usage: .*?new\(class,\s?bits\)/)
+{print "ok $n\n";} else {print "not ok $n # $@\n";}
 $n++;
 
 eval { $set = Bit::Vector::new('main',17,1); };
-if ($@ =~ /Usage: .*?new\(class,bits\)/)
-{print "ok $n\n";} else {print "not ok $n\n";}
+if ($@ =~ /Usage: .*?new\(class,\s?bits\)/)
+{print "ok $n\n";} else {print "not ok $n # $@\n";}
 $n++;
 
 eval { $set = Bit::Vector::Create($set,'main',18); };
-if ($@ =~ /Usage: .*?Create\(class,bits\)/)
-{print "ok $n\n";} else {print "not ok $n\n";}
+if ($@ =~ /Usage: .*?Create\(class,\s?bits\)/)
+{print "ok $n\n";} else {print "not ok $n # $@\n";}
 $n++;
 
 eval { $set = Bit::Vector::new($set,19,'main'); };
-if ($@ =~ /Usage: .*?new\(class,bits\)/)
-{print "ok $n\n";} else {print "not ok $n\n";}
+if ($@ =~ /Usage: .*?new\(class,\s?bits\)/)
+{print "ok $n\n";} else {print "not ok $n # $@\n";}
 $n++;
 
 # test if size is correct:

======================

Embperl doesn't work; it goes into infinite recursion with this testcase:

[! sub call_a_sub(&) { my($proc)=@_; &$proc(); } !]
[$ sub x_tags $]
...
[$ endsub $]
...
[- call_a_sub { x_tags(@_) }; -]

I have mailed this (plus the obligarory :-/ MULTIPLICITY patch) to the
author.

======================

Our ticket system (loosely based on RT, but with a totally different
MySQL database as backend) still looks like it works OK (I didn't yet
test everything), so I consider this a qualified success.

We do need embperl, though, so we can't move this into production testing yet.
Other than that, though, 

-- 
Matthias Urlichs  |  noris network GmbH   |   smurf@noris.de  |  ICQ: 20193661
The quote was selected randomly. Really.    |      http://www.noris.de/~smurf/
-- 
One who is good for making excuses is seldom good for anything else.



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About