[perl5.git] / djgpp / djgpp.c

#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; 

    if (sp<=mark)
        return -1;
    a=argv=(char**) alloca ((sp-mark+3)*sizeof (char*));

    while (++mark <= sp)
        if (*mark)
            *a++ = SvPVx(*mark, PL_na);
        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, PL_na)))
        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;
};

#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;

            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;

            ic=tell (fd);
            if (siz+ic>=gi->size)
                siz=gi->size-ic;
            memcpy (buf,ic+gi->matches,siz);
            lseek (fd,siz,1);
            *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,"..");
}
Commit	Line	Data
39e571d4 LM	1	#include <libc/stubs.h>
	2	#include <io.h>
	3	#include <errno.h>
	4	#include <stdio.h>
	5	#include <stdlib.h>
	6	#include <string.h>
	7	#include <unistd.h>
	8	#include <libc/file.h>
	9	#include <process.h>
	10	#include <fcntl.h>
	11	#include <glob.h>
	12	#include <sys/fsext.h>
	13	#include <crt0.h>
	14	#include "EXTERN.h"
	15	#include "perl.h"
	16	#include "XSUB.h"
	17
9731c6ca	18	/* hold file pointer, command, mode, and the status of the command */
39e571d4 LM	19	struct pipe_list {
39e571d4 LM	20	FILE *fp;
39e571d4	21	int exit_status;
39e571d4	22	struct pipe_list *next;
9731c6ca	23	char *command, mode;
39e571d4 LM	24	};
	25
	26	/* static, global list pointer */
	27	static struct pipe_list *pl = NULL;
	28
	29	FILE *
	30	popen (const char cm, const char md) /* program name, pipe mode */
	31	{
	32	struct pipe_list *l1;
9731c6ca LM	33	int fd;
9731c6ca LM	34	char *temp_name=NULL;
39e571d4 LM	35
39e571d4 LM	36	/* make new node */
9731c6ca LM	37	if ((l1 = (struct pipe_list ) malloc (sizeof (l1)))
9731c6ca LM	38	&& (temp_name = malloc (L_tmpnam)) && tmpnam (temp_name))
39e571d4	39	{
9731c6ca LM	40	l1->fp = NULL;
	41	l1->command = NULL;
	42	l1->next = pl;
	43	l1->exit_status = -1;
	44	l1->mode = md[0];
	45
39e571d4	46	/* if caller wants to read */
9731c6ca	47	if (md[0] == 'r' && (fd = dup (fileno (stdout))) >= 0)
39e571d4	48	{
9731c6ca	49	if ((l1->fp = freopen (temp_name, "wb", stdout)))
39e571d4	50	{
9731c6ca LM	51	l1->exit_status = system (cm);
	52	if (dup2 (fd, fileno (stdout)) >= 0)
	53	l1->fp = fopen (temp_name, md);
39e571d4	54	}
9731c6ca LM	55	close (fd);
	56	}
	57	/* if caller wants to write */
	58	else if (md[0] == 'w' && (l1->command = malloc (1 + strlen (cm))))
	59	{
	60	strcpy (l1->command, cm);
	61	l1->fp = fopen (temp_name, md);
	62	}
	63
	64	if (l1->fp)
	65	{
	66	l1->fp->_flag \|= _IORMONCL; /* remove on close */
	67	l1->fp->_name_to_remove = temp_name;
	68	return (pl = l1)->fp;
39e571d4	69	}
9731c6ca	70	free (l1->command);
39e571d4	71	}
9731c6ca LM	72	free (temp_name);
	73	free (l1);
	74	return NULL;
39e571d4 LM	75	}
	76
	77	int
	78	pclose (FILE *pp)
	79	{
9731c6ca LM	80	struct pipe_list l1, l2; / list pointers */
9731c6ca LM	81	int retval=-1; /* function return value */
39e571d4	82
9731c6ca LM	83	for (l2 = &pl; l2 && (l2)->fp != pp; l2 = &((*l2)->next))
	84	;
	85	if (!(l1 = *l2))
	86	return retval;
	87	*l2 = l1->next;
39e571d4	88
9731c6ca LM	89	/* if pipe was opened to write */
9731c6ca LM	90	if (l1->mode == 'w')
39e571d4	91	{
9731c6ca LM	92	int fd;
	93	fflush (l1->fp);
	94	close (fileno (l1->fp));
39e571d4	95
9731c6ca LM	96	if ((fd = dup (fileno (stdin))) >= 0
9731c6ca LM	97	&& (freopen (l1->fp->_name_to_remove, "rb", stdin)))
39e571d4	98	{
9731c6ca LM	99	retval = system (l1->command);
9731c6ca LM	100	dup2 (fd, fileno (stdin));
39e571d4	101	}
9731c6ca LM	102	close (fd);
9731c6ca LM	103	free (l1->command);
39e571d4	104	}
9731c6ca LM	105	else
	106	/* if pipe was opened to read, return the exit status we saved */
	107	retval = l1->exit_status;
39e571d4	108
9731c6ca LM	109	fclose (l1->fp); /* this removes the temp file */
	110	free (l1);
	111	return retval; /* retval==0 ? OK : ERROR */
39e571d4 LM	112	}
39e571d4 LM	113
39e571d4 LM	114	/**/
	115
	116	#define EXECF_SPAWN 0
	117	#define EXECF_EXEC 1
	118
	119	static int
	120	convretcode (int rc,char *prog,int fl)
	121	{
6b88bc9c	122	if (rc < 0 && PL_dowarn)
39e571d4 LM	123	warn ("Can't %s \"%s\": %s",fl ? "exec" : "spawn",prog,Strerror (errno));
	124	if (rc > 0)
	125	return rc <<= 8;
	126	if (rc < 0)
	127	return 255 << 8;
	128	return 0;
	129	}
	130
	131	int
	132	do_aspawn (SV really,SV mark,SV *sp)
	133	{
	134	dTHR;
	135	int rc;
	136	char *a,tmps,**argv;
	137
	138	if (sp<=mark)
	139	return -1;
	140	a=argv=(char*) alloca ((sp-mark+3)sizeof (char*));
	141
	142	while (++mark <= sp)
	143	if (*mark)
6b88bc9c	144	a++ = SvPVx(mark, PL_na);
39e571d4 LM	145	else
	146	*a++ = "";
	147	*a = Nullch;
	148
	149	if (argv[0][0] != '/' && argv[0][0] != '\\'
	150	&& !(argv[0][0] && argv[0][1] == ':'
	151	&& (argv[0][2] == '/' \|\| argv[0][2] != '\\'))
	152	) /* will swawnvp use PATH? */
	153	TAINT_ENV(); /* testing IFS here is overkill, probably */
	154
6b88bc9c	155	if (really && *(tmps = SvPV(really, PL_na)))
39e571d4 LM	156	rc=spawnvp (P_WAIT,tmps,argv);
	157	else
	158	rc=spawnvp (P_WAIT,argv[0],argv);
	159
	160	return convretcode (rc,argv[0],EXECF_SPAWN);
	161	}
	162
	163	#define EXTRA "\x00\x00\x00\x00\x00\x00"
	164
	165	int
	166	do_spawn2 (char *cmd,int execf)
	167	{
	168	char *a,s,shell,metachars;
	169	int rc,unixysh;
	170
	171	if ((shell=getenv("SHELL"))==NULL && (shell=getenv("COMSPEC"))==NULL)
	172	shell="c:\\command.com" EXTRA;
	173
	174	unixysh=_is_unixy_shell (shell);
	175	metachars=unixysh ? "$&(){}[]'\";\\?>\|<~`\n" EXTRA : "?[\|<>\"\\" EXTRA;
	176
	177	while (cmd && isSPACE(cmd))
	178	cmd++;
	179
	180	if (strnEQ (cmd,"/bin/sh",7) && isSPACE (cmd[7]))
	181	cmd+=5;
	182
	183	/* save an extra exec if possible */
	184	/* see if there are shell metacharacters in it */
	185	if (strstr (cmd,"..."))
	186	goto doshell;
	187	if (unixysh)
	188	{
	189	if (*cmd=='.' && isSPACE (cmd[1]))
	190	goto doshell;
	191	if (strnEQ (cmd,"exec",4) && isSPACE (cmd[4]))
	192	goto doshell;
	193	for (s=cmd; s && isALPHA (s); s++) ; /* catch VAR=val gizmo */
	194	if (*s=='=')
	195	goto doshell;
	196	}
	197	for (s=cmd; *s; s++)
	198	if (strchr (metachars,*s))
	199	{
	200	if (*s=='\n' && s[1]=='\0')
	201	{
	202	*s='\0';
	203	break;
	204	}
	205	doshell:
	206	if (execf==EXECF_EXEC)
	207	return convretcode (execl (shell,shell,unixysh ? "-c" : "/c",cmd,NULL),cmd,execf);
	208	return convretcode (system (cmd),cmd,execf);
	209	}
	210
6b88bc9c GS	211	New (1303,PL_Argv,(s-cmd)/2+2,char*);
	212	PL_Cmd=savepvn (cmd,s-cmd);
	213	a=PL_Argv;
	214	for (s=PL_Cmd; *s;) {
39e571d4 LM	215	while (s && isSPACE (s)) s++;
	216	if (*s)
	217	*(a++)=s;
	218	while (s && !isSPACE (s)) s++;
	219	if (*s)
	220	*s++='\0';
	221	}
	222	*a=Nullch;
6b88bc9c	223	if (!PL_Argv[0])
39e571d4 LM	224	return -1;
	225
	226	if (execf==EXECF_EXEC)
6b88bc9c	227	rc=execvp (PL_Argv[0],PL_Argv);
39e571d4	228	else
6b88bc9c GS	229	rc=spawnvp (P_WAIT,PL_Argv[0],PL_Argv);
6b88bc9c GS	230	return convretcode (rc,PL_Argv[0],execf);
39e571d4 LM	231	}
	232
	233	int
	234	do_spawn (char *cmd)
	235	{
	236	return do_spawn2 (cmd,EXECF_SPAWN);
	237	}
	238
	239	bool
	240	do_exec (char *cmd)
	241	{
	242	do_spawn2 (cmd,EXECF_EXEC);
	243	return FALSE;
	244	}
	245
	246	/**/
	247
	248	struct globinfo
	249	{
	250	int fd;
	251	char *matches;
	252	size_t size;
	253	};
	254
	255	#define MAXOPENGLOBS 10
	256
	257	static struct globinfo myglobs[MAXOPENGLOBS];
	258
	259	static struct globinfo *
	260	searchfd (int fd)
	261	{
	262	int ic;
	263	for (ic=0; ic<MAXOPENGLOBS; ic++)
	264	if (myglobs[ic].fd==fd)
	265	return myglobs+ic;
	266	return NULL;
	267	}
	268
	269	static int
	270	glob_handler (__FSEXT_Fnumber n,int *rv,va_list args)
	271	{
	272	unsigned ic;
	273	struct globinfo *gi;
	274	switch (n)
	275	{
	276	case __FSEXT_open:
	277	{
	278	char p1,pattern,name=va_arg (args,char);
	279	STRLEN len;
	280	glob_t pglob;
	281
	282	if (strnNE (name,"/dev/dosglob/",13))
	283	break;
	284	if ((gi=searchfd (-1)) == NULL)
	285	break;
	286
	287	pattern=alloca (strlen (name+=13)+1);
	288	strcpy (pattern,name);
	289	if (!_USE_LFN)
	290	strlwr (pattern);
	291	ic=pglob.gl_pathc=0;
	292	pglob.gl_pathv=NULL;
	293	while (pattern)
	294	{
295	if ((p1=strchr (pattern,' '))!=NULL)
296	*p1=0;
297	glob (pattern,ic,0,&pglob);
298	ic=GLOB_APPEND;
299	if ((pattern=p1)!=NULL)
300	pattern++;
301	}
302	for (ic=len=0; ic<pglob.gl_pathc; ic++)
303	len+=1+strlen (pglob.gl_pathv[ic]);
304	if (len)
305	{
306	if ((gi->matches=p1=(char*) malloc (gi->size=len))==NULL)
307	break;
308	for (ic=0; ic<pglob.gl_pathc; ic++)
309	{
310	strcpy (p1,pglob.gl_pathv[ic]);
311	p1+=strlen (p1)+1;
312	}
313	}
314	else
315	{
316	if ((gi->matches=strdup (name))==NULL)
317	break;
318	gi->size=strlen (name)+1;
319	}
320	globfree (&pglob);
321	gi->fd=*rv=__FSEXT_alloc_fd (glob_handler);
322	return 1;
323	}
324	case __FSEXT_read:
325	{
326	int fd=va_arg (args,int);
327	char buf=va_arg (args,char);
328	size_t siz=va_arg (args,size_t);
329
330	if ((gi=searchfd (fd))==NULL)
331	break;
332
333	ic=tell (fd);
334	if (siz+ic>=gi->size)
335	siz=gi->size-ic;
336	memcpy (buf,ic+gi->matches,siz);
337	lseek (fd,siz,1);
338	*rv=siz;
339	return 1;
340	}
341	case __FSEXT_close:
342	{
343	int fd=va_arg (args,int);
344
345	if ((gi=searchfd (fd))==NULL)
346	break;
347	free (gi->matches);
348	gi->fd=-1;
349	break;
350	}
351	default:
352	break;
353	}
354	return 0;
355	}
356
357	static
358	XS(dos_GetCwd)
359	{
360	dXSARGS;
361
362	if (items)
363	croak ("Usage: Dos::GetCwd()");
364	{
365	char tmp[PATH_MAX+2];
366	ST(0)=sv_newmortal ();
367	if (getcwd (tmp,PATH_MAX+1)!=NULL)
368	sv_setpv ((SV*)ST(0),tmp);
369	}
370	XSRETURN (1);
371	}
372
373	static
374	XS(dos_UseLFN)
375	{
376	dXSARGS;
377	XSRETURN_IV (_USE_LFN);
378	}
379
380	void
381	init_os_extras()
382	{
383	char *file = __FILE__;
384
385	dXSUB_SYS;
386
387	newXS ("Dos::GetCwd",dos_GetCwd,file);
388	newXS ("Dos::UseLFN",dos_UseLFN,file);
389
390	/* install my File System Extension for globbing */
391	__FSEXT_add_open_handler (glob_handler);
392	memset (myglobs,-1,sizeof (myglobs));
393	}
394
395	static char *perlprefix;
396
397	#define PERL5 "/perl5"
398
399	char djgpp_pathexp (const char p)
400	{
401	static char expp[PATH_MAX];
402	strcpy (expp,perlprefix);
403	switch (p[0])
404	{
405	case 'B':
406	strcat (expp,"/bin");
407	break;
408	case 'S':
409	strcat (expp,"/lib" PERL5 "/site");
410	break;
411	default:
412	strcat (expp,"/lib" PERL5);
413	break;
414	}
415	return expp;
416	}
417
418	void
419	Perl_DJGPP_init (int argcp,char **argvp)
420	{
421	char *p;
422
423	perlprefix=strdup (**argvp);
424	strlwr (perlprefix);
425	if ((p=strrchr (perlprefix,'/'))!=NULL)
426	{
427	*p=0;
428	if (strEQ (p-4,"/bin"))
429	p[-4]=0;
430	}
431	else
432	strcpy (perlprefix,"..");
433	}
434