perl5.005_03

5 files changed, 592 insertions, 0 deletions

diff --git a/gnu/usr.bin/perl/djgpp/config.over b/gnu/usr.bin/perl/djgpp/config.over
new file mode 100644
index 00000000000..b81c6970968
--- /dev/null
+++ b/gnu/usr.bin/perl/djgpp/config.over
@@ -0,0 +1,39 @@
+ln='cp'
+pager='less'
+
+# fix extension names under DOS 
+repair()
+{
+    echo "$1" | \
+    sed \
+     -e 's/^b/B/'\
+     -e 's=\([^a-z_]\)b=\1B='\
+     -e 's=data/dumper=Data/Dumper='\
+     -e 's/db_file/DB_File/'\
+     -e 's/dynaload/DynaLoader/'\
+     -e 's/errno/Errno/'\
+     -e 's/fcntl/Fcntl/'\
+     -e 's/gdbm_fil/GDBM_File/'\
+     -e 's/io/IO/'\
+     -e 's/SysV//'\
+     -e 's/sysv//'\
+     -e 's=ipc/=='\
+     -e 's=IPC/=='\
+     -e 's/ndbm_fil/NDBM_File/'\
+     -e 's/odbm_fil/ODBM_File/'\
+     -e 's/opcode/Opcode/'\
+     -e 's/posix/POSIX/'\
+     -e 's/sdbm_fil/SDBM_File/'\
+     -e 's/socket/Socket/'\
+     -e 's/thread/Thread/'
+}
+static_ext=$(repair "$static_ext")
+extensions=$(repair "$extensions")
+known_extensions=$(repair "$known_extensions")
+nonxs_ext=$(repair "$nonxs_ext")
+
+# I use Dos::UseLFN in AutoSplit.pm to override this under win0.95
+d_flexfnam='undef'
+
+# under W95 + bash the test program returns bogus result
+d_casti32='undef'
diff --git a/gnu/usr.bin/perl/djgpp/configure.bat b/gnu/usr.bin/perl/djgpp/configure.bat
new file mode 100644
index 00000000000..64b46ec34f7
--- /dev/null
+++ b/gnu/usr.bin/perl/djgpp/configure.bat
@@ -0,0 +1,37 @@
+@echo off

+set CONFIG=

+set PATH_SEPARATOR=;

+set PATH_EXPAND=y

+sh -c 'if test $PATH_SEPARATOR = ";"; then exit 1; fi'

+if ERRORLEVEL 1 goto path_sep_ok

+echo Error:

+echo Make sure the environment variable PATH_SEPARATOR=; while building perl!

+echo Please check your DJGPP.ENV!

+goto end

+

+:path_sep_ok

+sh -c 'if test $PATH_EXPAND = "Y" -o $PATH_EXPAND = "y"; then exit 1; fi'

+if ERRORLEVEL 1 goto path_exp_ok

+echo Error:

+echo Make sure the environment variable PATH_EXPAND=Y while building perl!

+echo Please check your DJGPP.ENV!

+goto end

+

+:path_exp_ok

+sh -c '$SHELL -c "exit 128"'

+if ERRORLEVEL 128 goto shell_ok

+

+echo Error:

+echo The SHELL environment variable must be set to the full path of your sh.exe!

+goto end

+

+:shell_ok

+sh -c 'if test ! -d /tmp; then mkdir /tmp; fi'

+cp djgpp.c config.over ..

+cd ..

+echo Running sed...

+sh djgpp/djgppsed.sh

+

+echo Running Configure...

+sh Configure %1 %2 %3 %4 %5 %6 %7 %8 %9

+:end

