home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl501m.zip / patches / patch.1j < prev    next >
Text File  |  1995-06-05  |  76KB  |  2,731 lines
  1. # This is my patch  patch.1j for perl5.001.  See description below.
  2. #    Andy Dougherty        doughera@lafcol.lafayette.edu
  3. #
  4. exit 0   # In case someone runs sh on this patch.
  5.  
  6. This is my patch  patch.1j  for perl5.001.
  7.  
  8. To apply, change to your perl directory and apply with
  9.     patch -p1 -N  < thispatch.
  10.  
  11. After you apply this patch, I would recommend:
  12.     rm config.sh
  13.     sh Configure [whatever options you use]
  14.     make depend
  15.     make 
  16.     make test
  17.  
  18. Here are the highlights:
  19.     Linux fixes:  Now correctly sets & uses stdio _ptr and _cnt
  20.     tricks only when feasible (Configure, config_h.SH, config_H,
  21.     doio.c, sv.c x2p/str.c)
  22.  
  23.     #!path-to-perl fixed to use $binexp instead of $bin.  This should
  24.     really be fixed to do the correct perl start-up stuff.  Volunteers?
  25.     (c2ph.SH, h2ph.SH, h2xs.SH, makeaperl.SH, perldoc.SH,
  26.     pod/pod2*.SH, x2p/find2perl.SH, x2p/s2p.SH)
  27.  
  28.     hint updates:  hints/apollo.sh, hints/linux.sh, hints/freebsd.sh,
  29.     hints/sco_3.sh.
  30.  
  31.     xsubpp version 1.7.  (includes CASE support)
  32.  
  33.     pod/perlbot updates.
  34.  
  35.     my lib/AutoLoader patch (to use @INC).
  36.  
  37.     [ON]DBM_File/Makefile.PL now have a few hint files.
  38.  
  39.     Other sundry small things.
  40.  
  41. Patch and enjoy,
  42.  
  43.     Andy Dougherty        doughera@lafcol.lafayette.edu
  44.     Dept. of Physics
  45.     Lafayette College    Easton, PA  18042
  46.  
  47. Here's the file-by-file breakdown of what's included:
  48.  
  49. Configure
  50.     Checks if File_ptr(fp) and File_cnt(fp) can be assigned to.
  51.  
  52.     Fix typo:  s/sytem/system/
  53.  
  54. MANIFEST
  55.     Include new extension hint files.
  56.  
  57. README
  58.     Some clarifications, thanks to John Stoeffel.  Tell users how to
  59.     not use dynamic loading.
  60.  
  61. c2ph.SH
  62.     Use $binexp instead of $bin.
  63.  
  64. config_H
  65.     Updated to match config_h.SH.
  66.  
  67. config_h.SH
  68.     Include defines for whether File_ptr(fp) and File_cnt(fp)
  69.     can be assigned to.
  70.  
  71. doio.c
  72.     Use defines for whether File_ptr(fp) and File_cnt(fp) can be assigned to.
  73.  
  74. ext/DynaLoader/DynaLoader.pm
  75.     Improve error messages and a little documentation.
  76.  
  77. ext/NDBM_File/hints/solaris.pl
  78.     New hint file.
  79.  
  80. ext/ODBM_File/Makefile.PL
  81.     Removed -ldbm.nfs, since it's now in the sco hint file.
  82.  
  83. ext/ODBM_File/hints/sco.pl
  84. ext/ODBM_File/hints/solaris.pl
  85. ext/ODBM_File/hints/svr4.pl
  86.     New hint files.
  87.  
  88. h2ph.SH
  89. h2xs.SH
  90.     Use $binexp instead of $bin.
  91.  
  92. hints/apollo.sh
  93. hints/freebsd.sh
  94. hints/linux.sh
  95. hints/sco_3.sh
  96.     Updated.
  97.  
  98. lib/AutoLoader.pm
  99.     Eliminate else clause in sub import.
  100.  
  101.     Handle case where @INC contains relative paths.
  102.  
  103. lib/ExtUtils/xsubpp
  104.     Update to version 1.7.  This includes CASE support.
  105.  
  106. lib/I18N/Collate.pm
  107.     Updated documentation.
  108.  
  109. lib/ftp.pl
  110.     Look for socket.ph or sys/socket.ph
  111.  
  112. lib/getcwd.pl
  113.     Use defined().
  114.    
  115. makeaperl.SH
  116.     Use $binexp instead of $bin.
  117.  
  118. perl.c
  119.     fputs("\tUnofficial patchlevel 1j.\n",stdout);
  120.       
  121. perldoc.SH
  122.     Use $binexp instead of $bin.
  123.  
  124.     Turn off debugging messages.
  125.  
  126. pod/perlbot.pod
  127.     Updated.
  128.  
  129. pod/pod2html.SH
  130. pod/pod2latex.SH
  131. pod/pod2man.SH
  132.     Use $binexp instead of $bin.
  133.  
  134. sv.c
  135.     Use defines for whether File_ptr(fp) and File_cnt(fp) can be assigned to.
  136.  
  137. toke.c
  138.     Fix spelling of ambiguous.
  139.  
  140. x2p/find2perl.SH
  141. x2p/s2p.SH
  142.     Use $binexp instead of $bin.
  143.  
  144. x2p/str.c
  145.     Use defines for whether File_ptr(fp) and File_cnt(fp) can be assigned to.
  146.  
  147. Index: Configure
  148. Prereq:  3.0.1.7 
  149. *** perl5.001i/Configure    Wed May 31 09:19:09 1995
  150. --- perl5.001j/Configure    Mon Jun  5 12:23:03 1995
  151. ***************
  152. *** 20,26 ****
  153.   
  154.   # $Id: Head.U,v 3.0.1.7 1995/03/21 08:46:15 ram Exp $
  155.   #
  156. ! # Generated on Wed May 31 09:14:05 EDT 1995 [metaconfig 3.0 PL55]
  157.   
  158.   cat >/tmp/c1$$ <<EOF
  159.   ARGGGHHHH!!!!!
  160. --- 20,26 ----
  161.   
  162.   # $Id: Head.U,v 3.0.1.7 1995/03/21 08:46:15 ram Exp $
  163.   #
  164. ! # Generated on Mon Jun  5 12:18:53 EDT 1995 [metaconfig 3.0 PL55]
  165.   
  166.   cat >/tmp/c1$$ <<EOF
  167.   ARGGGHHHH!!!!!
  168. ***************
  169. *** 349,354 ****
  170. --- 349,356 ----
  171.   sockethdr=''
  172.   socketlib=''
  173.   d_statblks=''
  174. + d_stdio_cnt_lval=''
  175. + d_stdio_ptr_lval=''
  176.   d_stdiobase=''
  177.   d_stdstdio=''
  178.   stdio_base=''
  179. ***************
  180. *** 5610,5632 ****
  181.   if $contains '_IO_fpos_t' `./findhdr stdio.h` >/dev/null 2>&1 ; then
  182.       echo "(Looks like you have stdio.h from Linux.)"
  183.       case "$stdio_ptr" in
  184. !     '') stdio_ptr='((fp)->_IO_read_ptr)';;
  185.       esac
  186.       case "$stdio_cnt" in
  187. !     '') stdio_cnt='((fp)->_IO_read_end - (fp)->_IO_read_ptr)';;
  188.       esac
  189.       case "$stdio_base" in
  190.       '') stdio_base='((fp)->_IO_read_base)';;
  191.       esac
  192.       case "$stdio_bufsiz" in
  193. !     '') stdio_bufsiz='((fp)->_IO_read_end - (fp)->_IO_read_base))';;
  194.       esac
  195.   else
  196.       case "$stdio_ptr" in
  197. !     '') stdio_ptr='((fp)->_ptr)';;
  198.       esac
  199.       case "$stdio_cnt" in
  200. !     '') stdio_cnt='((fp)->_cnt)';;
  201.       esac
  202.       case "$stdio_base" in
  203.       '') stdio_base='((fp)->_base)';;
  204. --- 5612,5642 ----
  205.   if $contains '_IO_fpos_t' `./findhdr stdio.h` >/dev/null 2>&1 ; then
  206.       echo "(Looks like you have stdio.h from Linux.)"
  207.       case "$stdio_ptr" in
  208. !     '') stdio_ptr='((fp)->_IO_read_ptr)'
  209. !         ptr_lval=$define
  210. !         ;;
  211.       esac
  212.       case "$stdio_cnt" in
  213. !     '') stdio_cnt='((fp)->_IO_read_end - (fp)->_IO_read_ptr)'
  214. !         cnt_lval=$undef
  215. !         ;;
  216.       esac
  217.       case "$stdio_base" in
  218.       '') stdio_base='((fp)->_IO_read_base)';;
  219.       esac
  220.       case "$stdio_bufsiz" in
  221. !     '') stdio_bufsiz='((fp)->_IO_read_end - (fp)->_IO_read_base)';;
  222.       esac
  223.   else
  224.       case "$stdio_ptr" in
  225. !     '') stdio_ptr='((fp)->_ptr)'
  226. !         ptr_lval=$define
  227. !         ;;
  228.       esac
  229.       case "$stdio_cnt" in
  230. !     '') stdio_cnt='((fp)->_cnt)'
  231. !         cnt_lval=$define
  232. !         ;;
  233.       esac
  234.       case "$stdio_base" in
  235.       '') stdio_base='((fp)->_base)';;
  236. ***************
  237. *** 5667,5672 ****
  238. --- 5677,5702 ----
  239.   set d_stdstdio
  240.   eval $setvar
  241.   
  242. + : Can _ptr be used as an lvalue.  Only makes sense if we
  243. + : have a known stdio implementation.
  244. + case "$d_stdstdio" in
  245. + $define) val=$ptr_lval ;;
  246. + *) val=$undef ;;
  247. + esac
  248. + set d_stdio_ptr_lval
  249. + eval $setvar
  250. + 
  251. + 
  252. + : Can _cnt be used as an lvalue.  Only makes sense if we
  253. + : have a known stdio implementation.
  254. + case "$d_stdstdio" in
  255. + $define) val=$cnt_lval ;;
  256. + *) val=$undef ;;
  257. + esac
  258. + set d_stdio_cnt_lval
  259. + eval $setvar
  260. + 
  261. + 
  262.   : see if _base is also standard
  263.   val="$undef"
  264.   case "$d_stdstdio" in
  265. ***************
  266. *** 5834,5840 ****
  267.       eval $typedef
  268.       dflt="$clocktype"
  269.       echo " "
  270. !     rp="What type is returned by times() on this sytem?"
  271.       . ./myread
  272.       clocktype="$ans"
  273.   else
  274. --- 5864,5870 ----
  275.       eval $typedef
  276.       dflt="$clocktype"
  277.       echo " "
  278. !     rp="What type is returned by times() on this system?"
  279.       . ./myread
  280.       clocktype="$ans"
  281.   else
  282. ***************
  283. *** 7472,7478 ****
  284.       eval $typedef
  285.       dflt="$timetype"
  286.       echo " "
  287. !     rp="What type is returned by time() on this sytem?"
  288.       . ./myread
  289.       timetype="$ans"
  290.   else
  291. --- 7502,7508 ----
  292.       eval $typedef
  293.       dflt="$timetype"
  294.       echo " "
  295. !     rp="What type is returned by time() on this system?"
  296.       . ./myread
  297.       timetype="$ans"
  298.   else
  299. ***************
  300. *** 8174,8179 ****
  301. --- 8204,8211 ----
  302.   d_socket='$d_socket'
  303.   d_sockpair='$d_sockpair'
  304.   d_statblks='$d_statblks'
  305. + d_stdio_cnt_lval='$d_stdio_cnt_lval'
  306. + d_stdio_ptr_lval='$d_stdio_ptr_lval'
  307.   d_stdiobase='$d_stdiobase'
  308.   d_stdstdio='$d_stdstdio'
  309.   d_strchr='$d_strchr'
  310. Index: MANIFEST
  311. *** perl5.001i/MANIFEST    Tue May 30 13:45:16 1995
  312. --- perl5.001j/MANIFEST    Mon Jun  5 14:14:23 1995
  313. ***************
  314. *** 107,116 ****
  315. --- 107,120 ----
  316.   ext/NDBM_File/Makefile.PL    NDBM extension makefile writer
  317.   ext/NDBM_File/NDBM_File.pm    NDBM extension Perl module
  318.   ext/NDBM_File/NDBM_File.xs    NDBM extension external subroutines
  319. + ext/NDBM_File/hints/solaris.pl    Hint for NDBM_File for named architecture
  320.   ext/NDBM_File/typemap        NDBM extension interface types
  321.   ext/ODBM_File/Makefile.PL    ODBM extension makefile writer
  322.   ext/ODBM_File/ODBM_File.pm    ODBM extension Perl module
  323.   ext/ODBM_File/ODBM_File.xs    ODBM extension external subroutines
  324. + ext/ODBM_File/hints/sco.pl    Hint for ODBM_File for named architecture
  325. + ext/ODBM_File/hints/solaris.pl    Hint for ODBM_File for named architecture
  326. + ext/ODBM_File/hints/svr4.pl    Hint for ODBM_File for named architecture
  327.   ext/ODBM_File/typemap        ODBM extension interface types
  328.   ext/POSIX/Makefile.PL        POSIX extension makefile writer
  329.   ext/POSIX/POSIX.pm        POSIX extension Perl module
  330. Index: README
  331. *** perl5.001i/README    Tue May 30 16:00:51 1995
  332. --- perl5.001j/README    Fri Jun  2 11:38:22 1995
  333. ***************
  334. *** 68,92 ****
  335.       run ok, the defaults will usually be right.  It will then proceed to
  336.       make config.h, config.sh, and Makefile.  You may have to explicitly
  337.       say     sh Configure    to ensure that Configure is run under sh.
  338. !     If you're a hotshot, run Configure -d to take all the defaults,
  339. !     edit config.sh to patch up any flaws, and then run Configure -S.
  340.   
  341.       Configure supports a number of useful options.  Run Configure -h 
  342.       to get a listing.  To compile with gcc, for example, you can run 
  343.       Configure -Dcc=gcc, or answer 'gcc' at the cc prompt.  
  344.       
  345. !     If you wish to use gcc (or another alternative compiler))
  346.       you should use  Configure -Dcc=gcc.  That way, the the hints
  347.       files can set appropriate defaults.
  348.       
  349.       If you change compilers or make other significant changes, you should
  350.       probably _not_ re-use your old config.sh.  Simply remove it or
  351. !     rename it, e.g. mv config.sh config.sh.old.
  352. !     
  353. !     By default, perl will be installed in /usr/local/{bin, lib, man}.
  354. !     You can specify a different prefix for the default installation
  355. !     directory, when Configure prompts you or by using something like
  356. !     Configure -Dprefix=/whatever.
  357.   
  358.       You can also supply a file config.over to over-ride Configure's
  359.       guesses.  It will get loaded up at the very end, just before
  360. --- 68,101 ----
  361.       run ok, the defaults will usually be right.  It will then proceed to
  362.       make config.h, config.sh, and Makefile.  You may have to explicitly
  363.       say     sh Configure    to ensure that Configure is run under sh.
  364. !     If you're a hotshot, run Configure -d to take all the defaults
  365. !     and edit config.sh to patch up any flaws.
  366. ! 
  367. !     If you later make any changes to config.sh, you should propagate
  368. !     them to all the .SH files by running  Configure -S.
  369.   
  370.       Configure supports a number of useful options.  Run Configure -h 
  371.       to get a listing.  To compile with gcc, for example, you can run 
  372.       Configure -Dcc=gcc, or answer 'gcc' at the cc prompt.  
  373.       
  374. !     If you wish to use gcc (or another alternative compiler)
  375.       you should use  Configure -Dcc=gcc.  That way, the the hints
  376.       files can set appropriate defaults.
  377. + 
  378. +     By default, perl will be installed in /usr/local/{bin, lib, man}.
  379. +     You can specify a different 'prefix' for the default installation
  380. +     directory, when Configure prompts you or by using the Configure
  381. +     command line option -Dprefix='/some/directory'.
  382.       
  383. +     By default, perl will use dynamic extensions if your system
  384. +     supports it.  If you want to force perl to be compiled statically,
  385. +     you can either choose this when Configure prompts you or by using
  386. +     the Configure command line option -Uusedl
  387. + 
  388.       If you change compilers or make other significant changes, you should
  389.       probably _not_ re-use your old config.sh.  Simply remove it or
  390. !     rename it, e.g. mv config.sh config.sh.old.  Then rerun Configure
  391. !     with the options you want to use.
  392.   
  393.       You can also supply a file config.over to over-ride Configure's
  394.       guesses.  It will get loaded up at the very end, just before
  395. ***************
  396. *** 106,112 ****
  397.       can be done in cflags.SH.  For instance, to turn off the optimizer
  398.       on toke.c, find the line in the switch structure for toke.c and
  399.       put the command optimize='-g' before the ;;.  To change the C flags
  400. !     for all the files, edit config.sh and change either $ccflags or $optimize.
  401.   
  402.   3)  make depend
  403.   
  404. --- 115,123 ----
  405.       can be done in cflags.SH.  For instance, to turn off the optimizer
  406.       on toke.c, find the line in the switch structure for toke.c and
  407.       put the command optimize='-g' before the ;;.  To change the C flags
  408. !     for all the files, edit config.sh and change either $ccflags or $optimize,
  409. !     and then re-run  Configure -S ; make depend.
  410. ! 
  411.   
  412.   3)  make depend
  413.   
  414. Index: c2ph.SH
  415. *** perl5.001i/c2ph.SH    Tue Oct 18 12:18:34 1994
  416. --- perl5.001j/c2ph.SH    Thu Jun  1 11:20:10 1995
  417. ***************
  418. *** 21,27 ****
  419.   : by putting a backslash in front.  You may delete these comments.
  420.   rm -f c2ph
  421.   $spitshell >c2ph <<!GROK!THIS!
  422. ! #!$bin/perl
  423.   #
  424.   !GROK!THIS!
  425.   
  426. --- 21,27 ----
  427.   : by putting a backslash in front.  You may delete these comments.
  428.   rm -f c2ph
  429.   $spitshell >c2ph <<!GROK!THIS!
  430. ! #!$binexp/perl
  431.   #
  432.   !GROK!THIS!
  433.   
  434. Index: config_H
  435. Prereq:  3.0.1.3 
  436. *** perl5.001i/config_H    Tue May 30 16:01:51 1995
  437. --- perl5.001j/config_H    Mon Jun  5 12:19:31 1995
  438. ***************
  439. *** 14,20 ****
  440.    * $Id: Config_h.U,v 3.0.1.3 1995/01/30 14:25:39 ram Exp $
  441.    */
  442.   
  443. ! /* Configuration time: Tue May 30 13:05:37 EDT 1995
  444.    * Configured by: andy
  445.    * Target system: crystal crystal 3.2 2 i386 
  446.    */
  447. --- 14,20 ----
  448.    * $Id: Config_h.U,v 3.0.1.3 1995/01/30 14:25:39 ram Exp $
  449.    */
  450.   
  451. ! /* Configuration time: Fri Jun  2 14:50:10 EDT 1995
  452.    * Configured by: andy
  453.    * Target system: crystal crystal 3.2 2 i386 
  454.    */
  455. ***************
  456. *** 758,771 ****
  457. --- 758,781 ----
  458.    *    FILE structure pointed to by its argument. This macro will always be
  459.    *    defined if USE_STDIO_PTR is defined.
  460.    */
  461. + /* STDIO_PTR_LVALUE:
  462. +  *    This symbol is defined if the FILE_ptr macro can be used as an
  463. +  *    lvalue.
  464. +  */
  465.   /* FILE_cnt:
  466.    *    This macro is used to access the _cnt field (or equivalent) of the
  467.    *    FILE structure pointed to by its argument. This macro will always be
  468.    *    defined if USE_STDIO_PTR is defined.
  469.    */
  470. + /* STDIO_CNT_LVALUE:
  471. +  *    This symbol is defined if the FILE_cnt macro can be used as an
  472. +  *    lvalue.
  473. +  */
  474.   #ifdef USE_STDIO_PTR
  475.   #define FILE_ptr(fp)    ((fp)->_ptr)
  476. + #define STDIO_PTR_LVALUE
  477.   #define FILE_cnt(fp)    ((fp)->_cnt)
  478. + #define STDIO_CNT_LVALUE
  479.   #endif
  480.   
  481.   /* FILE_base:
  482. Index: config_h.SH
  483. Prereq:  3.0.1.3 
  484. *** perl5.001i/config_h.SH    Wed May 31 09:19:09 1995
  485. --- perl5.001j/config_h.SH    Mon Jun  5 12:23:03 1995
  486. ***************
  487. *** 772,785 ****
  488. --- 772,795 ----
  489.    *    FILE structure pointed to by its argument. This macro will always be
  490.    *    defined if USE_STDIO_PTR is defined.
  491.    */
  492. + /* STDIO_PTR_LVALUE:
  493. +  *    This symbol is defined if the FILE_ptr macro can be used as an
  494. +  *    lvalue.
  495. +  */
  496.   /* FILE_cnt:
  497.    *    This macro is used to access the _cnt field (or equivalent) of the
  498.    *    FILE structure pointed to by its argument. This macro will always be
  499.    *    defined if USE_STDIO_PTR is defined.
  500.    */
  501. + /* STDIO_CNT_LVALUE:
  502. +  *    This symbol is defined if the FILE_cnt macro can be used as an
  503. +  *    lvalue.
  504. +  */
  505.   #ifdef USE_STDIO_PTR
  506.   #define FILE_ptr(fp)    $stdio_ptr
  507. + #$d_stdio_ptr_lval STDIO_PTR_LVALUE
  508.   #define FILE_cnt(fp)    $stdio_cnt
  509. + #$d_stdio_cnt_lval STDIO_CNT_LVALUE
  510.   #endif
  511.   
  512.   /* FILE_base:
  513. Index: doio.c
  514. *** perl5.001i/doio.c    Thu May 18 15:31:16 1995
  515. --- perl5.001j/doio.c    Fri Jun  2 12:00:23 1995
  516. ***************
  517. *** 577,583 ****
  518.           (void)ungetc(ch, IoIFP(io));
  519.           return FALSE;
  520.       }
  521. ! #ifdef USE_STDIO_PTR
  522.       if (FILE_cnt(IoIFP(io)) < -1)
  523.           FILE_cnt(IoIFP(io)) = -1;
  524.   #endif
  525. --- 577,583 ----
  526.           (void)ungetc(ch, IoIFP(io));
  527.           return FALSE;
  528.       }
  529. ! #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
  530.       if (FILE_cnt(IoIFP(io)) < -1)
  531.           FILE_cnt(IoIFP(io)) = -1;
  532.   #endif
  533. Index: ext/DynaLoader/DynaLoader.pm
  534. *** perl5.001i/ext/DynaLoader/DynaLoader.pm    Thu May 25 11:45:15 1995
  535. --- perl5.001j/ext/DynaLoader/DynaLoader.pm    Fri Jun  2 13:59:28 1995
  536. ***************
  537. *** 9,33 ****
  538.   =head1 SYNOPSIS
  539.   
  540.       require DynaLoader;
  541. !     push (@ISA, 'DynaLoader');
  542.   
  543.   
  544.   =head1 DESCRIPTION
  545.   
  546. ! This specification defines a standard generic interface to the dynamic
  547.   linking mechanisms available on many platforms.  Its primary purpose is
  548.   to implement automatic dynamic loading of Perl modules.
  549.   
  550.   The DynaLoader is designed to be a very simple high-level
  551.   interface that is sufficiently general to cover the requirements
  552.   of SunOS, HP-UX, NeXT, Linux, VMS and other platforms.
  553.   
  554. ! It is also hoped that the interface will cover the needs of OS/2,
  555. ! NT etc and allow pseudo-dynamic linking (using C<ld -A> at runtime).
  556. ! 
  557. ! This document serves as both a specification for anyone wishing to
  558. ! implement the DynaLoader for a new platform and as a guide for
  559. ! anyone wishing to use the DynaLoader directly in an application.
  560.   
  561.   It must be stressed that the DynaLoader, by itself, is practically
  562.   useless for accessing non-Perl libraries because it provides almost no
  563. --- 9,33 ----
  564.   =head1 SYNOPSIS
  565.   
  566.       require DynaLoader;
  567. !     @ISA = qw(... DynaLoader ...);
  568.   
  569.   
  570.   =head1 DESCRIPTION
  571.   
  572. ! This document defines a standard generic interface to the dynamic
  573.   linking mechanisms available on many platforms.  Its primary purpose is
  574.   to implement automatic dynamic loading of Perl modules.
  575.   
  576. + This document serves as both a specification for anyone wishing to
  577. + implement the DynaLoader for a new platform and as a guide for
  578. + anyone wishing to use the DynaLoader directly in an application.
  579. + 
  580.   The DynaLoader is designed to be a very simple high-level
  581.   interface that is sufficiently general to cover the requirements
  582.   of SunOS, HP-UX, NeXT, Linux, VMS and other platforms.
  583.   
  584. ! It is also hoped that the interface will cover the needs of OS/2, NT
  585. ! etc and also allow pseudo-dynamic linking (using C<ld -A> at runtime).
  586.   
  587.   It must be stressed that the DynaLoader, by itself, is practically
  588.   useless for accessing non-Perl libraries because it provides almost no
  589. ***************
  590. *** 153,160 ****
  591.   and "$name".
  592.   
  593.   If any directories are included in @names they are searched before
  594. ! @dl_library_path.  Directories may be specified as B<-Ldir>.  Any other names
  595. ! are treated as filenames to be searched for.
  596.   
  597.   Using arguments of the form C<-Ldir> and C<-lname> is recommended.
  598.   
  599. --- 153,160 ----
  600.   and "$name".
  601.   
  602.   If any directories are included in @names they are searched before
  603. ! @dl_library_path.  Directories may be specified as B<-Ldir>.  Any other
  604. ! names are treated as filenames to be searched for.
  605.   
  606.   Using arguments of the form C<-Ldir> and C<-lname> is recommended.
  607.   
  608. ***************
  609. *** 174,181 ****
  610.   
  611.   To support these systems a dl_expandspec() function can be implemented
  612.   either in the F<dl_*.xs> file or code can be added to the autoloadable
  613. ! dl_expandspec(0 function in F<DynaLoader.pm>).  See F<DynaLoader.pm> for more
  614. ! information.
  615.   
  616.   =item dl_load_file()
  617.   
  618. --- 174,181 ----
  619.   
  620.   To support these systems a dl_expandspec() function can be implemented
  621.   either in the F<dl_*.xs> file or code can be added to the autoloadable
  622. ! dl_expandspec() function in F<DynaLoader.pm>.  See F<DynaLoader.pm> for
  623. ! more information.
  624.   
  625.   =item dl_load_file()
  626.   
  627. ***************
  628. *** 232,238 ****
  629.   
  630.   Return a list of symbol names which remain undefined after load_file().
  631.   Returns C<()> if not known.  Don't worry if your platform does not provide
  632. ! a mechanism for this.  Most do not need it and hence do not provide it.
  633.   
  634.   
  635.   =item dl_install_xsub()
  636. --- 232,239 ----
  637.   
  638.   Return a list of symbol names which remain undefined after load_file().
  639.   Returns C<()> if not known.  Don't worry if your platform does not provide
  640. ! a mechanism for this.  Most do not need it and hence do not provide it,
  641. ! they just return an empty list.
  642.   
  643.   
  644.   =item dl_install_xsub()
  645. ***************
  646. *** 308,322 ****
  647.   
  648.   =head1 AUTHOR
  649.   
  650.   This interface is based on the work and comments of (in no particular
  651.   order): Larry Wall, Robert Sanders, Dean Roehrich, Jeff Okamoto, Anno
  652. ! Siegel, Thomas Neumann, Paul Marquess, Charles Bailey, and others.
  653.   
  654.   Larry Wall designed the elegant inherited bootstrap mechanism and
  655.   implemented the first Perl 5 dynamic loader using it.
  656.   
  657. - Tim Bunce, 11 August 1994.
  658. - 
  659.   =cut
  660.   
  661.   #
  662. --- 309,323 ----
  663.   
  664.   =head1 AUTHOR
  665.   
  666. + Tim Bunce, 11 August 1994.
  667. + 
  668.   This interface is based on the work and comments of (in no particular
  669.   order): Larry Wall, Robert Sanders, Dean Roehrich, Jeff Okamoto, Anno
  670. ! Siegel, Thomas Neumann, Paul Marquess, Charles Bailey, myself and others.
  671.   
  672.   Larry Wall designed the elegant inherited bootstrap mechanism and
  673.   implemented the first Perl 5 dynamic loader using it.
  674.   
  675.   =cut
  676.   
  677.   #
  678. ***************
  679. *** 328,335 ****
  680.   
  681.   # Quote from Tolkien sugested by Anno Siegel.
  682.   #
  683. ! # Read ext/DynaLoader/README and DynaLoader.doc for
  684. ! # detailed information.
  685.   #
  686.   # Tim.Bunce@ig.co.uk, August 1994
  687.   
  688. --- 329,335 ----
  689.   
  690.   # Quote from Tolkien sugested by Anno Siegel.
  691.   #
  692. ! # Read ext/DynaLoader/README for detailed information.
  693.   #
  694.   # Tim.Bunce@ig.co.uk, August 1994
  695.   
  696. ***************
  697. *** 394,403 ****
  698.       local($module) = $args[0];
  699.       local(@dirs, $file);
  700.   
  701. !     croak "Usage: DynaLoader::bootstrap(module)"
  702. !     unless ($module);
  703.   
  704. !     croak "Can't load module $module, dynamic loading not available in this perl"
  705.       unless defined(&dl_load_file);
  706.   
  707.       print STDERR "DynaLoader::bootstrap($module)\n" if $dl_debug;
  708. --- 394,406 ----
  709.       local($module) = $args[0];
  710.       local(@dirs, $file);
  711.   
  712. !     confess "Usage: DynaLoader::bootstrap(module)" unless $module;
  713.   
  714. !     # A common error on platforms which don't support dynamic loading.
  715. !     # Since it's fatal and potentially confusing we give a detailed message.
  716. !     croak("Can't load module $module, dynamic loading not available in this perl.\n".
  717. !     "  (You may need to build a new perl executable which either supports\n".
  718. !     "  dynamic loading or has the $module module statically linked into it.)\n")
  719.       unless defined(&dl_load_file);
  720.   
  721.       print STDERR "DynaLoader::bootstrap($module)\n" if $dl_debug;
  722. ***************
  723. *** 496,504 ****
  724. --- 499,509 ----
  725.           # Deal with directories first:
  726.           #  Using a -L prefix is the preferred option (faster and more robust)
  727.           if (m:^-L:){ s/^-L//; push(@dirs, $_); next; }
  728. + 
  729.           #  Otherwise we try to try to spot directories by a heuristic
  730.           #  (this is a more complicated issue than it first appears)
  731.           if (m:/: && -d $_){   push(@dirs, $_); next; }
  732. + 
  733.           # VMS: we may be using native VMS directry syntax instead of
  734.           # Unix emulation, so check this as well
  735.           if ($vms && /[:>\]]/ && -d $_){   push(@dirs, $_); next; }
  736. Index: ext/NDBM_File/hints/solaris.pl
  737. *** /dev/null    Mon Jun  5 14:53:25 1995
  738. --- perl5.001j/ext/NDBM_File/hints/solaris.pl    Mon Jun  5 14:11:03 1995
  739. ***************
  740. *** 0 ****
  741. --- 1,3 ----
  742. + # -lucb has been reported to be fatal for perl5 on Solaris.
  743. + # Thus we deliberately don't include it here.
  744. + $att{LIBS} = ["-L/usr/local/lib -lndbm", "-ldbm"];
  745. Index: ext/ODBM_File/Makefile.PL
  746. *** perl5.001i/ext/ODBM_File/Makefile.PL    Wed Feb  8 19:43:08 1995
  747. --- perl5.001j/ext/ODBM_File/Makefile.PL    Mon Jun  5 15:03:44 1995
  748. ***************
  749. *** 1,2 ****
  750.   use ExtUtils::MakeMaker;
  751. ! WriteMakefile(LIBS => ["-ldbm.nfs", "-ldbm -lucb"]);
  752. --- 1,2 ----
  753.   use ExtUtils::MakeMaker;
  754. ! WriteMakefile(LIBS => ["-ldbm -lucb"]);
  755. Index: ext/ODBM_File/hints/sco.pl
  756. *** /dev/null    Mon Jun  5 14:53:25 1995
  757. --- perl5.001j/ext/ODBM_File/hints/sco.pl    Mon Jun  5 14:09:18 1995
  758. ***************
  759. *** 0 ****
  760. --- 1,4 ----
  761. + # Some versions of SCO contain a broken -ldbm library that is missing
  762. + # dbmclose.  Some of those might have a fixed library installed as
  763. + # -ldbm.nfs.
  764. + $att{LIBS} = ['-ldbm.nfs', '-ldbm'];
  765. Index: ext/ODBM_File/hints/solaris.pl
  766. *** /dev/null    Mon Jun  5 14:53:25 1995
  767. --- perl5.001j/ext/ODBM_File/hints/solaris.pl    Mon Jun  5 14:09:18 1995
  768. ***************
  769. *** 0 ****
  770. --- 1,3 ----
  771. + # -lucb has been reported to be fatal for perl5 on Solaris.
  772. + # Thus we deliberately don't include it here.
  773. + $att{LIBS} = ['-ldbm'];
  774. Index: ext/ODBM_File/hints/svr4.pl
  775. *** /dev/null    Mon Jun  5 14:53:25 1995
  776. --- perl5.001j/ext/ODBM_File/hints/svr4.pl    Mon Jun  5 14:09:18 1995
  777. ***************
  778. *** 0 ****
  779. --- 1,4 ----
  780. + # Some SVR4 systems may need to link against routines in -lucb for
  781. + # odbm.  Some may also need to link against -lc to pick up things like
  782. + # ecvt.
  783. + $att{LIBS} = ['-ldbm -lucb -lc'];
  784. Index: h2ph.SH
  785. *** perl5.001i/h2ph.SH    Sun Mar 12 01:49:00 1995
  786. --- perl5.001j/h2ph.SH    Thu Jun  1 11:20:39 1995
  787. ***************
  788. *** 21,27 ****
  789.   : by putting a backslash in front.  You may delete these comments.
  790.   rm -f h2ph
  791.   $spitshell >h2ph <<!GROK!THIS!
  792. ! #!$bin/perl
  793.   'di ';
  794.   'ds 00 \"';
  795.   'ig 00 ';
  796. --- 21,27 ----
  797.   : by putting a backslash in front.  You may delete these comments.
  798.   rm -f h2ph
  799.   $spitshell >h2ph <<!GROK!THIS!
  800. ! #!$binexp/perl
  801.   'di ';
  802.   'ds 00 \"';
  803.   'ig 00 ';
  804. Index: h2xs.SH
  805. *** perl5.001i/h2xs.SH    Wed Feb 22 14:36:55 1995
  806. --- perl5.001j/h2xs.SH    Thu Jun  1 11:20:46 1995
  807. ***************
  808. *** 18,24 ****
  809.   esac
  810.   echo "Extracting h2xs (with variable substitutions)"
  811.   $spitshell >h2xs <<!GROK!THIS!
  812. ! #!$bin/perl
  813.   !GROK!THIS!
  814.   
  815.   $spitshell >>h2xs <<'!NO!SUBS!'
  816. --- 18,24 ----
  817.   esac
  818.   echo "Extracting h2xs (with variable substitutions)"
  819.   $spitshell >h2xs <<!GROK!THIS!
  820. ! #!$binexp/perl
  821.   !GROK!THIS!
  822.   
  823.   $spitshell >>h2xs <<'!NO!SUBS!'
  824. Index: hints/apollo.sh
  825. *** perl5.001i/hints/apollo.sh    Tue Oct 18 12:32:32 1994
  826. --- perl5.001j/hints/apollo.sh    Fri Jun  2 11:29:54 1995
  827. ***************
  828. *** 1,6 ****
  829. ! optimize=''
  830. ! ccflags='-A cpu,mathchip -W0,-opt,2'
  831.   
  832.   cat <<'EOF'
  833.   Some tests may fail unless you use 'chacl -B'.  Also, op/stat
  834.   test 2 may fail occasionally because Apollo doesn't guarantee
  835. --- 1,20 ----
  836. ! # Info from Johann Klasek <jk@auto.tuwien.ac.at>
  837. ! # Merged by Andy Dougherty  <doughera@lafcol.lafayette.edu>
  838. ! # Last revised    Fri Jun  2 11:21:27 EDT 1995
  839.   
  840. + # uname -a looks like
  841. + # DomainOS newton 10.4.1 bsd4.3 425t
  842. + 
  843. + # We want to use both BSD includes and some of the features from the
  844. + # /sys5 includes.
  845. + ccflags="$ccflags -A cpu,mathchip -I/usr/include -I/sys5/usr/include"
  846. + 
  847. + # These adjustments are necessary (why?) to compile malloc.c.
  848. + freetype='void'
  849. + i_malloc='undef'
  850. + malloctype='void *'
  851. + 
  852. + # This info is left over from perl4.  
  853.   cat <<'EOF'
  854.   Some tests may fail unless you use 'chacl -B'.  Also, op/stat
  855.   test 2 may fail occasionally because Apollo doesn't guarantee
  856. ***************
  857. *** 8,13 ****
  858. --- 22,29 ----
  859.   file.  Finally, the sleep test will sometimes fail.  See the
  860.   sleep(3) man page to learn why.
  861.   
  862. + See hints/apollo.sh for hints on running h2ph.
  863. + 
  864.   And a note on ccflags:
  865.   
  866.       Lastly, while -A cpu,mathchip generates optimal code for your DN3500
  867. ***************
  868. *** 18,20 ****
  869. --- 34,51 ----
  870.                           -- Steve Vinoski
  871.   
  872.   EOF
  873. + 
  874. + # Running h2ph, on the other hand, presents a challenge. 
  875. + 
  876. + #The perl header files have to be generated with following commands
  877. + 
  878. + #sed 's|/usr/include|/sys5/usr/include|g' h2ph >h2ph.new && chmod +x h2ph.new
  879. + #(set cdir=`pwd`; cd /sys5/usr/include; $cdir/h2ph.new sys/* )
  880. + #(set cdir=`pwd`; cd /usr/include; $cdir/h2ph * sys/* machine/*)
  881. + 
  882. + #The SYS5 headers (only sys) are overlayed by the BSD headers.  It  seems
  883. + #all ok, but once I am going into details,  a  lot  of  limitations  from
  884. + #'h2ph' are coming up. Lines like "#define NODEV (dev_t)(-1)"  result  in
  885. + #syntax errors as converted by h2ph. 
  886. + 
  887. + # Generally, h2ph might need a lot of help.
  888. Index: hints/freebsd.sh
  889. *** perl5.001i/hints/freebsd.sh    Mon May 22 14:23:20 1995
  890. --- perl5.001j/hints/freebsd.sh    Fri Jun  2 10:58:00 1995
  891. ***************
  892. *** 33,39 ****
  893.       ;;
  894.   1.1*)    d_dlopen="$define"
  895.       cccdlflags='-DPIC -fpic'
  896. !     lddlflags='-Bshareable $lddlflags'
  897.       malloctype='void *'
  898.       groupstype='int'
  899.       d_setregid='undef'
  900. --- 33,39 ----
  901.       ;;
  902.   1.1*)    d_dlopen="$define"
  903.       cccdlflags='-DPIC -fpic'
  904. !     lddlflags="-Bshareable $lddlflags"
  905.       malloctype='void *'
  906.       groupstype='int'
  907.       d_setregid='undef'
  908. ***************
  909. *** 44,50 ****
  910.   2.0-RELEASE*)
  911.       d_dlopen="$define"
  912.       cccdlflags='-DPIC -fpic'
  913. !     lddlflags='-Bshareable $lddlflags'
  914.       d_setregid='undef'
  915.       d_setreuid='undef'
  916.       d_setrgid='undef'
  917. --- 44,50 ----
  918.   2.0-RELEASE*)
  919.       d_dlopen="$define"
  920.       cccdlflags='-DPIC -fpic'
  921. !     lddlflags="-Bshareable $lddlflags"
  922.       d_setregid='undef'
  923.       d_setreuid='undef'
  924.       d_setrgid='undef'
  925. ***************
  926. *** 58,64 ****
  927.   2.0.5*|2.0-BUILD|2.1*)
  928.       d_dlopen="$define"
  929.       cccdlflags='-DPIC -fpic'
  930. !     lddlflags='-Bshareable $lddlflags'
  931.       # Are these defines necessary?  Doesn't Configure find them
  932.       # correctly?
  933.       d_setregid='define'
  934. --- 58,64 ----
  935.   2.0.5*|2.0-BUILD|2.1*)
  936.       d_dlopen="$define"
  937.       cccdlflags='-DPIC -fpic'
  938. !     lddlflags="-Bshareable $lddlflags"
  939.       # Are these defines necessary?  Doesn't Configure find them
  940.       # correctly?
  941.       d_setregid='define'
  942. Index: hints/linux.sh
  943. *** perl5.001i/hints/linux.sh    Tue May 30 14:28:25 1995
  944. --- perl5.001j/hints/linux.sh    Fri Jun  2 10:20:55 1995
  945. ***************
  946. *** 80,87 ****
  947.   You don't have an ELF gcc.  I will use dld if possible.  If you are
  948.   using a version of DLD earlier than 3.2.6, or don't have it at all, you
  949.   should probably upgrade. If you are forced to use 3.2.4, you should
  950. ! uncomment a couple of lines in hints/linux.sh and rerun Configure to
  951. ! disallow shared libraries.
  952.   
  953.   EOM
  954.       lddlflags="-r $lddlflags"
  955. --- 80,87 ----
  956.   You don't have an ELF gcc.  I will use dld if possible.  If you are
  957.   using a version of DLD earlier than 3.2.6, or don't have it at all, you
  958.   should probably upgrade. If you are forced to use 3.2.4, you should
  959. ! uncomment a couple of lines in hints/linux.sh and restart Configure so
  960. ! that shared libraries will be disallowed.
  961.   
  962.   EOM
  963.       lddlflags="-r $lddlflags"
  964. ***************
  965. *** 96,118 ****
  966.       #ldflags="-static"
  967.       #so='none'
  968.   fi
  969. - rm -rf try.c a.out
  970.   
  971. ! case "$BASH_VERSION" in
  972. ! 1.14.3*)
  973. !     cat <<'EOM'
  974. ! 
  975. ! If you get failure of op/exec test #5 during the test phase, you probably
  976. ! have a buggy version of bash. Upgrading to a recent version (1.14.4 or
  977. ! later) should fix the problem.
  978.   
  979.   EOM
  980. ! ;;
  981. ! esac
  982.   
  983.   # In addition, on some systems there is a problem with perl and NDBM, which
  984.   # causes AnyDBM and NDBM_File to lock up. This is evidenced in the tests as
  985.   # AnyDBM just freezing.  Currently we disable NDBM for all linux systems.
  986.   # If someone can suggest a more robust test, that would be appreciated.
  987.   d_dbm_open=undef
  988.   
  989. --- 96,123 ----
  990.       #ldflags="-static"
  991.       #so='none'
  992.   fi
  993.   
  994. ! rm -f try.c a.out
  995. ! 
  996. ! if /bin/bash -c exit; then
  997. !   echo You appear to have a working bash. Good.
  998. ! else
  999. !   cat << 'EOM'
  1000. ! Warning: it would appear you have a defective bash shell installed. This is
  1001. ! likely to give you a failure of op/exec test #5 during the test phase of the
  1002. ! build, Upgrading to a recent version (1.14.4 or later) should fix the
  1003. ! problem.
  1004.   
  1005.   EOM
  1006. ! 
  1007. ! fi
  1008.   
  1009.   # In addition, on some systems there is a problem with perl and NDBM, which
  1010.   # causes AnyDBM and NDBM_File to lock up. This is evidenced in the tests as
  1011.   # AnyDBM just freezing.  Currently we disable NDBM for all linux systems.
  1012.   # If someone can suggest a more robust test, that would be appreciated.
  1013. + # This will generate a harmless message:
  1014. + # Hmm...You had some extra variables I don't know about...I'll try to keep 'em.
  1015. + #    Propagating recommended variable d_dbm_open
  1016.   d_dbm_open=undef
  1017.   
  1018. Index: hints/sco_3.sh
  1019. *** perl5.001i/hints/sco_3.sh    Tue Apr 11 16:14:41 1995
  1020. --- perl5.001j/hints/sco_3.sh    Mon Jun  5 11:50:11 1995
  1021. ***************
  1022. *** 39,41 ****
  1023. --- 39,45 ----
  1024.   # If you want to use nm, you'll probably have to use nm -p.  The
  1025.   # following does that for you:
  1026.   nm_opt='-p'
  1027. + 
  1028. + # I have received one report that you can't include utime.h in
  1029. + # pp_sys.c.  Uncomment the following line if that happens to you:
  1030. + # i_utime=undef
  1031. Index: lib/AutoLoader.pm
  1032. *** perl5.001i/lib/AutoLoader.pm    Thu May 25 14:33:45 1995
  1033. --- perl5.001j/lib/AutoLoader.pm    Mon Jun  5 14:47:15 1995
  1034. ***************
  1035. *** 43,64 ****
  1036.       goto &$AUTOLOAD;
  1037.   }
  1038.                               
  1039. ! sub import
  1040. ! {
  1041. !  my ($callclass, $callfile, $callline,$path,$callpack) = caller(0);
  1042. !  ($callpack = $callclass) =~ s#::#/#;
  1043. !  if (defined($path = $INC{$callpack . '.pm'}))
  1044. !   {
  1045. !    if ($path =~ s#^(.*)$callpack\.pm$#$1auto/$callpack/autosplit.ix# && -e $path) 
  1046. !     {
  1047. !      eval {require $path}; 
  1048. !      carp $@ if ($@);  
  1049.       } 
  1050. -    else 
  1051. -     {
  1052. -      croak "Have not loaded $callpack.pm";
  1053. -     }
  1054. -   }
  1055.   }
  1056.   
  1057.   1;
  1058. --- 43,72 ----
  1059.       goto &$AUTOLOAD;
  1060.   }
  1061.                               
  1062. ! sub import {
  1063. !     my ($callclass, $callfile, $callline,$path,$callpack) = caller(0);
  1064. !     ($callpack = $callclass) =~ s#::#/#;
  1065. !     # Try to find the autosplit index file.  Eg., if the call package
  1066. !     # is POSIX, then $INC{POSIX.pm} is something like
  1067. !     # '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in
  1068. !     # '/usr/local/lib/perl5/auto/POSIX/autosplit.ix', so we require that.
  1069. !     #
  1070. !     # However, if @INC is a relative path, this might not work.  If,
  1071. !     # for example, @INC = ('lib'), then
  1072. !     # $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require
  1073. !     # 'auto/POSIX/autosplit.ix' (without the leading 'lib').
  1074. !     #
  1075. !     if (defined($path = $INC{$callpack . '.pm'})) {
  1076. !     # Try absolute path name.
  1077. !     $path =~ s#^(.*)$callpack\.pm$#$1auto/$callpack/autosplit.ix#;
  1078. !     eval { require $path; };
  1079. !     # If that failed, try relative path with normal @INC searching.
  1080. !     if ($@) {
  1081. !         $path ="auto/$callpack/autosplit.ix";
  1082. !         eval { require $path; };
  1083. !     }
  1084. !     carp $@ if ($@);  
  1085.       } 
  1086.   }
  1087.   
  1088.   1;
  1089. Index: lib/ExtUtils/xsubpp
  1090. *** perl5.001i/lib/ExtUtils/xsubpp    Fri May 26 15:24:22 1995
  1091. --- perl5.001j/lib/ExtUtils/xsubpp    Mon Jun  5 12:10:44 1995
  1092. ***************
  1093. *** 132,145 ****
  1094.   When parsing the OUTPUT arguments check that they are all present in
  1095.   the corresponding input argument definitions.
  1096.   
  1097.   =head1 SEE ALSO
  1098.   
  1099.   perl(1)
  1100.   
  1101.   =cut
  1102.   
  1103.   # Global Constants
  1104. ! $XSUBPP_version = "1.4" ;
  1105.   
  1106.   $usage = "Usage: xsubpp [-C++] [-except] [-typemap typemap] file.xs\n";
  1107.   
  1108. --- 132,171 ----
  1109.   When parsing the OUTPUT arguments check that they are all present in
  1110.   the corresponding input argument definitions.
  1111.   
  1112. + =head2 1.5 
  1113. + 
  1114. + Changes by Paul Marquess <pmarquess@bfsec.bt.co.uk>, 1 June 1995.
  1115. + 
  1116. + Started tidy up to allow clean run using C<-w> flag. 
  1117. + 
  1118. + Added some more error checking.
  1119. + 
  1120. + The CASE: functionality now works.
  1121. + 
  1122. + =head2 1.6 
  1123. + 
  1124. + Changes by Paul Marquess <pmarquess@bfsec.bt.co.uk>, 3 June 1995.
  1125. + 
  1126. + Added some more error checking.
  1127. + 
  1128. + =head2 1.7 
  1129. + 
  1130. + Changes by Paul Marquess <pmarquess@bfsec.bt.co.uk>, 5 June 1995.
  1131. + 
  1132. + When an error or warning message is printed C<xsubpp> will now attempt
  1133. + to identify the exact line in the C<.xs> file where the fault occurs.
  1134. + This can be achieved in the majority of cases.
  1135. + 
  1136.   =head1 SEE ALSO
  1137.   
  1138.   perl(1)
  1139.   
  1140.   =cut
  1141.   
  1142. + use FileHandle ;
  1143. + 
  1144.   # Global Constants
  1145. ! $XSUBPP_version = "1.7" ;
  1146.   
  1147.   $usage = "Usage: xsubpp [-C++] [-except] [-typemap typemap] file.xs\n";
  1148.   
  1149. ***************
  1150. *** 155,162 ****
  1151.   chop($pwd = `pwd`);
  1152.   # Check for error message from VMS
  1153.   if ($pwd =~ /unrecognized command verb/) { $Is_VMS = 1; $pwd = $ENV{DEFAULT} }
  1154. ! ($dir, $filename) = @ARGV[0] =~ m#(.*)/(.*)#
  1155. !     or ($dir, $filename) = @ARGV[0] =~ m#(.*[>\]])(.*)#
  1156.       or ($dir, $filename) = ('.', $ARGV[0]);
  1157.   chdir($dir);
  1158.   
  1159. --- 181,188 ----
  1160.   chop($pwd = `pwd`);
  1161.   # Check for error message from VMS
  1162.   if ($pwd =~ /unrecognized command verb/) { $Is_VMS = 1; $pwd = $ENV{DEFAULT} }
  1163. ! ($dir, $filename) = $ARGV[0] =~ m#(.*)/(.*)#
  1164. !     or ($dir, $filename) = $ARGV[0] =~ m#(.*[>\]])(.*)#
  1165.       or ($dir, $filename) = ('.', $ARGV[0]);
  1166.   chdir($dir);
  1167.   
  1168. ***************
  1169. *** 196,201 ****
  1170. --- 222,228 ----
  1171.       open(TYPEMAP, $typemap) 
  1172.       or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
  1173.       $mode = Typemap;
  1174. +     $junk = "" ;
  1175.       $current = \$junk;
  1176.       while (<TYPEMAP>) {
  1177.       next if /^#/;
  1178. ***************
  1179. *** 209,215 ****
  1180.           # skip blank lines and comment lines
  1181.           next if /^$/ or /^#/ ;
  1182.           my @words = split (' ') ;
  1183. !         blurt("Error: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 columns\n"), next 
  1184.           unless @words >= 2 ;
  1185.           my $kind = pop @words ;
  1186.               TrimWhitespace($kind) ;
  1187. --- 236,242 ----
  1188.           # skip blank lines and comment lines
  1189.           next if /^$/ or /^#/ ;
  1190.           my @words = split (' ') ;
  1191. !         warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 columns\n"), next 
  1192.           unless @words >= 2 ;
  1193.           my $kind = pop @words ;
  1194.               TrimWhitespace($kind) ;
  1195. ***************
  1196. *** 251,256 ****
  1197. --- 278,285 ----
  1198.       $text;
  1199.   }
  1200.   
  1201. + open(F, $filename) or die "cannot open $filename: $!\n";
  1202. + 
  1203.   # Identify the version of xsubpp used
  1204.   $TimeStamp = localtime ;
  1205.   print <<EOM ;
  1206. ***************
  1207. *** 263,270 ****
  1208.   EOM
  1209.    
  1210.   
  1211. - open(F, $filename) or die "cannot open $filename: $!\n";
  1212. - 
  1213.   while (<F>) {
  1214.       last if ($Module, $foo, $Package, $foo1, $Prefix) =
  1215.       /^MODULE\s*=\s*([\w:]+)(\s+PACKAGE\s*=\s*([\w:]+))?(\s+PREFIX\s*=\s*(\S+))?\s*$/;
  1216. --- 292,297 ----
  1217. ***************
  1218. *** 276,281 ****
  1219. --- 303,309 ----
  1220.   sub fetch_para {
  1221.       # parse paragraph
  1222.       @line = ();
  1223. +     @line_no = () ;
  1224.       if ($lastline ne "") {
  1225.       if ($lastline =~
  1226.       /^MODULE\s*=\s*([\w:]+)(\s+PACKAGE\s*=\s*([\w:]+))?(\s+PREFIX\s*=\s*(\S+))?\s*$/) {
  1227. ***************
  1228. *** 294,303 ****
  1229.               !/^#[ \t]*(if|ifdef|ifndef|else|elif|endif|define|undef)\b/;
  1230.           last if /^\S/;
  1231.           }
  1232. !         push(@line, $_) if $_ ne "";
  1233.       }
  1234.       else {
  1235.           push(@line, $lastline);
  1236.       }
  1237.       $lastline = "";
  1238.       while (<F>) {
  1239. --- 322,332 ----
  1240.               !/^#[ \t]*(if|ifdef|ifndef|else|elif|endif|define|undef)\b/;
  1241.           last if /^\S/;
  1242.           }
  1243. !         push(@line, $_), push(@line_no, input_line_number F) if $_ ne "";
  1244.       }
  1245.       else {
  1246.           push(@line, $lastline);
  1247. +             push(@line_no, $lastline_no) ;
  1248.       }
  1249.       $lastline = "";
  1250.       while (<F>) {
  1251. ***************
  1252. *** 306,323 ****
  1253.           chop;
  1254.           if (/^\S/ && @line && $line[-1] eq "") {
  1255.           $lastline = $_;
  1256.           last;
  1257.           }
  1258.           else {
  1259.           push(@line, $_);
  1260.           }
  1261.       }
  1262. !     pop(@line) while @line && $line[-1] =~ /^\s*$/;
  1263.       }
  1264.       $PPCODE = grep(/PPCODE:/, @line);
  1265.       scalar @line;
  1266.   }
  1267.   
  1268.   while (&fetch_para) {
  1269.       # initialize info arrays
  1270.       undef(%args_match);
  1271. --- 335,355 ----
  1272.           chop;
  1273.           if (/^\S/ && @line && $line[-1] eq "") {
  1274.           $lastline = $_;
  1275. +                 $lastline_no = input_line_number F ;
  1276.           last;
  1277.           }
  1278.           else {
  1279.           push(@line, $_);
  1280. +                 push(@line_no, input_line_number F) ;
  1281.           }
  1282.       }
  1283. !     pop(@line), pop(@line_no) while @line && $line[-1] =~ /^\s*$/;
  1284.       }
  1285.       $PPCODE = grep(/PPCODE:/, @line);
  1286.       scalar @line;
  1287.   }
  1288.   
  1289. + PARAGRAPH:
  1290.   while (&fetch_para) {
  1291.       # initialize info arrays
  1292.       undef(%args_match);
  1293. ***************
  1294. *** 332,352 ****
  1295.   
  1296.       # extract return type, function name and arguments
  1297.       $ret_type = TidyType(shift(@line));
  1298.       if ($ret_type =~ /^BOOT:/) {
  1299.           push (@BootCode, @line, "", "") ;
  1300. !         next ;
  1301.       }
  1302.       if ($ret_type =~ /^static\s+(.*)$/) {
  1303.           $static = 1;
  1304.           $ret_type = $1;
  1305.       }
  1306.       $func_header = shift(@line);
  1307. !     ($func_name, $orig_args) =  $func_header =~ /^([\w:]+)\s*\((.*)\)$/;
  1308.       if ($func_name =~ /(.*)::(.*)/) {
  1309.           $class = $1;
  1310.           $func_name = $2;
  1311.       }
  1312.       ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/;
  1313.       push(@Func_name, "${Packid}_$func_name");
  1314.       push(@Func_pname, $pname);
  1315.       @args = split(/\s*,\s*/, $orig_args);
  1316. --- 364,400 ----
  1317.   
  1318.       # extract return type, function name and arguments
  1319.       $ret_type = TidyType(shift(@line));
  1320. + 
  1321.       if ($ret_type =~ /^BOOT:/) {
  1322.           push (@BootCode, @line, "", "") ;
  1323. !         next PARAGRAPH ;
  1324.       }
  1325. + 
  1326. +     # a function definition needs at least 2 lines
  1327. +     blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH
  1328. +     unless @line ;
  1329. + 
  1330.       if ($ret_type =~ /^static\s+(.*)$/) {
  1331.           $static = 1;
  1332.           $ret_type = $1;
  1333.       }
  1334.       $func_header = shift(@line);
  1335. !     blurt ("Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH
  1336. !     unless $func_header =~ /^([\w:]+)\s*\((.*)\)$/;
  1337. ! 
  1338. !     ($func_name, $orig_args) =  ($1, $2) ;
  1339.       if ($func_name =~ /(.*)::(.*)/) {
  1340.           $class = $1;
  1341.           $func_name = $2;
  1342.       }
  1343. +     $Prefix = '' unless defined $Prefix ; # keep -w happy
  1344.       ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/;
  1345. + 
  1346. +     # Check for duplicate function definition
  1347. +     blurt("Error: ignoring duplicate function definition '$func_name'"), next PARAGRAPH
  1348. +     if defined $Func_name{"${Packid}_$func_name"} ;
  1349. +     $Func_name{"${Packid}_$func_name"} ++ ;
  1350. + 
  1351.       push(@Func_name, "${Packid}_$func_name");
  1352.       push(@Func_pname, $pname);
  1353.       @args = split(/\s*,\s*/, $orig_args);
  1354. ***************
  1355. *** 368,374 ****
  1356.           if ($args[$i] =~ s/\.\.\.//) {
  1357.               $elipsis = 1;
  1358.               $min_args--;
  1359. !             if ($args[i] eq '' && $i == $num_args - 1) {
  1360.               pop(@args);
  1361.               last;
  1362.               }
  1363. --- 416,422 ----
  1364.           if ($args[$i] =~ s/\.\.\.//) {
  1365.               $elipsis = 1;
  1366.               $min_args--;
  1367. !             if ($args[$i] eq '' && $i == $num_args - 1) {
  1368.               pop(@args);
  1369.               last;
  1370.               }
  1371. ***************
  1372. *** 421,442 ****
  1373.       # Now do a block of some sort.
  1374.   
  1375.       $condnum = 0;
  1376.       if (!@line) {
  1377.       @line = "CLEANUP:";
  1378.       }
  1379.       while (@line) {
  1380. !     if ($_[0] =~ s/^\s*CASE\s*:\s*//) {
  1381.           $cond = shift(@line);
  1382.           if ($condnum == 0) {
  1383. !         print "    if ($cond)\n";
  1384.           }
  1385.           elsif ($cond ne '') {
  1386.           print "    else if ($cond)\n";
  1387.           }
  1388.           else {
  1389.           print "    else\n";
  1390.           }
  1391.           $condnum++;
  1392.       }
  1393.   
  1394.       if ($except) {
  1395. --- 469,499 ----
  1396.       # Now do a block of some sort.
  1397.   
  1398.       $condnum = 0;
  1399. +     $else_cond = 0 ;
  1400.       if (!@line) {
  1401.       @line = "CLEANUP:";
  1402.       }
  1403.       while (@line) {
  1404. !     if ($line[0] =~ s/^\s*CASE\s*:\s*//) {
  1405.           $cond = shift(@line);
  1406. +             TrimWhitespace($cond) ;
  1407.           if ($condnum == 0) {
  1408. !         # Check $cond is not blank
  1409. !         blurt("Error: First CASE: needs a condition") 
  1410. !             if $cond eq '' ;
  1411. !         print "    if ($cond)\n"
  1412.           }
  1413.           elsif ($cond ne '') {
  1414.           print "    else if ($cond)\n";
  1415.           }
  1416.           else {
  1417. +         blurt ("Error: Too many CASE: statements without a condition")
  1418. +             unless $else_cond ;
  1419. +                 ++ $else_cond  ;
  1420.           print "    else\n";
  1421.           }
  1422.           $condnum++;
  1423. +             $_ = '' ;
  1424.       }
  1425.   
  1426.       if ($except) {
  1427. ***************
  1428. *** 454,459 ****
  1429. --- 511,518 ----
  1430.       $thisdone = 0;
  1431.       $retvaldone = 0;
  1432.       $deferred = "";
  1433. +     %arg_list = () ;
  1434. +         $gotRETVAL = 0;
  1435.       while (@line) {
  1436.           $_ = shift(@line);
  1437.           last if /^\s*NOT_IMPLEMENTED_YET/;
  1438. ***************
  1439. *** 463,470 ****
  1440.                   # skip blank lines 
  1441.                   next if /^$/ ;
  1442.           my $line = $_ ;
  1443.             # check for optional initialisation code
  1444. !         my $var_init = $1 if s/\s*(=.*)$// ;
  1445.   
  1446.                   my @words = split (' ') ;
  1447.                   blurt("Error: invalid argument declaration '$line'"), next
  1448. --- 522,534 ----
  1449.                   # skip blank lines 
  1450.                   next if /^$/ ;
  1451.           my $line = $_ ;
  1452. + 
  1453. +                 # remove trailing semicolon if no initialisation
  1454. +                 s/\s*;+\s*$//g unless /=/ ;
  1455. + 
  1456.             # check for optional initialisation code
  1457. !         my $var_init = '' ;
  1458. !         $var_init = $1 if s/\s*(=.*)$// ;
  1459.   
  1460.                   my @words = split (' ') ;
  1461.                   blurt("Error: invalid argument declaration '$line'"), next
  1462. ***************
  1463. *** 472,480 ****
  1464.                   my $var_name = pop @words ;
  1465.           my $var_type = "@words" ;
  1466.   
  1467. -         # catch C style argument declaration (this could be made alowable syntax)
  1468. -         warn("Warning: ignored semicolon in $pname argument declaration '$_'\n")
  1469. -             if ($var_name =~ s/;//g); # eg SV *<tab>name;
  1470.           # catch many errors similar to: SV<tab>* name
  1471.           blurt("Error: invalid $pname argument name '$var_name' (type '$var_type')\n")
  1472.               unless ($var_name =~ m/^&?\w+$/);
  1473. --- 536,541 ----
  1474. ***************
  1475. *** 493,499 ****
  1476.           print "\t" . &map_type($var_type);
  1477.           $var_num = $args_match{$var_name};
  1478.           if ($var_addr{$var_name}) {
  1479. !             $func_args =~ s/\b($var_name)\b/&\1/;
  1480.           }
  1481.           if ($var_init !~ /^=\s*NO_INIT\s*$/) {
  1482.               if ($var_init !~ /^\s*$/) {
  1483. --- 554,560 ----
  1484.           print "\t" . &map_type($var_type);
  1485.           $var_num = $args_match{$var_name};
  1486.           if ($var_addr{$var_name}) {
  1487. !             $func_args =~ s/\b($var_name)\b/&$1/;
  1488.           }
  1489.           if ($var_init !~ /^=\s*NO_INIT\s*$/) {
  1490.               if ($var_init !~ /^\s*$/) {
  1491. ***************
  1492. *** 536,542 ****
  1493.               print $deferred;
  1494.               while (@line) {
  1495.                   $_ = shift(@line);
  1496. !                 die "PPCODE must be last thing"
  1497.                       if /^\s*(OUTPUT|CLEANUP|CASE)\s*:/;
  1498.                   print "$_\n";
  1499.               }
  1500. --- 597,603 ----
  1501.               print $deferred;
  1502.               while (@line) {
  1503.                   $_ = shift(@line);
  1504. !                 death ("PPCODE must be last thing")
  1505.                       if /^\s*(OUTPUT|CLEANUP|CASE)\s*:/;
  1506.                   print "$_\n";
  1507.               }
  1508. ***************
  1509. *** 572,597 ****
  1510.                   $func_name = $2;
  1511.               }
  1512.               print "$func_name($func_args);\n";
  1513. !             $wantRETVAL = 1 
  1514. !                     unless $ret_type eq "void";
  1515.           }
  1516.       }
  1517.   
  1518.       # do output variables
  1519.       if (/^\s*OUTPUT\s*:/) {
  1520. !         my $gotRETVAL ;
  1521.           my %outargs ;
  1522.           while (@line) {
  1523.               $_ = shift(@line);
  1524. !             last if /^\s*CLEANUP\s*:/;
  1525.               TrimWhitespace($_) ;
  1526.               next if /^$/ ;
  1527.               my ($outarg, $outcode) = /^(\S+)\s*(.*)/ ;
  1528.               if (!$gotRETVAL and $outarg eq 'RETVAL') {
  1529.                   # deal with RETVAL last
  1530. !                 push(@line, $_) ;
  1531.                   $gotRETVAL = 1 ;
  1532. -                 undef ($wantRETVAL) ;
  1533.                   next ;
  1534.               }
  1535.               blurt ("Error: duplicate OUTPUT argument '$outarg' ignored"), next
  1536. --- 633,657 ----
  1537.                   $func_name = $2;
  1538.               }
  1539.               print "$func_name($func_args);\n";
  1540. !                 $wantRETVAL = 1 unless $ret_type eq "void";
  1541.           }
  1542.       }
  1543.   
  1544.       # do output variables
  1545.       if (/^\s*OUTPUT\s*:/) {
  1546. !         $gotRETVAL = 0;
  1547. !         my $RETVAL_code ;
  1548.           my %outargs ;
  1549.           while (@line) {
  1550.               $_ = shift(@line);
  1551. !             last if /^\s*CLEANUP|CASE\s*:/;
  1552.               TrimWhitespace($_) ;
  1553.               next if /^$/ ;
  1554.               my ($outarg, $outcode) = /^(\S+)\s*(.*)/ ;
  1555.               if (!$gotRETVAL and $outarg eq 'RETVAL') {
  1556.                   # deal with RETVAL last
  1557. !                 $RETVAL_code = $outcode ;
  1558.                   $gotRETVAL = 1 ;
  1559.                   next ;
  1560.               }
  1561.               blurt ("Error: duplicate OUTPUT argument '$outarg' ignored"), next
  1562. ***************
  1563. *** 608,618 ****
  1564.                       $outarg); 
  1565.               }
  1566.           }
  1567.       }
  1568.   
  1569.       # all OUTPUT done, so now push the return value on the stack
  1570.       &generate_output($ret_type, 0, "RETVAL")
  1571. !          if $wantRETVAL ;
  1572.   
  1573.       # do cleanup
  1574.       if (/^\s*CLEANUP\s*:/) {
  1575. --- 668,685 ----
  1576.                       $outarg); 
  1577.               }
  1578.           }
  1579. + 
  1580. +         if ($gotRETVAL) {
  1581. +             if ($RETVAL_code) 
  1582. +                             { print "\t$RETVAL_code\n" }
  1583. +             else 
  1584. +                 { &generate_output($ret_type, 0, 'RETVAL') }
  1585. +         }
  1586.       }
  1587.   
  1588.       # all OUTPUT done, so now push the return value on the stack
  1589.       &generate_output($ret_type, 0, "RETVAL")
  1590. !          if $wantRETVAL and ! $gotRETVAL ;
  1591.   
  1592.       # do cleanup
  1593.       if (/^\s*CLEANUP\s*:/) {
  1594. ***************
  1595. *** 690,696 ****
  1596.       eval qq/print " $init\\\n"/;
  1597.   }
  1598.   
  1599. ! sub blurt { warn @_; $errors++ }
  1600.   
  1601.   sub generate_init {
  1602.       local($type, $num, $var) = @_;
  1603. --- 757,781 ----
  1604.       eval qq/print " $init\\\n"/;
  1605.   }
  1606.   
  1607. ! sub Warn
  1608. ! {
  1609. !     # work out the line number
  1610. !     my $line_no = $line_no[@line_no - @line -1] ;
  1611. !  
  1612. !     print STDERR "@_ in $filename, line $line_no\n" ;
  1613. ! }
  1614. ! 
  1615. ! sub blurt 
  1616. ! { 
  1617. !     Warn @_ ;
  1618. !     $errors ++ 
  1619. ! }
  1620. ! 
  1621. ! sub death
  1622. ! {
  1623. !     Warn @_ ;
  1624. !     exit 1 ;
  1625. ! }
  1626.   
  1627.   sub generate_init {
  1628.       local($type, $num, $var) = @_;
  1629. ***************
  1630. *** 700,706 ****
  1631.       local($tk);
  1632.   
  1633.       $type = TidyType($type) ;
  1634. !     blurt("Error: '$type' not in typemap"), return unless defined($type_kind{$type});
  1635.       ($ntype = $type) =~ s/\s*\*/Ptr/g;
  1636.       $subtype = $ntype;
  1637.       $subtype =~ s/Ptr$//;
  1638. --- 785,793 ----
  1639.       local($tk);
  1640.   
  1641.       $type = TidyType($type) ;
  1642. !     blurt("Error: '$type' not in typemap"), return 
  1643. !     unless defined($type_kind{$type});
  1644. ! 
  1645.       ($ntype = $type) =~ s/\s*\*/Ptr/g;
  1646.       $subtype = $ntype;
  1647.       $subtype =~ s/Ptr$//;
  1648. ***************
  1649. *** 708,715 ****
  1650. --- 795,808 ----
  1651.       $tk = $type_kind{$type};
  1652.       $tk =~ s/OBJ$/REF/ if $func_name =~ /DESTROY$/;
  1653.       $type =~ s/:/_/g;
  1654. +     blurt("Error: No INPUT definition for type '$type' found"), return
  1655. +         unless defined $input_expr{$tk} ;
  1656.       $expr = $input_expr{$tk};
  1657.       if ($expr =~ /DO_ARRAY_ELEM/) {
  1658. +         blurt("Error: '$subtype' not in typemap"), return 
  1659. +         unless defined($type_kind{$subtype});
  1660. +         blurt("Error: No INPUT definition for type '$subtype' found"), return
  1661. +             unless defined $input_expr{$type_kind{$subtype}} ;
  1662.       $subexpr = $input_expr{$type_kind{$subtype}};
  1663.       $subexpr =~ s/ntype/subtype/g;
  1664.       $subexpr =~ s/\$arg/ST(ix_$var)/g;
  1665. ***************
  1666. *** 743,748 ****
  1667. --- 836,843 ----
  1668.       } else {
  1669.           blurt("Error: '$type' not in typemap"), return
  1670.           unless defined($type_kind{$type});
  1671. +             blurt("Error: No OUTPUT definition for type '$type' found"), return
  1672. +                 unless defined $output_expr{$type_kind{$type}} ;
  1673.           ($ntype = $type) =~ s/\s*\*/Ptr/g;
  1674.           $ntype =~ s/\(\)//g;
  1675.           $subtype = $ntype;
  1676. ***************
  1677. *** 750,755 ****
  1678. --- 845,854 ----
  1679.           $subtype =~ s/Array$//;
  1680.           $expr = $output_expr{$type_kind{$type}};
  1681.           if ($expr =~ /DO_ARRAY_ELEM/) {
  1682. +             blurt("Error: '$subtype' not in typemap"), return
  1683. +             unless defined($type_kind{$subtype});
  1684. +                 blurt("Error: No OUTPUT definition for type '$subtype' found"), return
  1685. +                     unless defined $output_expr{$type_kind{$subtype}} ;
  1686.           $subexpr = $output_expr{$type_kind{$subtype}};
  1687.           $subexpr =~ s/ntype/subtype/g;
  1688.           $subexpr =~ s/\$arg/ST(ix_$var)/g;
  1689. ***************
  1690. *** 771,782 ****
  1691.           elsif ($arg =~ /^ST\(\d+\)$/) {
  1692.           eval "print qq\a$expr\a";
  1693.           }
  1694. -         elsif ($arg =~ /^ST\(\d+\)$/) {
  1695. -         eval "print qq\a$expr\a";
  1696. -         }
  1697. -         elsif ($arg =~ /^ST\(\d+\)$/) {
  1698. -         eval "print qq\a$expr\a";
  1699. -         }
  1700.       }
  1701.   }
  1702.   
  1703. --- 870,875 ----
  1704. ***************
  1705. *** 794,797 ****
  1706.   # If this is VMS, the exit status has meaning to the shell, so we
  1707.   # use a predictable value (SS$_Abort) rather than an arbitrary
  1708.   # number.
  1709. ! exit $Is_VMS ? 44 : $errors;
  1710. --- 887,890 ----
  1711.   # If this is VMS, the exit status has meaning to the shell, so we
  1712.   # use a predictable value (SS$_Abort) rather than an arbitrary
  1713.   # number.
  1714. ! exit ($Is_VMS ? 44 : $errors) ;
  1715. Index: lib/I18N/Collate.pm
  1716. *** perl5.001i/lib/I18N/Collate.pm    Thu May 25 11:30:29 1995
  1717. --- perl5.001j/lib/I18N/Collate.pm    Fri Jun  2 11:30:49 1995
  1718. ***************
  1719. *** 23,36 ****
  1720.   
  1721.   to extract the data itself, you'll need a dereference: $$s1
  1722.   
  1723. ! This uses POSIX::setlocale The basic collation conversion is done by
  1724.   strxfrm() which terminates at NUL characters being a decent C routine.
  1725.   collate_xfrm() handles embedded NUL characters gracefully.  Due to C<cmp>
  1726.   and overload magic, C<lt>, C<le>, C<eq>, C<ge>, and C<gt> work also.  The
  1727.   available locales depend on your operating system; try whether C<locale
  1728. ! -a> shows them or the more direct approach C<ls /usr/lib/nls/loc> or C<ls
  1729. ! /usr/lib/nls>.  The locale names are probably something like
  1730. ! "xx_XX.(ISO)?8859-N".
  1731.   
  1732.   =cut
  1733.   
  1734. --- 23,43 ----
  1735.   
  1736.   to extract the data itself, you'll need a dereference: $$s1
  1737.   
  1738. ! This uses POSIX::setlocale. The basic collation conversion is done by
  1739.   strxfrm() which terminates at NUL characters being a decent C routine.
  1740.   collate_xfrm() handles embedded NUL characters gracefully.  Due to C<cmp>
  1741.   and overload magic, C<lt>, C<le>, C<eq>, C<ge>, and C<gt> work also.  The
  1742.   available locales depend on your operating system; try whether C<locale
  1743. ! -a> shows them or man pages for "locale" or "nlsinfo" or
  1744. ! the direct approach C<ls /usr/lib/nls/loc> or C<ls
  1745. ! /usr/lib/nls>.  Not all the locales that your vendor supports
  1746. ! are necessarily installed: please consult your operating system's
  1747. ! documentation.
  1748. ! 
  1749. ! The locale names are probably something like
  1750. ! C<"xx_XX.(ISO)?8859-N"> or C<"xx_XX.(ISO)?8859N">, for example
  1751. ! C<"fr_CH.ISO8859-1"> is the Swiss (CH) variant of French (fr),
  1752. ! ISO Latin (8859) 1 (-1) which is the Western European character set.
  1753.   
  1754.   =cut
  1755.   
  1756. ***************
  1757. *** 54,60 ****
  1758.   # Overloads:    cmp # 3)
  1759.   #
  1760.   # Usage:    use Collate;
  1761. ! #            setlocale(&LC_COLLATE, 'locale-of-your-choice'); # 4)
  1762.   #        $s1 = new Collate "scalar_data_1";
  1763.   #        $s2 = new Collate "scalar_data_2";
  1764.   #        
  1765. --- 61,67 ----
  1766.   # Overloads:    cmp # 3)
  1767.   #
  1768.   # Usage:    use Collate;
  1769. ! #            setlocale(LC_COLLATE, 'locale-of-your-choice'); # 4)
  1770.   #        $s1 = new Collate "scalar_data_1";
  1771.   #        $s2 = new Collate "scalar_data_2";
  1772.   #        
  1773. ***************
  1774. *** 68,79 ****
  1775.   #           collate_xfrm handles embedded NUL characters gracefully.
  1776.   #        3) due to cmp and overload magic, lt le eq ge gt work also
  1777.   #        4) the available locales depend on your operating system;
  1778. ! #           try whether "locale -a" shows them or the more direct
  1779.   #           approach "ls /usr/lib/nls/loc" or "ls /usr/lib/nls".
  1780.   #           The locale names are probably something like
  1781. ! #           'xx_XX.(ISO)?8859-N'.
  1782.   #
  1783. ! # Updated:    19940913 1341 GMT
  1784.   #
  1785.   # ---
  1786.   
  1787. --- 75,93 ----
  1788.   #           collate_xfrm handles embedded NUL characters gracefully.
  1789.   #        3) due to cmp and overload magic, lt le eq ge gt work also
  1790.   #        4) the available locales depend on your operating system;
  1791. ! #           try whether "locale -a" shows them or man pages for
  1792. ! #           "locale" or "nlsinfo" work or the more direct
  1793.   #           approach "ls /usr/lib/nls/loc" or "ls /usr/lib/nls".
  1794. + #           Not all the locales that your vendor supports
  1795. + #           are necessarily installed: please consult your
  1796. + #           operating system's documentation.
  1797.   #           The locale names are probably something like
  1798. ! #           'xx_XX.(ISO)?8859-N' or 'xx_XX.(ISO)?8859N',
  1799. ! #           for example 'fr_CH.ISO8859-1' is the Swiss (CH)
  1800. ! #           variant of French (fr), ISO Latin (8859) 1 (-1)
  1801. ! #           which is the Western European character set.
  1802.   #
  1803. ! # Updated:    19950602 1601 GMT
  1804.   #
  1805.   # ---
  1806.   
  1807. Index: lib/ftp.pl
  1808. Prereq:  1.17 
  1809. *** perl5.001i/lib/ftp.pl    Tue Oct 18 12:36:16 1994
  1810. --- perl5.001j/lib/ftp.pl    Fri Jun  2 11:31:42 1995
  1811. ***************
  1812. *** 89,95 ****
  1813.   #
  1814.   
  1815.   require 'chat2.pl';
  1816. ! require 'socket.ph';
  1817.   
  1818.   
  1819.   package ftp;
  1820. --- 89,95 ----
  1821.   #
  1822.   
  1823.   require 'chat2.pl';
  1824. ! eval "require 'socket.ph'" || eval "require 'sys/socket.ph'" || die "socket.ph missing: $!\n";
  1825.   
  1826.   
  1827.   package ftp;
  1828. Index: lib/getcwd.pl
  1829. *** perl5.001i/lib/getcwd.pl    Tue Oct 18 12:36:19 1994
  1830. --- perl5.001j/lib/getcwd.pl    Fri Jun  2 11:33:24 1995
  1831. ***************
  1832. *** 36,42 ****
  1833.       {
  1834.           do
  1835.           {
  1836. !         unless ($dir = readdir(getcwd'PARENT))            #'))
  1837.           {
  1838.               warn "readdir($dotdots): $!";
  1839.               closedir(getcwd'PARENT);                #');
  1840. --- 36,42 ----
  1841.       {
  1842.           do
  1843.           {
  1844. !         unless (defined ($dir = readdir(getcwd'PARENT)))        #'))
  1845.           {
  1846.               warn "readdir($dotdots): $!";
  1847.               closedir(getcwd'PARENT);                #');
  1848. Index: makeaperl.SH
  1849. *** perl5.001i/makeaperl.SH    Wed Feb 22 14:37:20 1995
  1850. --- perl5.001j/makeaperl.SH    Thu Jun  1 11:20:52 1995
  1851. ***************
  1852. *** 18,24 ****
  1853.   esac
  1854.   echo "Extracting makeaperl (with variable substitutions)"
  1855.   $spitshell >makeaperl <<!GROK!THIS!
  1856. ! #!$bin/perl
  1857.   !GROK!THIS!
  1858.   
  1859.   $spitshell >>makeaperl <<'!NO!SUBS!'
  1860. --- 18,24 ----
  1861.   esac
  1862.   echo "Extracting makeaperl (with variable substitutions)"
  1863.   $spitshell >makeaperl <<!GROK!THIS!
  1864. ! #!$binexp/perl
  1865.   !GROK!THIS!
  1866.   
  1867.   $spitshell >>makeaperl <<'!NO!SUBS!'
  1868. Index: perl.c
  1869. *** perl5.001i/perl.c    Wed May 31 11:40:13 1995
  1870. --- perl5.001j/perl.c    Thu Jun  1 11:38:05 1995
  1871. ***************
  1872. *** 996,1002 ****
  1873.       return s;
  1874.       case 'v':
  1875.       printf("\nThis is perl, version %s\n\n",patchlevel);
  1876. !     fputs("\tUnofficial patchlevel 1i.\n",stdout);
  1877.       fputs("\nCopyright 1987-1994, Larry Wall\n",stdout);
  1878.   #ifdef MSDOS
  1879.       fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n",
  1880. --- 996,1002 ----
  1881.       return s;
  1882.       case 'v':
  1883.       printf("\nThis is perl, version %s\n\n",patchlevel);
  1884. !     fputs("\tUnofficial patchlevel 1j.\n",stdout);
  1885.       fputs("\nCopyright 1987-1994, Larry Wall\n",stdout);
  1886.   #ifdef MSDOS
  1887.       fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n",
  1888. Index: perldoc.SH
  1889. *** perl5.001i/perldoc.SH    Tue May 30 15:59:09 1995
  1890. --- perl5.001j/perldoc.SH    Mon Jun  5 12:12:27 1995
  1891. ***************
  1892. *** 18,24 ****
  1893.   esac
  1894.   echo "Extracting perldoc (with variable substitutions)"
  1895.   $spitshell >perldoc <<!GROK!THIS!
  1896. ! #!$bin/perl
  1897.   !GROK!THIS!
  1898.   
  1899.   $spitshell >>perldoc <<'!NO!SUBS!'
  1900. --- 18,24 ----
  1901.   esac
  1902.   echo "Extracting perldoc (with variable substitutions)"
  1903.   $spitshell >perldoc <<!GROK!THIS!
  1904. ! #!$binexp/perl
  1905.   !GROK!THIS!
  1906.   
  1907.   $spitshell >>perldoc <<'!NO!SUBS!'
  1908. ***************
  1909. *** 149,155 ****
  1910.   sub searchfor {
  1911.       my($s,@dirs) = @_;
  1912.       $s =~ s!::!/!g;
  1913. !     printf STDERR "looking for $s in @dirs\n";
  1914.       
  1915.       foreach $dir (@dirs) {
  1916.           if( -f "$dir/$s.pod") { return "$dir/$s.pod" }
  1917. --- 149,155 ----
  1918.   sub searchfor {
  1919.       my($s,@dirs) = @_;
  1920.       $s =~ s!::!/!g;
  1921. !     # printf STDERR "looking for $s in @dirs\n";
  1922.       
  1923.       foreach $dir (@dirs) {
  1924.           if( -f "$dir/$s.pod") { return "$dir/$s.pod" }
  1925. Index: pod/perlbot.pod
  1926. *** perl5.001i/pod/perlbot.pod    Mon May  8 15:44:20 1995
  1927. --- perl5.001j/pod/perlbot.pod    Fri Jun  2 16:08:59 1995
  1928. ***************
  1929. *** 1,6 ****
  1930.   =head1 NAME
  1931.   
  1932. ! perlbot - Bag'o Object Tricks For Perl5 (the BOT)
  1933.   
  1934.   =head1 INTRODUCTION
  1935.   
  1936. --- 1,6 ----
  1937.   =head1 NAME
  1938.   
  1939. ! perlbot - Bag'o Object Tricks (the BOT)
  1940.   
  1941.   =head1 INTRODUCTION
  1942.   
  1943. ***************
  1944. *** 8,18 ****
  1945.   appetites about such things as the use of instance variables and the
  1946.   mechanics of object and class relationships.  The reader is encouraged to
  1947.   consult relevant textbooks for discussion of Object Oriented definitions and
  1948. ! methodology.  This is not intended as a comprehensive guide to Perl5's
  1949. ! object oriented features, nor should it be construed as a style guide.
  1950.   
  1951.   The Perl motto still holds:  There's more than one way to do it.
  1952.   
  1953.   =head1 INSTANCE VARIABLES
  1954.   
  1955.   An anonymous array or anonymous hash can be used to hold instance
  1956. --- 8,79 ----
  1957.   appetites about such things as the use of instance variables and the
  1958.   mechanics of object and class relationships.  The reader is encouraged to
  1959.   consult relevant textbooks for discussion of Object Oriented definitions and
  1960. ! methodology.  This is not intended as a tutorial for object-oriented
  1961. ! programming or as a comprehensive guide to Perl's object oriented features,
  1962. ! nor should it be construed as a style guide.
  1963.   
  1964.   The Perl motto still holds:  There's more than one way to do it.
  1965.   
  1966. + =head1 OO SCALING TIPS
  1967. + 
  1968. + =over 5
  1969. + 
  1970. + =item 1
  1971. + 
  1972. + Do not attempt to verify the type of $self.  That'll break if the class is
  1973. + inherited, when the type of $self is valid but its package isn't what you
  1974. + expect.  See rule 5.
  1975. + 
  1976. + =item 2
  1977. + 
  1978. + If an object-oriented (OO) or indirect-object (IO) syntax was used, then the
  1979. + object is probably the correct type and there's no need to become paranoid
  1980. + about it.  Perl isn't a paranoid language anyway.  If people subvert the OO
  1981. + or IO syntax then they probably know what they're doing and you should let
  1982. + them do it.  See rule 1.
  1983. + 
  1984. + =item 3
  1985. + 
  1986. + Use the two-argument form of bless().  Let a subclass use your constructor.
  1987. + See L<INHERITING A CONSTRUCTOR>.
  1988. + 
  1989. + =item 4
  1990. + 
  1991. + The subclass is allowed to know things about its immediate superclass, the
  1992. + superclass is allowed to know nothing about a subclass.
  1993. + 
  1994. + =item 5
  1995. + 
  1996. + Don't be trigger happy with inheritance.  A "using", "containing", or
  1997. + "delegation" relationship (some sort of aggregation, at least) is often more
  1998. + appropriate.  See L<OBJECT RELATIONSHIPS>, L<USING RELATIONSHIP WITH SDBM>,
  1999. + and L<"DELEGATION">.
  2000. + 
  2001. + =item 6
  2002. + 
  2003. + The object is the namespace.  Make package globals accessible via the
  2004. + object.  This will remove the guess work about the symbol's home package.
  2005. + See L<CLASS CONTEXT AND THE OBJECT>.
  2006. + 
  2007. + =item 7
  2008. + 
  2009. + IO syntax is certainly less noisy, but it is also prone to ambiguities which
  2010. + can cause difficult-to-find bugs.  Allow people to use the sure-thing OO
  2011. + syntax, even if you don't like it.
  2012. + 
  2013. + =item 8
  2014. + 
  2015. + Do not use function-call syntax on a method.  You're going to be bitten
  2016. + someday.  Someone might move that method into a superclass and your code
  2017. + will be broken.  On top of that you're feeding the paranoia in rule 2.
  2018. + 
  2019. + =item 9
  2020. + 
  2021. + Don't assume you know the home package of a method.  You're making it
  2022. + difficult for someone to override that method.  See L<THINKING OF CODE REUSE>.
  2023. + 
  2024. + =back
  2025. + 
  2026.   =head1 INSTANCE VARIABLES
  2027.   
  2028.   An anonymous array or anonymous hash can be used to hold instance
  2029. ***************
  2030. *** 26,32 ****
  2031.           my $self = {};
  2032.           $self->{'High'} = $params{'High'};
  2033.           $self->{'Low'}  = $params{'Low'};
  2034. !         bless $self;
  2035.       }
  2036.   
  2037.   
  2038. --- 87,93 ----
  2039.           my $self = {};
  2040.           $self->{'High'} = $params{'High'};
  2041.           $self->{'Low'}  = $params{'Low'};
  2042. !         bless $self, $type;
  2043.       }
  2044.   
  2045.   
  2046. ***************
  2047. *** 38,57 ****
  2048.           my $self = [];
  2049.           $self->[0] = $params{'Left'};
  2050.           $self->[1] = $params{'Right'};
  2051. !         bless $self;
  2052.       }
  2053.   
  2054.       package main;
  2055.   
  2056. !     $a = new Foo ( 'High' => 42, 'Low' => 11 );
  2057.       print "High=$a->{'High'}\n";
  2058.       print "Low=$a->{'Low'}\n";
  2059.   
  2060. !     $b = new Bar ( 'Left' => 78, 'Right' => 40 );
  2061.       print "Left=$b->[0]\n";
  2062.       print "Right=$b->[1]\n";
  2063.   
  2064. - 
  2065.   =head1 SCALAR INSTANCE VARIABLES
  2066.   
  2067.   An anonymous scalar can be used when only one instance variable is needed.
  2068. --- 99,117 ----
  2069.           my $self = [];
  2070.           $self->[0] = $params{'Left'};
  2071.           $self->[1] = $params{'Right'};
  2072. !         bless $self, $type;
  2073.       }
  2074.   
  2075.       package main;
  2076.   
  2077. !     $a = Foo->new( 'High' => 42, 'Low' => 11 );
  2078.       print "High=$a->{'High'}\n";
  2079.       print "Low=$a->{'Low'}\n";
  2080.   
  2081. !     $b = Bar->new( 'Left' => 78, 'Right' => 40 );
  2082.       print "Left=$b->[0]\n";
  2083.       print "Right=$b->[1]\n";
  2084.   
  2085.   =head1 SCALAR INSTANCE VARIABLES
  2086.   
  2087.   An anonymous scalar can be used when only one instance variable is needed.
  2088. ***************
  2089. *** 62,73 ****
  2090.           my $type = shift;
  2091.           my $self;
  2092.           $self = shift;
  2093. !         bless \$self;
  2094.       }
  2095.   
  2096.       package main;
  2097.   
  2098. !     $a = new Foo 42;
  2099.       print "a=$$a\n";
  2100.   
  2101.   
  2102. --- 122,133 ----
  2103.           my $type = shift;
  2104.           my $self;
  2105.           $self = shift;
  2106. !         bless \$self, $type;
  2107.       }
  2108.   
  2109.       package main;
  2110.   
  2111. !     $a = Foo->new( 42 );
  2112.       print "a=$$a\n";
  2113.   
  2114.   
  2115. ***************
  2116. *** 81,103 ****
  2117.       package Bar;
  2118.   
  2119.       sub new {
  2120.           my $self = {};
  2121.           $self->{'buz'} = 42;
  2122. !         bless $self;
  2123.       }
  2124.   
  2125.       package Foo;
  2126.       @ISA = qw( Bar );
  2127.   
  2128.       sub new {
  2129. !         my $self = new Bar;
  2130.           $self->{'biz'} = 11;
  2131. !         bless $self;
  2132.       }
  2133.   
  2134.       package main;
  2135.   
  2136. !     $a = new Foo;
  2137.       print "buz = ", $a->{'buz'}, "\n";
  2138.       print "biz = ", $a->{'biz'}, "\n";
  2139.   
  2140. --- 141,165 ----
  2141.       package Bar;
  2142.   
  2143.       sub new {
  2144. +         my $type = shift;
  2145.           my $self = {};
  2146.           $self->{'buz'} = 42;
  2147. !         bless $self, $type;
  2148.       }
  2149.   
  2150.       package Foo;
  2151.       @ISA = qw( Bar );
  2152.   
  2153.       sub new {
  2154. !         my $type = shift;
  2155. !         my $self = Bar->new;
  2156.           $self->{'biz'} = 11;
  2157. !         bless $self, $type;
  2158.       }
  2159.   
  2160.       package main;
  2161.   
  2162. !     $a = Foo->new;
  2163.       print "buz = ", $a->{'buz'}, "\n";
  2164.       print "biz = ", $a->{'biz'}, "\n";
  2165.   
  2166. ***************
  2167. *** 111,133 ****
  2168.       package Bar;
  2169.   
  2170.       sub new {
  2171.           my $self = {};
  2172.           $self->{'buz'} = 42;
  2173. !         bless $self;
  2174.       }
  2175.   
  2176.       package Foo;
  2177.   
  2178.       sub new {
  2179.           my $self = {};
  2180. !         $self->{'Bar'} = new Bar ();
  2181.           $self->{'biz'} = 11;
  2182. !         bless $self;
  2183.       }
  2184.   
  2185.       package main;
  2186.   
  2187. !     $a = new Foo;
  2188.       print "buz = ", $a->{'Bar'}->{'buz'}, "\n";
  2189.       print "biz = ", $a->{'biz'}, "\n";
  2190.   
  2191. --- 173,197 ----
  2192.       package Bar;
  2193.   
  2194.       sub new {
  2195. +         my $type = shift;
  2196.           my $self = {};
  2197.           $self->{'buz'} = 42;
  2198. !         bless $self, $type;
  2199.       }
  2200.   
  2201.       package Foo;
  2202.   
  2203.       sub new {
  2204. +         my $type = shift;
  2205.           my $self = {};
  2206. !         $self->{'Bar'} = Bar->new;
  2207.           $self->{'biz'} = 11;
  2208. !         bless $self, $type;
  2209.       }
  2210.   
  2211.       package main;
  2212.   
  2213. !     $a = Foo->new;
  2214.       print "buz = ", $a->{'Bar'}->{'buz'}, "\n";
  2215.       print "biz = ", $a->{'biz'}, "\n";
  2216.   
  2217. ***************
  2218. *** 154,160 ****
  2219.       @ISA = qw( Bar Baz );
  2220.       @Foo::Inherit::ISA = @ISA;  # Access to overridden methods.
  2221.   
  2222. !     sub new { bless [] }
  2223.       sub grr { print "grumble\n" }
  2224.       sub goo {
  2225.           my $self = shift;
  2226. --- 218,227 ----
  2227.       @ISA = qw( Bar Baz );
  2228.       @Foo::Inherit::ISA = @ISA;  # Access to overridden methods.
  2229.   
  2230. !     sub new {
  2231. !         my $type = shift;
  2232. !         bless [], $type;
  2233. !     }
  2234.       sub grr { print "grumble\n" }
  2235.       sub goo {
  2236.           my $self = shift;
  2237. ***************
  2238. *** 171,197 ****
  2239.   
  2240.       package main;
  2241.   
  2242. !     $foo = new Foo;
  2243.       $foo->mumble;
  2244.       $foo->grr;
  2245.       $foo->goo;
  2246.       $foo->google;
  2247.   
  2248.   
  2249. ! =head1 USING RELATIONSHIP WITH SDBM 
  2250.   
  2251.   This example demonstrates an interface for the SDBM class.  This creates a
  2252.   "using" relationship between the SDBM class and the new class Mydbm.
  2253.   
  2254. -     use SDBM_File;
  2255. -     use POSIX;
  2256. - 
  2257.       package Mydbm;
  2258.   
  2259.       sub TIEHASH {
  2260. !         my $self = shift;
  2261.           my $ref  = SDBM_File->new(@_);
  2262. !         bless {'dbm' => $ref};
  2263.       }
  2264.       sub FETCH {
  2265.           my $self = shift;
  2266. --- 238,265 ----
  2267.   
  2268.       package main;
  2269.   
  2270. !     $foo = Foo->new;
  2271.       $foo->mumble;
  2272.       $foo->grr;
  2273.       $foo->goo;
  2274.       $foo->google;
  2275.   
  2276.   
  2277. ! =head1 USING RELATIONSHIP WITH SDBM
  2278.   
  2279.   This example demonstrates an interface for the SDBM class.  This creates a
  2280.   "using" relationship between the SDBM class and the new class Mydbm.
  2281.   
  2282.       package Mydbm;
  2283.   
  2284. +     require SDBM_File;
  2285. +     require TieHash;
  2286. +     @ISA = qw( TieHash );
  2287. + 
  2288.       sub TIEHASH {
  2289. !         my $type = shift;
  2290.           my $ref  = SDBM_File->new(@_);
  2291. !         bless {'dbm' => $ref}, $type;
  2292.       }
  2293.       sub FETCH {
  2294.           my $self = shift;
  2295. ***************
  2296. *** 209,214 ****
  2297. --- 277,283 ----
  2298.       }
  2299.   
  2300.       package main;
  2301. +     use Fcntl qw( O_RDWR O_CREAT );
  2302.   
  2303.       tie %foo, Mydbm, "Sdbm", O_RDWR|O_CREAT, 0640;
  2304.       $foo{'bar'} = 123;
  2305. ***************
  2306. *** 230,236 ****
  2307.   
  2308.       package FOO;
  2309.   
  2310. !     sub new { bless {} }
  2311.       sub bar {
  2312.           my $self = shift;
  2313.           $self->FOO::private::BAZ;
  2314. --- 299,308 ----
  2315.   
  2316.       package FOO;
  2317.   
  2318. !     sub new {
  2319. !         my $type = shift;
  2320. !         bless {}, $type;
  2321. !     }
  2322.       sub bar {
  2323.           my $self = shift;
  2324.           $self->FOO::private::BAZ;
  2325. ***************
  2326. *** 253,259 ****
  2327.   
  2328.       package FOO;
  2329.   
  2330. !     sub new { bless {} }
  2331.       sub bar {
  2332.           my $self = shift;
  2333.           $self->FOO::private::BAZ;
  2334. --- 325,334 ----
  2335.   
  2336.       package FOO;
  2337.   
  2338. !     sub new {
  2339. !         my $type = shift;
  2340. !         bless {}, $type;
  2341. !     }
  2342.       sub bar {
  2343.           my $self = shift;
  2344.           $self->FOO::private::BAZ;
  2345. ***************
  2346. *** 267,273 ****
  2347.   
  2348.       package GOOP;
  2349.       @ISA = qw( FOO );
  2350. !     sub new { bless {} }
  2351.   
  2352.       sub BAZ {
  2353.           print "in GOOP::BAZ\n";
  2354. --- 342,351 ----
  2355.   
  2356.       package GOOP;
  2357.       @ISA = qw( FOO );
  2358. !     sub new {
  2359. !         my $type = shift;
  2360. !         bless {}, $type;
  2361. !     }
  2362.   
  2363.       sub BAZ {
  2364.           print "in GOOP::BAZ\n";
  2365. ***************
  2366. *** 284,290 ****
  2367.   
  2368.       package FOO;
  2369.   
  2370. !     sub new { bless {} }
  2371.       sub bar {
  2372.           my $self = shift;
  2373.           $self->BAZ;
  2374. --- 362,371 ----
  2375.   
  2376.       package FOO;
  2377.   
  2378. !     sub new {
  2379. !         my $type = shift;
  2380. !         bless {}, $type;
  2381. !     }
  2382.       sub bar {
  2383.           my $self = shift;
  2384.           $self->BAZ;
  2385. ***************
  2386. *** 297,303 ****
  2387.       package GOOP;
  2388.       @ISA = qw( FOO );
  2389.   
  2390. !     sub new { bless {} }
  2391.       sub BAZ {
  2392.           print "in GOOP::BAZ\n";
  2393.       }
  2394. --- 378,387 ----
  2395.       package GOOP;
  2396.       @ISA = qw( FOO );
  2397.   
  2398. !     sub new {
  2399. !         my $type = shift;
  2400. !         bless {}, $type;
  2401. !     }
  2402.       sub BAZ {
  2403.           print "in GOOP::BAZ\n";
  2404.       }
  2405. ***************
  2406. *** 330,338 ****
  2407.       %fizzle = ( 'Password' => 'XYZZY' );
  2408.   
  2409.       sub new {
  2410.           my $self = {};
  2411.           $self->{'fizzle'} = \%fizzle;
  2412. !         bless $self;
  2413.       }
  2414.   
  2415.       sub enter {
  2416. --- 414,423 ----
  2417.       %fizzle = ( 'Password' => 'XYZZY' );
  2418.   
  2419.       sub new {
  2420. +         my $type = shift;
  2421.           my $self = {};
  2422.           $self->{'fizzle'} = \%fizzle;
  2423. !         bless $self, $type;
  2424.       }
  2425.   
  2426.       sub enter {
  2427. ***************
  2428. *** 353,361 ****
  2429.       %fizzle = ( 'Password' => 'Rumple' );
  2430.   
  2431.       sub new {
  2432.           my $self = Bar->new;
  2433.           $self->{'fizzle'} = \%fizzle;
  2434. !         bless $self;
  2435.       }
  2436.   
  2437.       package main;
  2438. --- 438,447 ----
  2439.       %fizzle = ( 'Password' => 'Rumple' );
  2440.   
  2441.       sub new {
  2442. +         my $type = shift;
  2443.           my $self = Bar->new;
  2444.           $self->{'fizzle'} = \%fizzle;
  2445. !         bless $self, $type;
  2446.       }
  2447.   
  2448.       package main;
  2449. Index: pod/pod2html.SH
  2450. *** perl5.001i/pod/pod2html.SH    Thu Apr 13 10:34:13 1995
  2451. --- perl5.001j/pod/pod2html.SH    Thu Jun  1 11:21:35 1995
  2452. ***************
  2453. *** 17,24 ****
  2454.   echo "Extracting pod/pod2html (with variable substitutions)"
  2455.   rm -f pod2html
  2456.   $spitshell >pod2html <<!GROK!THIS!
  2457. ! #!$bin/perl
  2458. ! eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
  2459.       if \$running_under_some_shell;
  2460.   !GROK!THIS!
  2461.   
  2462. --- 17,24 ----
  2463.   echo "Extracting pod/pod2html (with variable substitutions)"
  2464.   rm -f pod2html
  2465.   $spitshell >pod2html <<!GROK!THIS!
  2466. ! #!$binexp/perl
  2467. ! eval 'exec perl -S \$0 \${1+"\$@"}'
  2468.       if \$running_under_some_shell;
  2469.   !GROK!THIS!
  2470.   
  2471. Index: pod/pod2latex.SH
  2472. *** perl5.001i/pod/pod2latex.SH    Thu Apr 13 12:20:39 1995
  2473. --- perl5.001j/pod/pod2latex.SH    Thu Jun  1 11:21:45 1995
  2474. ***************
  2475. *** 17,24 ****
  2476.   echo "Extracting pod/pod2latex (with variable substitutions)"
  2477.   rm -f pod2latex
  2478.   $spitshell >pod2latex <<!GROK!THIS!
  2479. ! #!$bin/perl
  2480. ! eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
  2481.       if \$running_under_some_shell;
  2482.   !GROK!THIS!
  2483.   
  2484. --- 17,24 ----
  2485.   echo "Extracting pod/pod2latex (with variable substitutions)"
  2486.   rm -f pod2latex
  2487.   $spitshell >pod2latex <<!GROK!THIS!
  2488. ! #!$binexp/perl
  2489. ! eval 'exec perl -S \$0 \${1+"\$@"}'
  2490.       if \$running_under_some_shell;
  2491.   !GROK!THIS!
  2492.   
  2493. Index: pod/pod2man.SH
  2494. Prereq:  1.5 
  2495. *** perl5.001i/pod/pod2man.SH    Thu Apr 13 10:34:04 1995
  2496. --- perl5.001j/pod/pod2man.SH    Thu Jun  1 11:21:53 1995
  2497. ***************
  2498. *** 17,24 ****
  2499.   echo "Extracting pod/pod2man (with variable substitutions)"
  2500.   rm -f pod2man
  2501.   $spitshell >pod2man <<!GROK!THIS!
  2502. ! #!$bin/perl
  2503. ! eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
  2504.       if \$running_under_some_shell;
  2505.   !GROK!THIS!
  2506.   
  2507. --- 17,24 ----
  2508.   echo "Extracting pod/pod2man (with variable substitutions)"
  2509.   rm -f pod2man
  2510.   $spitshell >pod2man <<!GROK!THIS!
  2511. ! #!$binexp/perl
  2512. ! eval 'exec perl -S \$0 \${1+"\$@"}'
  2513.       if \$running_under_some_shell;
  2514.   !GROK!THIS!
  2515.   
  2516. Index: sv.c
  2517. *** perl5.001i/sv.c    Wed May 24 14:27:52 1995
  2518. --- perl5.001j/sv.c    Fri Jun  2 12:03:04 1995
  2519. ***************
  2520. *** 2368,2374 ****
  2521.   I32 append;
  2522.   {
  2523.       register char *bp;        /* we're going to steal some values */
  2524. ! #ifdef USE_STDIO_PTR
  2525.       register I32 cnt;        /*  from the stdio struct and put EVERYTHING */
  2526.       register STDCHAR *ptr;    /*   in the innermost loop into registers */
  2527.       STRLEN bpx;
  2528. --- 2368,2374 ----
  2529.   I32 append;
  2530.   {
  2531.       register char *bp;        /* we're going to steal some values */
  2532. ! #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
  2533.       register I32 cnt;        /*  from the stdio struct and put EVERYTHING */
  2534.       register STDCHAR *ptr;    /*   in the innermost loop into registers */
  2535.       STRLEN bpx;
  2536. ***************
  2537. *** 2398,2404 ****
  2538.           }
  2539.       } while (i != EOF);
  2540.       }
  2541. ! #ifdef USE_STDIO_PTR    /* Here is some breathtakingly efficient cheating */
  2542.       cnt = FILE_cnt(fp);            /* get count into register */
  2543.       (void)SvPOK_only(sv);        /* validate pointer */
  2544.       if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */
  2545. --- 2398,2405 ----
  2546.           }
  2547.       } while (i != EOF);
  2548.       }
  2549. ! #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
  2550. !     /* Here is some breathtakingly efficient cheating */
  2551.       cnt = FILE_cnt(fp);            /* get count into register */
  2552.       (void)SvPOK_only(sv);        /* validate pointer */
  2553.       if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */
  2554. ***************
  2555. *** 2466,2473 ****
  2556.       *bp = '\0';
  2557.       SvCUR_set(sv, bp - SvPVX(sv));    /* set length */
  2558.   
  2559. ! #else /* !USE_STDIO_PTR */    /* The big, slow, and stupid way */
  2560. ! 
  2561.       {
  2562.       char buf[8192];
  2563.       register char * bpe = buf + sizeof(buf) - 3;
  2564. --- 2467,2474 ----
  2565.       *bp = '\0';
  2566.       SvCUR_set(sv, bp - SvPVX(sv));    /* set length */
  2567.   
  2568. ! #else /* USE_STDIO_PTR && STDIO_PTR_LVALUE && STDIO_CNT_LVALUE */
  2569. !     /*The big, slow, and stupid way */
  2570.       {
  2571.       char buf[8192];
  2572.       register char * bpe = buf + sizeof(buf) - 3;
  2573. ***************
  2574. *** 2499,2505 ****
  2575.       }
  2576.       }
  2577.   
  2578. ! #endif /* USE_STDIO_PTR */
  2579.   
  2580.       if (rspara) {
  2581.           while (i != EOF) {
  2582. --- 2500,2506 ----
  2583.       }
  2584.       }
  2585.   
  2586. ! #endif /* USE_STDIO_PTR && STDIO_PTR_LVALUE && STDIO_CNT_LVALUE */
  2587.   
  2588.       if (rspara) {
  2589.           while (i != EOF) {
  2590. Index: toke.c
  2591. *** perl5.001i/toke.c    Fri May 26 15:24:57 1995
  2592. --- perl5.001j/toke.c    Mon Jun  5 12:11:34 1995
  2593. ***************
  2594. *** 2366,2372 ****
  2595.               TOKEN('&');
  2596.               }
  2597.               if (lastchar == '-')
  2598. !             warn("Ambiguious use of -%s resolved as -&%s()",
  2599.                   tokenbuf, tokenbuf);
  2600.               last_lop = oldbufptr;
  2601.               last_lop_op = OP_ENTERSUB;
  2602. --- 2366,2372 ----
  2603.               TOKEN('&');
  2604.               }
  2605.               if (lastchar == '-')
  2606. !             warn("Ambiguous use of -%s resolved as -&%s()",
  2607.                   tokenbuf, tokenbuf);
  2608.               last_lop = oldbufptr;
  2609.               last_lop_op = OP_ENTERSUB;
  2610. ***************
  2611. *** 2401,2407 ****
  2612.           if (lastchar && strchr("*%&", lastchar)) {
  2613.               warn("Operator or semicolon missing before %c%s",
  2614.               lastchar, tokenbuf);
  2615. !             warn("Ambiguious use of %c resolved as operator %c",
  2616.               lastchar, lastchar);
  2617.           }
  2618.           TOKEN(WORD);
  2619. --- 2401,2407 ----
  2620.           if (lastchar && strchr("*%&", lastchar)) {
  2621.               warn("Operator or semicolon missing before %c%s",
  2622.               lastchar, tokenbuf);
  2623. !             warn("Ambiguous use of %c resolved as operator %c",
  2624.               lastchar, lastchar);
  2625.           }
  2626.           TOKEN(WORD);
  2627. Index: x2p/find2perl.SH
  2628. *** perl5.001i/x2p/find2perl.SH    Tue Oct 18 12:47:36 1994
  2629. --- perl5.001j/x2p/find2perl.SH    Thu Jun  1 11:22:09 1995
  2630. ***************
  2631. *** 23,29 ****
  2632.   : by putting a backslash in front.  You may delete these comments.
  2633.   rm -f find2perl
  2634.   $spitshell >find2perl <<!GROK!THIS!
  2635. ! #!$bin/perl
  2636.   # 
  2637.   # Modified September 26, 1993 to provide proper handling of years after 1999
  2638.   #   Tom Link <tml+@pitt.edu>
  2639. --- 23,29 ----
  2640.   : by putting a backslash in front.  You may delete these comments.
  2641.   rm -f find2perl
  2642.   $spitshell >find2perl <<!GROK!THIS!
  2643. ! #!$binexp/perl
  2644.   # 
  2645.   # Modified September 26, 1993 to provide proper handling of years after 1999
  2646.   #   Tom Link <tml+@pitt.edu>
  2647. Index: x2p/s2p.SH
  2648. *** perl5.001i/x2p/s2p.SH    Tue Oct 18 12:47:48 1994
  2649. --- perl5.001j/x2p/s2p.SH    Thu Jun  1 11:32:48 1995
  2650. ***************
  2651. *** 24,32 ****
  2652.   : by putting a backslash in front.  You may delete these comments.
  2653.   rm -f s2p
  2654.   $spitshell >s2p <<!GROK!THIS!
  2655. ! #!$bin/perl
  2656.   
  2657. ! eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
  2658.       if \$running_under_some_shell;
  2659.   
  2660.   \$bin = '$bin';
  2661. --- 24,32 ----
  2662.   : by putting a backslash in front.  You may delete these comments.
  2663.   rm -f s2p
  2664.   $spitshell >s2p <<!GROK!THIS!
  2665. ! #!$binexp/perl
  2666.   
  2667. ! eval 'exec perl -S \$0 \${1+"\$@"}'
  2668.       if \$running_under_some_shell;
  2669.   
  2670.   \$bin = '$bin';
  2671. Index: x2p/str.c
  2672. *** perl5.001i/x2p/str.c    Tue May 23 14:12:27 1995
  2673. --- perl5.001j/x2p/str.c    Fri Jun  2 12:01:49 1995
  2674. ***************
  2675. *** 287,293 ****
  2676.   register STR *str;
  2677.   register FILE *fp;
  2678.   {
  2679. ! #ifdef USE_STDIO_PTR        /* Here is some breathtakingly efficient cheating */
  2680.   
  2681.       register char *bp;        /* we're going to steal some values */
  2682.       register int cnt;        /*  from the stdio struct and put EVERYTHING */
  2683. --- 287,294 ----
  2684.   register STR *str;
  2685.   register FILE *fp;
  2686.   {
  2687. ! #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
  2688. !     /* Here is some breathtakingly efficient cheating */
  2689.   
  2690.       register char *bp;        /* we're going to steal some values */
  2691.       register int cnt;        /*  from the stdio struct and put EVERYTHING */
  2692. ***************
  2693. *** 339,345 ****
  2694.       *bp = '\0';
  2695.       str->str_cur = bp - str->str_ptr;    /* set length */
  2696.   
  2697. ! #else /* !USE_STDIO_PTR */    /* The big, slow, and stupid way */
  2698.   
  2699.       static char buf[4192];
  2700.   
  2701. --- 340,347 ----
  2702.       *bp = '\0';
  2703.       str->str_cur = bp - str->str_ptr;    /* set length */
  2704.   
  2705. ! #else /* USE_STDIO_PTR && STDIO_PTR_LVALUE && STDIO_CNT_LVALUE */
  2706. !     /* The big, slow, and stupid way */
  2707.   
  2708.       static char buf[4192];
  2709.   
  2710. ***************
  2711. *** 348,354 ****
  2712.       else
  2713.       str_set(str, No);
  2714.   
  2715. ! #endif /* USE_STDIO_PTR */
  2716.   
  2717.       return str->str_cur ? str->str_ptr : Nullch;
  2718.   }
  2719. --- 350,356 ----
  2720.       else
  2721.       str_set(str, No);
  2722.   
  2723. ! #endif /* USE_STDIO_PTR && STDIO_PTR_LVALUE && STDIO_CNT_LVALUE */
  2724.   
  2725.       return str->str_cur ? str->str_ptr : Nullch;
  2726.   }
  2727.  
  2728.  
  2729. End of patch.
  2730.  
  2731.