2 * (C) Copyright 1990, 1991 Tom Dinger
4 * You may distribute under the terms of the GNU General Public License
5 * as specified in the README file that comes with the perl 4.0 kit.
10 * A "DOS-aware" chdir() function, that will change current drive as well.
12 * chdir( "B:" ) -- changes to the default directory, on drive B:
13 * chdir( "C:\FOO" ) changes to the specified directory, on drive C:
14 * chdir( "\BAR" ) changes to the specified directory on the current
29 /* We should have the line:
31 * #define chdir perl_chdir
33 * in some header for perl (I put it in config.h) so that all
34 * references to chdir() become references to this function.
37 /*------------------------------------------------------------------*/
39 #if defined(BUGGY_MSC5) /* only needed for MSC 5.1 */
41 int _chdrive( int drivenum )
44 unsigned int tmpdrive;
47 _dos_setdrive( drivenum, &ndrives );
49 /* check for illegal drive letter */
50 _dos_getdrive( &tmpdrive );
52 return (tmpdrive != drivenum) ? -1 : 0 ;
57 /*-----------------------------------------------------------------*/
59 int perl_chdir( char * path )
62 unsigned int drivenum;
65 if ( path && *path && (path[1] == ':') )
67 /* The path starts with a drive letter */
68 /* Change current drive */
70 if ( isalpha(drive_letter) )
72 /* Drive letter legal */
73 if ( islower(drive_letter) )
74 drive_letter = toupper(drive_letter);
75 drivenum = drive_letter - 'A' + 1;
78 if ( _chdrive( drivenum ) == -1 )
80 /* Drive change failed -- must be illegal drive letter */
85 /* Now see if that's all we do */
87 return 0; /* no path after drive -- all done */
89 /* else drive letter illegal -- fall into "normal" chdir */
92 /* Here with some path as well */
95 /* end perl_chdir() */