diff --git a/gnu/usr.bin/perl/djgpp/djgpp.c b/gnu/usr.bin/perl/djgpp/djgpp.c
new file mode 100644
index 00000000000..3a3a1fc5264
--- /dev/null
+++ b/gnu/usr.bin/perl/djgpp/djgpp.c
@@ -0,0 +1,436 @@
+#include <libc/stubs.h>
+#include <io.h>
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+#include <libc/file.h>
+#include <process.h>
+#include <fcntl.h>
+#include <glob.h>
+#include <sys/fsext.h>
+#include <crt0.h>
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+/* hold file pointer, command, mode, and the status of the command */
+struct pipe_list {
+  FILE *fp;
+  int exit_status;
+  struct pipe_list *next;
+  char *command, mode;
+};
+
+/* static, global list pointer */
+static struct pipe_list *pl = NULL;
+
+FILE *
+popen (const char *cm, const char *md) /* program name, pipe mode */
+{
+  struct pipe_list *l1;
+  int fd;
+  char *temp_name=NULL;
+
+  /* make new node */
+  if ((l1 = (struct pipe_list *) malloc (sizeof (*l1)))
+     && (temp_name = malloc (L_tmpnam)) && tmpnam (temp_name))
+  {
+    l1->fp = NULL;
+    l1->command = NULL;
+    l1->next = pl;
+    l1->exit_status = -1;
+    l1->mode = md[0];
+
+    /* if caller wants to read */
+    if (md[0] == 'r' && (fd = dup (fileno (stdout))) >= 0)
+    {
+      if ((l1->fp = freopen (temp_name, "wb", stdout)))
+      {
+        l1->exit_status = system (cm);
+        if (dup2 (fd, fileno (stdout)) >= 0)
+          l1->fp = fopen (temp_name, md);
+      }
+      close (fd);
+    }
+    /* if caller wants to write */
+    else if (md[0] == 'w' && (l1->command = malloc (1 + strlen (cm))))
+    {
+      strcpy (l1->command, cm);
+      l1->fp = fopen (temp_name, md);
+    }
+
+    if (l1->fp)
+    {
+      l1->fp->_flag |= _IORMONCL; /* remove on close */
+      l1->fp->_name_to_remove = temp_name;
+      return (pl = l1)->fp;
+    }
+    free (l1->command);
+  }
+  free (temp_name);
+  free (l1);
+  return NULL;
+}
+
+int
+pclose (FILE *pp)
+{
+  struct pipe_list *l1, **l2;   /* list pointers */
+  int retval=-1;		/* function return value */
+
+  for (l2 = &pl; *l2 && (*l2)->fp != pp; l2 = &((*l2)->next))
+    ;
+  if (!(l1 = *l2))
+    return retval;
+  *l2 = l1->next;
+
+  /* if pipe was opened to write */
+  if (l1->mode == 'w')
+  {
+    int fd;
+    fflush (l1->fp);
+    close (fileno (l1->fp)); 
+
+    if ((fd = dup (fileno (stdin))) >= 0
+       && (freopen (l1->fp->_name_to_remove, "rb", stdin)))
+    {
+      retval = system (l1->command);
+      dup2 (fd, fileno (stdin));
+    }
+    close (fd);
+    free (l1->command);
+  }
+  else
+    /* if pipe was opened to read, return the exit status we saved */
+    retval = l1->exit_status;
+
+  fclose (l1->fp);              /* this removes the temp file */
+  free (l1);
+  return retval;                /* retval==0 ? OK : ERROR */
+}
+
+/**/
+
+#define EXECF_SPAWN 0
+#define EXECF_EXEC 1
+
+static int
+convretcode (int rc,char *prog,int fl)
+{
+    if (rc < 0 && PL_dowarn)
+        warn ("Can't %s \"%s\": %s",fl ? "exec" : "spawn",prog,Strerror (errno));
+    if (rc > 0)
+        return rc <<= 8;
+    if (rc < 0)
+        return 255 << 8;
+    return 0;
+}
+
+int
+do_aspawn (SV *really,SV **mark,SV **sp)
+{
+    dTHR;
+    int  rc;
+    char **a,*tmps,**argv;
+    STRLEN n_a;
+
+    if (sp<=mark)
+        return -1;
+    a=argv=(char**) alloca ((sp-mark+3)*sizeof (char*));
+
+    while (++mark <= sp)
+        if (*mark)
+            *a++ = SvPVx(*mark, n_a);
+        else
+            *a++ = "";
+    *a = Nullch;
+
+    if (argv[0][0] != '/' && argv[0][0] != '\\'
+        && !(argv[0][0] && argv[0][1] == ':'
+        && (argv[0][2] == '/' || argv[0][2] != '\\'))
+     ) /* will swawnvp use PATH? */
+         TAINT_ENV();	/* testing IFS here is overkill, probably */
+
+    if (really && *(tmps = SvPV(really, n_a)))
+        rc=spawnvp (P_WAIT,tmps,argv);
+    else
+        rc=spawnvp (P_WAIT,argv[0],argv);
+
+    return convretcode (rc,argv[0],EXECF_SPAWN);
+}
+
+#define EXTRA "\x00\x00\x00\x00\x00\x00"
+
+int
+do_spawn2 (char *cmd,int execf)
+{
+    char **a,*s,*shell,*metachars;
+    int  rc,unixysh;
+
+    if ((shell=getenv("SHELL"))==NULL && (shell=getenv("COMSPEC"))==NULL)
+    	shell="c:\\command.com" EXTRA;
+
+    unixysh=_is_unixy_shell (shell);
+    metachars=unixysh ? "$&*(){}[]'\";\\?>|<~`\n" EXTRA : "*?[|<>\"\\" EXTRA;
+
+    while (*cmd && isSPACE(*cmd))
+	cmd++;
+
+    if (strnEQ (cmd,"/bin/sh",7) && isSPACE (cmd[7]))
+        cmd+=5;
+
+    /* save an extra exec if possible */
+    /* see if there are shell metacharacters in it */
+    if (strstr (cmd,"..."))
+        goto doshell;
+    if (unixysh)
+    {
+        if (*cmd=='.' && isSPACE (cmd[1]))
+            goto doshell;
+        if (strnEQ (cmd,"exec",4) && isSPACE (cmd[4]))
+            goto doshell;
+        for (s=cmd; *s && isALPHA (*s); s++) ;	/* catch VAR=val gizmo */
+            if (*s=='=')
+                goto doshell;
+    }
+    for (s=cmd; *s; s++)
+	if (strchr (metachars,*s))
+	{
+	    if (*s=='\n' && s[1]=='\0')
+	    {
+		*s='\0';
+		break;
+	    }
+doshell:
+	    if (execf==EXECF_EXEC)
+                return convretcode (execl (shell,shell,unixysh ? "-c" : "/c",cmd,NULL),cmd,execf);
+            return convretcode (system (cmd),cmd,execf);
+	}
+
+    New (1303,PL_Argv,(s-cmd)/2+2,char*);
+    PL_Cmd=savepvn (cmd,s-cmd);
+    a=PL_Argv;
+    for (s=PL_Cmd; *s;) {
+	while (*s && isSPACE (*s)) s++;
+	if (*s)
+	    *(a++)=s;
+	while (*s && !isSPACE (*s)) s++;
+	if (*s)
+	    *s++='\0';
+    }
+    *a=Nullch;
+    if (!PL_Argv[0])
+        return -1;
+
+    if (execf==EXECF_EXEC)
+        rc=execvp (PL_Argv[0],PL_Argv);
+    else
+        rc=spawnvp (P_WAIT,PL_Argv[0],PL_Argv);
+    return convretcode (rc,PL_Argv[0],execf);
+}
+
+int
+do_spawn (char *cmd)
+{
+    return do_spawn2 (cmd,EXECF_SPAWN);
+}
+
+bool
+do_exec (char *cmd)
+{
+    do_spawn2 (cmd,EXECF_EXEC);
+    return FALSE;
+}
+
+/**/
+
+struct globinfo
+{
+    int    fd;
+    char   *matches;
+    size_t size;
+    fpos_t pos;
+};
+
+#define MAXOPENGLOBS 10
+
+static struct globinfo myglobs[MAXOPENGLOBS];
+
+static struct globinfo *
+searchfd (int fd)
+{
+    int ic;
+    for (ic=0; ic<MAXOPENGLOBS; ic++)
+        if (myglobs[ic].fd==fd)
+            return myglobs+ic;
+    return NULL;
+}
+
+static int
+glob_handler (__FSEXT_Fnumber n,int *rv,va_list args)
+{
+    unsigned ic;
+    struct globinfo *gi;
+    switch (n)
+    {
+        case __FSEXT_open:
+        {
+            char   *p1,*pattern,*name=va_arg (args,char*);
+            STRLEN len;
+            glob_t pglob;
+
+            if (strnNE (name,"/dev/dosglob/",13))
+                break;
+            if ((gi=searchfd (-1)) == NULL)
+                break;
+
+            gi->pos=0;
+            pattern=alloca (strlen (name+=13)+1);
+            strcpy (pattern,name);
+            if (!_USE_LFN)
+                strlwr (pattern);
+            ic=pglob.gl_pathc=0;
+            pglob.gl_pathv=NULL;
+            while (pattern)
+            {
+                if ((p1=strchr (pattern,' '))!=NULL)
+                    *p1=0;
+                glob (pattern,ic,0,&pglob);
+                ic=GLOB_APPEND;
+                if ((pattern=p1)!=NULL)
+                    pattern++;
+            }
+            for (ic=len=0; ic<pglob.gl_pathc; ic++)
+                len+=1+strlen (pglob.gl_pathv[ic]);
+            if (len)
+            {
+                if ((gi->matches=p1=(char*) malloc (gi->size=len))==NULL)
+                    break;
+                for (ic=0; ic<pglob.gl_pathc; ic++)
+                {
+                    strcpy (p1,pglob.gl_pathv[ic]);
+                    p1+=strlen (p1)+1;
+                }
+            }
+            else
+            {
+                if ((gi->matches=strdup (name))==NULL)
+                    break;
+                gi->size=strlen (name)+1;
+            }
+            globfree (&pglob);
+            gi->fd=*rv=__FSEXT_alloc_fd (glob_handler);
+            return 1;
+        }
+        case __FSEXT_read:
+        {
+            int      fd=va_arg (args,int);
+            char   *buf=va_arg (args,char*);
+            size_t  siz=va_arg (args,size_t);
+
+            if ((gi=searchfd (fd))==NULL)
+                break;
+
+            if (siz+gi->pos>gi->size)
+                siz=gi->size-gi->pos;
+            memcpy (buf,gi->pos+gi->matches,siz);
+            gi->pos+=siz;
+            *rv=siz;
+            return 1;
+        }
+        case __FSEXT_close:
+        {
+            int fd=va_arg (args,int);
+
+            if ((gi=searchfd (fd))==NULL)
+                break;
+            free (gi->matches);
+            gi->fd=-1;
+            break;
+        }
+        default:
+            break;
+    }
+    return 0;
+}
+
+static
+XS(dos_GetCwd)
+{
+    dXSARGS;
+
+    if (items)
+        croak ("Usage: Dos::GetCwd()");
+    {
+        char tmp[PATH_MAX+2];
+        ST(0)=sv_newmortal ();
+        if (getcwd (tmp,PATH_MAX+1)!=NULL)
+            sv_setpv ((SV*)ST(0),tmp);
+    }
+    XSRETURN (1);
+}
+
+static
+XS(dos_UseLFN)
+{
+    dXSARGS;
+    XSRETURN_IV (_USE_LFN);
+}
+
+void
+init_os_extras()
+{
+    char *file = __FILE__;
+
+    dXSUB_SYS;
+    
+    newXS ("Dos::GetCwd",dos_GetCwd,file);
+    newXS ("Dos::UseLFN",dos_UseLFN,file);
+
+    /* install my File System Extension for globbing */
+    __FSEXT_add_open_handler (glob_handler);
+    memset (myglobs,-1,sizeof (myglobs));
+}
+
+static char *perlprefix;
+
+#define PERL5 "/perl5"
+
+char *djgpp_pathexp (const char *p)
+{
+    static char expp[PATH_MAX];
+    strcpy (expp,perlprefix);
+    switch (p[0])
+    {
+        case 'B':
+            strcat (expp,"/bin");
+            break;
+        case 'S':
+            strcat (expp,"/lib" PERL5 "/site");
+            break;
+        default:
+            strcat (expp,"/lib" PERL5);
+            break;
+    }
+    return expp;
+}
+
+void
+Perl_DJGPP_init (int *argcp,char ***argvp)
+{
+    char *p;
+
+    perlprefix=strdup (**argvp);
+    strlwr (perlprefix);
+    if ((p=strrchr (perlprefix,'/'))!=NULL)
+    {
+        *p=0;
+        if (strEQ (p-4,"/bin"))
+            p[-4]=0;
+    }
+    else
+        strcpy (perlprefix,"..");
+}
+
diff --git a/gnu/usr.bin/perl/djgpp/djgppsed.sh b/gnu/usr.bin/perl/djgpp/djgppsed.sh
new file mode 100644
index 00000000000..5276f4f67fb
--- /dev/null
+++ b/gnu/usr.bin/perl/djgpp/djgppsed.sh
@@ -0,0 +1,49 @@
+#! /bin/sh
+
+# Change some files to work under DOS
+# Most of this stuff does .xx -> _xx and aa.bb.ccc -> aa_bb.cc conversion
+
+SCONFIG='s=\.\(config\)=_\1=g'
+SLIST='s=\.\([a-z]\+list\)=_\1=g'
+SGREPTMP='s=\.\(greptmp\)=_\1=g'
+SECHOTMP='s=\.\(echotmp\)=_\1=g'
+SDDC='s=\.\($$\.c\)=_\1=g'
+SOUT='s=\([^a-z1-9?]\)\.\(out\)=\1_\2=g'
+SEXISTS='s=\.\(exists\)=_\1=g'
+SPOD2HTML='s=pod2html-=pod2html.=g'
+SCC='s=\.c\.c=.c_c=g'
+SFILEC="s=\(\$file\)\.c=\\1'_c'=g"
+SCOR='s=c\\\.c|=c\_c|=g'
+SHSED='s=\.\(hsed\)=_\1=g'
+SDEPTMP='s=\.\(deptmp\)=_\1=g'
+SCPP='s=\.\(cpp\.\)=_\1=g'
+SARGV='s=\.\(argv\.\)=_\1=g'
+SABC='s=\.\([abc][^a]\)=_\1=g'
+SDBMX='s=\.\(dbmx\)=_\1=g'
+SDBHASH='s=dbhash\.tmp=dbhash_tmp=g'
+SSTAT='s=\.\(stat\.\)=_\1=g'
+STMP2='s=tmp2=tm2=g'
+SPACKLIST='s=\.\(packlist\)=_\1=g'
+
+sed -e $SCONFIG -e $SGREPTMP -e $SECHOTMP -e $SDDC -e $SOUT -e 's=\.\( \./\$file\)$=sh\1=g' Configure |tr -d '\r' >s; mv -f s Configure
+sed -e $SEXISTS -e $SLIST -e $SCONFIG Makefile.SH |tr -d '\r' >s; mv -f s Makefile.SH
+sed -e $SEXISTS -e $SPACKLIST lib/ExtUtils/Install.pm |tr -d '\r' >s; mv -f s lib/ExtUtils/Install.pm
+sed -e $SEXISTS -e $SPACKLIST lib/ExtUtils/MM_Unix.pm |tr -d '\r' >s; mv -f s lib/ExtUtils/MM_Unix.pm
+sed -e $SEXISTS -e $SPACKLIST installperl >s; mv -f s installperl
+sed -e $SPOD2HTML lib/Pod/Html.pm |tr -d '\r' >s; mv -f s lib/Pod/Html.pm
+sed -e $SCC -e $SLIST -e $SFILEC -e $SCOR -e $SDEPTMP -e $SHSED makedepend.SH |tr -d '\r' >s; mv -f s makedepend.SH
+sed -e $SCPP t/comp/cpp.aux |tr -d '\r' >s; mv -f s t/comp/cpp.aux
+sed -e $SARGV t/io/argv.t >s; mv -f s t/io/argv.t
+sed -e $SABC t/io/inplace.t >s; mv -f s t/io/inplace.t
+sed -e $SDBMX t/lib/anydbm.t >s; mv -f s t/lib/anydbm.t
+sed -e $SDBMX -e $SDBHASH t/lib/gdbm.t >s; mv -f s t/lib/gdbm.t
+sed -e $SDBMX -e $SDBHASH t/lib/sdbm.t >s; mv -f s t/lib/sdbm.t
+sed -e $SSTAT -e $STMP2 t/op/stat.t >s; mv -f s t/op/stat.t
+sed -e $SLIST x2p/Makefile.SH |tr -d '\r' >s; mv -f s x2p/Makefile.SH
+sed -e 's=^#define.\([A-Z]\+\)_EXP.*$=#define \1_EXP djgpp_pathexp("\1")=g' config_h.SH >s; mv -f s config_h.SH
+sed -e 's=:^/:={^([a-z]:)?[\\\\/]}=g' lib/termcap.pl >s; mv -f s lib/termcap.pl
+sed -e $SPACKLIST installman >s; mv -f s installman
+sed -e $SPACKLIST lib/ExtUtils/Installed.pm >s; mv -f s lib/ExtUtils/Installed.pm
+sed -e $SPACKLIST lib/ExtUtils/Packlist.pm >s; mv -f s lib/ExtUtils/Packlist.pm
+sed -e $SPACKLIST lib/ExtUtils/inst >s; mv -f s lib/ExtUtils/inst
+sed -e $SABC t/io/iprefix.t >s; mv -f s t/io/iprefix.t
diff --git a/gnu/usr.bin/perl/djgpp/fixpmain b/gnu/usr.bin/perl/djgpp/fixpmain
new file mode 100644
index 00000000000..6b0591c40f4
--- /dev/null
+++ b/gnu/usr.bin/perl/djgpp/fixpmain
@@ -0,0 +1,31 @@
+#!perl -w
+# Fix perlmain.c under DOS (short & case insensitive filenames).
+# Called from Makefile.aperl when needed.
+# You don't need this when LFN=y.
+
+use Config;
+
+open (PERLM,"<perlmain.c") or die "Can't load perlmain.c: $!";
+open (MAKEFILE,"<makefile.pl") or die "Can't load makefile.pl: $!";
+undef $/;
+$perlmain=<PERLM>;
+$makefile=<MAKEFILE>;
+
+($_) = $makefile =~ /\bNAME\b.*=>\W*([\w\:]+)/; # extract module name
+$badname=join ("__",map {lc substr ($_,0,8)} split /:+/); # dosify
+$perlmain =~ s/^.*boot_$badname.*$//gm if $badname; # delete bad lines
+
+@exts=('DynaLoader',split (" ",$Config{known_extensions}));
+for $realname (@exts)
+{
+    $dosname=join ("__",map {lc substr ($_,0,8)} split /\//,$realname);
+    $realname =~ s!/!__!g;
+    $perlmain =~ s/\bboot_$dosname/boot_$realname/gm;
+    $perlmain =~ s/\b$dosname(::bootstrap)/$realname$1/gm;
+}
+
+#DynaLoader is special
+$perlmain =~ s/(DynaLoader:\:boot)strap/$1_DynaLoader/gm;
+
+open (PERLM,">perlmain.c") or die "Can't write perlmain.c: $!";
+print PERLM $perlmain;