DataMuseum.dk

top - metrics - download

    Length: 2114 (0x842)
    Types: TextFile
    Names: »chdir.c«

└─⟦4f9d7c866⟧ Bits:30007245 EUUGD6: Sikkerheds distributionen
    └─⟦b5330643c⟧ »./cops/perl-4.019/perl.tar.Z« 
        └─⟦2b9a58213⟧ 
            └─⟦this⟧ »perl-4.019/msdos/chdir.c« 

TextFile

/*
 *    (C) Copyright 1990, 1991 Tom Dinger
 *
 *    You may distribute under the terms of either the GNU General Public
 *    License or the Artistic License, as specified in the README file.
 *
 */

/*
 * A "DOS-aware" chdir() function, that will change current drive as well.
 *
 *	chdir( "B:" )	-- changes to the default directory, on drive B:
 *	chdir( "C:\FOO" )  changes to the specified directory, on drive C:
 *	chdir( "\BAR" )    changes to the specified directory on the current
 *			   drive.
 */

#include <stdlib.h>
#include <ctype.h>
#include <direct.h>
#include <dos.h>
#include <errno.h>

#include "config.h"
#ifdef chdir
#undef chdir
#endif

/* We should have the line:
 *
 * #define chdir perl_chdir
 *
 * in some header for perl (I put it in config.h) so that all
 * references to chdir() become references to this function.
 */

/*------------------------------------------------------------------*/

#if defined(BUGGY_MSC5)	/* only needed for MSC 5.1 */

int _chdrive( int drivenum )
{
unsigned int	ndrives;
unsigned int	tmpdrive;


_dos_setdrive( drivenum, &ndrives );

/* check for illegal drive letter */
_dos_getdrive( &tmpdrive );

return (tmpdrive != drivenum) ? -1 : 0 ;
}

#endif

/*-----------------------------------------------------------------*/

int perl_chdir( char * path )
{
int		drive_letter;
unsigned int	drivenum;


if ( path && *path && (path[1] == ':') )
    {
    /* The path starts with a drive letter */
    /* Change current drive */
    drive_letter = *path;
    if ( isalpha(drive_letter) )
	{
	/* Drive letter legal */
	if ( islower(drive_letter) )
	    drive_letter = toupper(drive_letter);
	drivenum = drive_letter - 'A' + 1;

	/* Change drive */
	if ( _chdrive( drivenum ) == -1 )
	    {
	    /* Drive change failed -- must be illegal drive letter */
	    errno = ENODEV;
	    return -1;
	    }

	/* Now see if that's all we do */
	if ( ! path[2] )
	    return 0;		/* no path after drive -- all done */
	}
    /* else drive letter illegal -- fall into "normal" chdir */
    }

/* Here with some path as well */
return chdir( path );

/* end perl_chdir() */
}