The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#############################################################################
#  A simple compatible version of mkdir( 1 ) written in Perl.
#############################################################################
#
#  Copyright (c) Steve Kemp 1999, skx@tardis.ed.ac.uk
#
#  To do:-
#   Nothing known.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
##############################################################################


# Packages we use.
use strict;
use Getopt::Std;

# Command line arguments, and other variables.
use vars qw( $arg $opt_m $opt_p $mode );

# Set the default mode
$mode = "0777";

# Get any options.
getOptions();

#
# Process each directory named on the command line.
foreach $arg ( @ARGV )
{
    # If we aren't makeing the directorys recursively
    if ( !$opt_p )
    {
	mkdir( $arg, $mode );
    }
    else
    {
	createDir( $arg, $mode );
    }
}


#
#  Read the options from the command line.
sub getOptions() 
{
     # Process options, if any.
     # Make sure defaults are set before returning!
     return unless @ARGV > 0;

     #
     #  Attempt to look for a "-m" with an argument.
     if ( !getopts( 'm:p' ) )
     {
	 showUsage();
     }

     #
     # If there was a mode specified then save it away.
     if ( $opt_m )
     {
	 $mode = $opt_m;
     }
}


#
#  Recursively create directory.  This contains two loops that will attempt
# to do the same job.  The first is going to be used on Windows systems, and
# the second on Unix systems.
sub createDir()
{
    my( $dir, $mode ) = @_;
    my $pos = -1;
    my $tempDir;

    #
    # Windows 95/98/NT,etc uses the seperator "\"
    while( ( $pos = index( $dir, "\\", $pos ) ) > -1 )
    {
	$tempDir =  substr( $dir, 0, $pos );
		     
	if ( length( $tempDir ) )
	{
	    mkdir( $tempDir, $mode );
	}
	$pos++;
    }
    
    #
    # UNIX - Uses the seperator "/"
    while( ( $pos = index( $dir, "/", $pos ) ) > -1 )
    {
	$tempDir =  substr( $dir, 0, $pos );
		     
	if ( length( $tempDir ) )
	{
	    mkdir( $tempDir, $mode );
	}
	$pos++;
    }

    # Make the last part of the directory
    mkdir( $dir, $mode );
}

#
# Show the useage
sub showUsage()
{
    print << "E-O-F";
Usage: mkdir [-m mode -p] dirname1 dirname2 ...
  The options are as follows:

     -m      Set the file permission bits of the final created directory to
             the specified mode.  The mode argument can be in any of the for-
             mats specified to the chmod(1) utility.  If a symbolic mode is
             specified, the operation characters ``+'' and ``-'' are inter-
             preted relative to an initial mode of ``a=rwx''.

     -p      Create intermediate directories as required.  If this option is
             not specified, the full path prefix of each operand must already
             exist.  Intermediate directories are created with permission bits
             of rwxrwxrwx (0777) as modified by the current umask, plus write
             and search permission for the owner.  Do not consider it an error
             if the argument directory already exists.
E-O-F
    exit;
}