#!/usr/bin/perl -wT
#
# TWiki Collaboration Platform, http://TWiki.org/
#
# Copyright (C) 1999-2004 Peter Thoeny, peter@thoeny.com
#
# For licensing info read license.txt file in the TWiki root.
# 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, published at 
# http://www.gnu.org/copyleft/gpl.html

BEGIN {
    # Set default current working directory
    if( $ENV{"SCRIPT_FILENAME"} && $ENV{"SCRIPT_FILENAME"} =~ /^(.+)\/[^\/]+$/ ) {
        chdir $1;
    }
    # Set library paths in @INC at compile time
    unshift @INC, '.';
    require 'setlib.cfg';

    # 'Use locale' for internationalisation of Perl regexes - 
    # main locale settings are done in TWiki::setupLocale
    # Do a dynamic 'use locale' for this module
    require TWiki;
    if( $TWiki::useLocale ) {
        require locale;
	import locale ();
    }
}

use CGI::Carp qw(fatalsToBrowser);
use CGI;
use TWiki;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );

my $nonAlphaNum;

&main();


# =========================
# code fragment to extract pixel size from images
# taken from http://www.tardis.ed.ac.uk/~ark/wwwis/
# subroutines: imgsize, gifsize, OLDgifsize, gif_blockskip,
#              NEWgifsize, jpegsize
#
# looking at the filename really sucks I should be using the first 4 bytes
# of the image. If I ever do it these are the numbers.... (from chris@w3.org)
#  PNG 89 50 4e 47
#  GIF 47 49 46 38
#  JPG ff d8 ff e0
#  XBM 23 64 65 66


# =========================
sub imgsize {
  my( $file ) = shift @_;
  my( $x, $y) = ( 0, 0 );

  if( defined( $file ) && open( STRM, "<$file" ) ) {
    binmode( STRM ); # for crappy MS OSes - Win/Dos/NT use is NOT SUPPORTED
    if( $file =~ /\.jpg$/i || $file =~ /\.jpeg$/i ) {
      ( $x, $y ) = &jpegsize( \*STRM );
    } elsif( $file =~ /\.gif$/i ) {
      ( $x, $y ) = &gifsize(\*STRM);
    } elsif( $file =~ /\.png$/i ) {
      ( $x, $y ) = &pngsize(\*STRM);
    }
    close( STRM );
  }
  return( $x, $y );
}


# =========================
sub gifsize
{
  my( $GIF ) = @_;
  if( 0 ) {
    return &NEWgifsize( $GIF );
  } else {
    return &OLDgifsize( $GIF );
  }
}


# =========================
sub OLDgifsize {
  my( $GIF ) = @_;
  my( $type, $a, $b, $c, $d, $s ) = ( 0, 0, 0, 0, 0, 0 );

  if( defined( $GIF )              &&
      read( $GIF, $type, 6 )       &&
      $type =~ /GIF8[7,9]a/        &&
      read( $GIF, $s, 4 ) == 4     ) {
    ( $a, $b, $c, $d ) = unpack( "C"x4, $s );
    return( $b<<8|$a, $d<<8|$c );
  }
  return( 0, 0 );
}


# =========================
# part of NEWgifsize
sub gif_blockskip {
  my ( $GIF, $skip, $type ) = @_;
  my ( $s ) = 0;
  my ( $dummy ) = '';

  read( $GIF, $dummy, $skip );       # Skip header (if any)
  while( 1 ) {
    if( eof( $GIF ) ) {
      #warn "Invalid/Corrupted GIF (at EOF in GIF $type)\n";
      return "";
    }
    read( $GIF, $s, 1 );             # Block size
    last if ord( $s ) == 0;          # Block terminator
    read( $GIF, $dummy, ord( $s ) ); # Skip data
  }
}


# =========================
# this code by "Daniel V. Klein" <dvk@lonewolf.com>
sub NEWgifsize {
  my( $GIF ) = @_;
  my( $cmapsize, $a, $b, $c, $d, $e ) = 0;
  my( $type, $s ) = ( 0, 0 );
  my( $x, $y ) = ( 0, 0 );
  my( $dummy ) = '';

  return( $x,$y ) if( !defined $GIF );

  read( $GIF, $type, 6 );
  if( $type !~ /GIF8[7,9]a/ || read( $GIF, $s, 7 ) != 7 ) {
    #warn "Invalid/Corrupted GIF (bad header)\n";
    return( $x, $y );
  }
  ( $e ) = unpack( "x4 C", $s );
  if( $e & 0x80 ) {
    $cmapsize = 3 * 2**(($e & 0x07) + 1);
    if( !read( $GIF, $dummy, $cmapsize ) ) {
      #warn "Invalid/Corrupted GIF (global color map too small?)\n";
      return( $x, $y );
    }
  }
 FINDIMAGE:
  while( 1 ) {
    if( eof( $GIF ) ) {
      #warn "Invalid/Corrupted GIF (at EOF w/o Image Descriptors)\n";
      return( $x, $y );
    }
    read( $GIF, $s, 1 );
    ( $e ) = unpack( "C", $s );
    if( $e == 0x2c ) {           # Image Descriptor (GIF87a, GIF89a 20.c.i)
      if( read( $GIF, $s, 8 ) != 8 ) {
        #warn "Invalid/Corrupted GIF (missing image header?)\n";
        return( $x, $y );
      }
      ( $a, $b, $c, $d ) = unpack( "x4 C4", $s );
      $x = $b<<8|$a;
      $y = $d<<8|$c;
      return( $x, $y );
    }
    if( $type eq "GIF89a" ) {
      if( $e == 0x21 ) {         # Extension Introducer (GIF89a 23.c.i)
        read( $GIF, $s, 1 );
        ( $e ) = unpack( "C", $s );
        if( $e == 0xF9 ) {       # Graphic Control Extension (GIF89a 23.c.ii)
          read( $GIF, $dummy, 6 );        # Skip it
          next FINDIMAGE;       # Look again for Image Descriptor
        } elsif( $e == 0xFE ) {  # Comment Extension (GIF89a 24.c.ii)
          &gif_blockskip( $GIF, 0, "Comment" );
          next FINDIMAGE;       # Look again for Image Descriptor
        } elsif( $e == 0x01 ) {  # Plain Text Label (GIF89a 25.c.ii)
          &gif_blockskip( $GIF, 12, "text data" );
          next FINDIMAGE;       # Look again for Image Descriptor
        } elsif( $e == 0xFF ) {  # Application Extension Label (GIF89a 26.c.ii)
          &gif_blockskip( $GIF, 11, "application data" );
          next FINDIMAGE;       # Look again for Image Descriptor
        } else {
          #printf STDERR "Invalid/Corrupted GIF (Unknown extension %#x)\n", $e;
          return( $x, $y );
        }
      } else {
        #printf STDERR "Invalid/Corrupted GIF (Unknown code %#x)\n", $e;
        return( $x, $y );
      }
    } else {
      #warn "Invalid/Corrupted GIF (missing GIF87a Image Descriptor)\n";
      return( $x, $y );
    }
  }
}


# =========================
# jpegsize : gets the width and height (in pixels) of a jpeg file
# Andrew Tong, werdna@ugcs.caltech.edu           February 14, 1995
# modified slightly by alex@ed.ac.uk
sub jpegsize {
  my( $JPEG ) = @_;
  my( $done ) = 0;
  my( $c1, $c2, $ch, $s, $length, $dummy ) = ( 0, 0, 0, 0, 0, 0 );
  my( $a, $b, $c, $d );

  if( defined( $JPEG )             &&
      read( $JPEG, $c1, 1 )        &&
      read( $JPEG, $c2, 1 )        &&
      ord( $c1 ) == 0xFF           &&
      ord( $c2 ) == 0xD8           ) {
    while ( ord( $ch ) != 0xDA && !$done ) {
      # Find next marker (JPEG markers begin with 0xFF)
      # This can hang the program!!
      while( ord( $ch ) != 0xFF ) {
        return( 0, 0 ) unless read( $JPEG, $ch, 1 );
      }
      # JPEG markers can be padded with unlimited 0xFF's
      while( ord( $ch ) == 0xFF ) {
        return( 0, 0 ) unless read( $JPEG, $ch, 1 );
      }
      # Now, $ch contains the value of the marker.
      if( ( ord( $ch ) >= 0xC0 ) && ( ord( $ch ) <= 0xC3 ) ) {
        return( 0, 0 ) unless read( $JPEG, $dummy, 3 );
        return( 0, 0 ) unless read( $JPEG, $s, 4 );
        ( $a, $b, $c, $d ) = unpack( "C"x4, $s );
        return( $c<<8|$d, $a<<8|$b );
      } else {
        # We **MUST** skip variables, since FF's within variable names are
        # NOT valid JPEG markers
        return( 0, 0 ) unless read( $JPEG, $s, 2 );
        ( $c1, $c2 ) = unpack( "C"x2, $s );
        $length = $c1<<8|$c2;
        last if( !defined( $length ) || $length < 2 );
        read( $JPEG, $dummy, $length-2 );
      }
    }
  }
  return( 0, 0 );
}

# =========================
#  pngsize : gets the width & height (in pixels) of a png file
#  cor this program is on the cutting edge of technology! (pity it's blunt!)
#  GRR 970619:  fixed bytesex assumption
#  source: http://www.la-grange.net/2000/05/04-png.html
sub pngsize {
  local($PNG) = @_;
  local($head) = "";
  my($a, $b, $c, $d, $e, $f, $g, $h)=0;
  if(defined($PNG)                              &&
     read( $PNG, $head, 8 ) == 8                &&
     $head eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a" &&
     read($PNG, $head, 4) == 4                  &&
     read($PNG, $head, 4) == 4                  &&
     $head eq "IHDR"                            &&
     read($PNG, $head, 8) == 8                  ){
    ($a,$b,$c,$d,$e,$f,$g,$h)=unpack("C"x8,$head);
    return ($a<<24|$b<<16|$c<<8|$d, $e<<24|$f<<16|$g<<8|$h);
  }
  return (0,0);
} 

# =========================
sub addLinkToEndOfTopic
{
    my ( $text, $pathFilename, $fileName, $fileComment ) = @_;
    my $fileLink = "";
    my $imgSize = "";

    if( $fileName =~ /\.(gif|jpg|jpeg|png)$/i ) {
        # inline image
        $fileComment = $fileName if( ! $fileComment );
        my( $nx, $ny ) = &imgsize( $pathFilename );
        if( ( $nx > 0 ) && ( $ny > 0 ) ) {
            $imgSize = " width=\"$nx\" height=\"$ny\" ";
        }
        $fileLink = &TWiki::Prefs::getPreferencesValue( "ATTACHEDIMAGEFORMAT" )
                  || '   * $comment: <br />'
                   . ' <img src="%ATTACHURLPATH%/$name" alt="$name"$size />';
    } else {
        # normal attached file
        $fileLink = &TWiki::Prefs::getPreferencesValue( "ATTACHEDFILELINKFORMAT" )
                 || '   * [[%ATTACHURL%/$name][$name]]: $comment';
    }

    $fileLink =~ s/^      /\t\t/go;
    $fileLink =~ s/^   /\t/go;
    $fileLink =~ s/\$name/$fileName/g;
    $fileLink =~ s/\$comment/$fileComment/g;
    $fileLink =~ s/\$size/$imgSize/g;
    $fileLink =~ s/\\t/\t/go;
    $fileLink =~ s/\\n/\n/go;
    $fileLink =~ s/([^\n])$/$1\n/;

    return "$text$fileLink";
}

# =========================
sub handleError
{
    my( $noredirect, $message, $query, $theWeb, $theTopic, 
        $theOopsTemplate, $oopsArg1, $oopsArg2 ) = @_;

    if( $noredirect ) {
        $oopsArg1 = "" if( ! $oopsArg1 );
        $oopsArg2 = "" if( ! $oopsArg2 );
        &TWiki::writeHeader( $query );
        print "ERROR $theWeb.$theTopic $message $oopsArg1 $oopsArg2\n";
    } else {
	my $url = &TWiki::getOopsUrl( $theWeb, $theTopic, $theOopsTemplate, $oopsArg1, $oopsArg2 );
	TWiki::redirect( $query, $url );
    }
}


# =========================
sub main
{
    my $query = new CGI;

    ##### for debug only: Remove next 3 comments (but redirect does not work)
    #open(STDERR,'>&STDOUT'); # redirect error to browser
    #$| = 1;                  # no buffering
    #TWiki::writeHeader( $query );

    my $thePathInfo = $query->path_info(); 
    my $theRemoteUser = $query->remote_user();
    my $theTopic = $query->param( 'topic' );
    my $theUrl = $query->url;
    my $doChangeProperties = $query->param( 'changeproperties' );
    my $hideFile = $query->param( 'hidefile' ) || "";
    my $noredirect = $query->param( 'noredirect' ) || "";

    ( $topic, $webName, $dummy, $userName ) = 
	&TWiki::initialize( $thePathInfo, $theRemoteUser, $theTopic, $theUrl, $query );
    $dummy = "";  # to suppress warning

    $nonAlphaNum= "[^$TWiki::regex{mixedAlphaNum}" . '\._-]+';

    my $wikiUserName = &TWiki::userToWikiName( $userName );

    if( ! &TWiki::Store::webExists( $webName ) ) {
        handleError( $noredirect, "Missing Web", $query, $webName, $topic, "oopsnoweb" );
        return;
    }

    # EPIC
    my $noSpaces = &TWiki::Prefs::getPreferencesValue( "UPLOADNOSPACES", $webName ) || "";
    if ($noSpaces =~ /[Nn][oO]/) { $noSpaces = ""; }
    my $lowerCase = &TWiki::Prefs::getPreferencesValue( "UPLOADLOWERCASE", $webName ) || "";
    if ($lowerCase =~ /[Nn][oO]/) { $lowerCase = ""; }

    my( $mirrorSiteName, $mirrorViewURL ) = &TWiki::readOnlyMirrorWeb( $webName );
    if( $mirrorSiteName ) {
        handleError( $noredirect, "This is a readonly mirror", 
               $query, $webName, $topic, "oopsmirror", $mirrorSiteName, $mirrorViewURL );
        return;
    }

    # check access permission
    if( ! &TWiki::Access::checkAccessPermission( "change", $wikiUserName, "", $topic, $webName ) ) {
        handleError( $noredirect, "No change permission", $query, $webName, $topic, "oopsaccesschange" );
        return;
    }

    unless( &TWiki::Store::topicExists( $webName, $topic ) ) {
        handleError( $noredirect, "Missing topic", $query, $webName, $topic, "oopsattachnotopic" );
        return;
    }

    my $filePath = $query->param( 'filepath' ) || "";
    my $fileName = $query->param( 'filename' ) || "";
    if ( $filePath && ! $fileName ) {
        $filePath =~ m|([^/\\]*$)|;
        $fileName = $1;
    }
    my $tmpFilename = $query->tmpFileName( $filePath ) || "";
#    my $tmpFilename = $query->param( 'tmpfilename' ) || "";
    my $fileComment = $query->param( 'filecomment' ) || "";
    my $createLink = $query->param( 'createlink' ) || "";
    my $archivefile = $query->param( 'archivefile' ) || "";

    $fileComment =~ s/\s+/ /go;
    $fileComment =~ s/^\s*//o;
    $fileComment =~ s/\s*$//o;

    close $filePath if( $TWiki::OS eq "WINDOWS");

    # Change Windows path to Unix path
    $tmpFilename =~ s!\\!/!go;
    $tmpFilename =~ /(.*)/;
    $tmpFilename = $1;
    ##TWiki::writeDebug( "upload: tmpFilename $tmpFilename" );

    # EPIC Added 22 Mar 2003
    my ($zip, %processedFiles, $tmpDir);

    if ( $archivefile ) {
        $zip = openZipSanityCheck ( $tmpFilename, $lowerCase, $noSpaces,
				    $noredirect, $query, $webName, $topic, $filePath );

        ($tmpDir, %processedFiles ) = doUnzip($zip, $tmpFilename, $fileComment);
#	TWiki::writeDebug( "upload: tmpDir = $tmpDir" );
    } else {
        $processedFiles{$tmpFilename} = [ $fileName, $fileComment, $filePath ];
	$tmpDir = ""; # insurance!
    }

    # Loop through processed files.
    my $error;
    foreach my $fileNameKey (sort keys %processedFiles) {
      my ($fileName, $fileComment, $filePath ) = @{$processedFiles{$fileNameKey}};

      $filePath = $fileName unless defined $filePath ; # for archives
      $fileName =~ /^(.*?)$/goi ; $fileName = $1;
      $tmpFilename = $fileNameKey;

      $fileName = lc ($fileName)
	if $lowerCase;
      $fileName =~ s/\s/_/go
	unless $noSpaces;

      #	TWiki::writeDebug( "upload: fileName=$fileName, fileComment=$fileComment, tmpFilename=$fileNameKey" );

      my( $fileSize, $fileUser, $fileDate, $fileVersion ) = "";

      unless( $doChangeProperties ) {

	# check if file exists and has non zero size
	# get time stamp and file size of uploaded file:

	( $fileSize, $fileDate ) = (stat $tmpFilename)[7,9];

	unless ( defined $fileSize && $fileSize ) {
	  handleError( $noredirect, "File missing or zero size", 
		       $query, $webName, $topic, "oopsupload", $fileName );
	  return;
	}

	my $maxSize = &TWiki::Prefs::getPreferencesValue( "ATTACHFILESIZELIMIT" );
	$maxSize = 0 unless $maxSize =~ /([0-9]+)/;
	if ( $maxSize && $fileSize > $maxSize * 1024 ) {
	  handleError( $noredirect, "File exceeds size limit", 
		       $query, $webName, $topic, "oopsuploadlimit", $fileName, $maxSize );
	  return;
	}

	# cut path from filepath name (Windows "\" and Unix "/" format)
	my @pathz = ( split( /\\/, $filePath ) );
	my $filetemp = $pathz[$#pathz];
	my @pathza = ( split( '/', $filetemp ) );
	$fileName = $pathza[$#pathza];

	# Delete unwanted characters from filename, with I18N
        $fileName =~ s/$nonAlphaNum//go;
        $fileName =~ s/$TWiki::uploadFilter/$1\.txt/goi; # apply security filter
        $fileName =~ /(.*)/;	# untaint
        $fileName = $1;

	$fileName = lc ($fileName)
	  if $lowerCase;
	$fileName =~ s/\s/_/go
	  unless $noSpaces;

	##TWiki::writeDebug ("Upload filename after cleanup is '$fileName'");

	# Update
	my $text1 = "";
	my $saveCmd = "";
	my $doNotLogChanges = 1;
	my $doUnlock = 0;
	my $dontNotify = "";

	my $error = &TWiki::Store::saveAttachment( $webName, $topic, $text1, $saveCmd,
                                                   $fileName, $doNotLogChanges, $doUnlock, 
						   $dontNotify, $fileComment, $tmpFilename );

	if ( $error ) {
	  handleError( $noredirect, "Save attachment error", $query, $webName, $topic,
		       "oopssaveerr", $error );
	  return;
	}

	# get user name
	$fileUser = $userName;

        $fileVersion = TWiki::Store::getRevisionNumber( $webName, $topic, $fileName );

	if ( $TWiki::doLogTopicUpload ) {
	  # write log entry
	  &TWiki::Store::writeLog( "upload", "$webName.$topic", $fileName );
	  #FIXE also do log for change property?
	}
      }

      # update topic
      my( $meta, $text ) = &TWiki::Store::readTopic( $webName, $topic );

      if ( $doChangeProperties ) {
        TWiki::Attach::updateProperties( $fileName, $hideFile, $fileComment, $meta );
      } else {
        TWiki::Attach::updateAttachment( 
					$fileVersion, $fileName, $filePath, $fileSize,
					$fileDate, $fileUser, $fileComment, $hideFile, $meta );
      }

      if ( $createLink ) {
        my $filePath = &TWiki::Store::getFileName( $webName, $topic, $fileName );
        $text = addLinkToEndOfTopic( $text, $filePath, $fileName, $fileComment );
      }

      $error = &TWiki::Store::saveTopic( $webName, $topic, $text, $meta, "", 1 );
      if( $error ) {
	handleError( $noredirect, "Save topic error", $query, $webName, $topic,
		     "oopssaveerr", $error );
	return;
      }
    }				# RNF End loop.

    # and finally display topic
    if ( $noredirect ) {
      &TWiki::writeHeader( $query );
      my $message = ( $doChangeProperties ) ? "properties changed" : "$fileName uploaded";
      print( "OK $message\n" );
    } else {
      TWiki::redirect( $query, &TWiki::getViewUrl( $webName, $topic ) );
    }
}

# EPIC
# changed to work around a race condition where a symlink could be made in the temp
# directory pointing to a file writable by the CGI and then a zip uploaded with
# that filename, also solves the problem if two people are uploading zips with
# some identical filenames.
sub doUnzip
{
    my ($zip, $archive, $archiveComment) = @_;
    my $tmpDir = $archive; $tmpDir =~ s/(.*)\/.+/$1/;
    $tmpDir = makeTempName( $tmpDir );

    my (@memberNames, $mName, $member, $buffer, $comment, %good, $zipRet);

    @memberNames = $zip->memberNames();


    mkdir( $tmpDir );

    # on some systems with some versions of Archive::Zip extractMemberWithoutPaths()
    # ignores the path given to it and tries to just write the file to the current directory.
    chdir( $tmpDir );

    foreach $mName (sort @memberNames) {
        $member = $zip->memberNamed($mName);
        next if $member->isDirectory();

        $comment = substr($member->fileComment(), 0, 50);
        $comment = length($comment) ? $comment : $archiveComment;

	$mName =~ /\/?(.*\/)?(.+)/; $mName = $2;

	my $zipRet = $zip->extractMemberWithoutPaths( $member, "$tmpDir/$mName" );
	if ($zipRet == AZ_OK) {
	    $good{"$tmpDir/$mName"} = [ $mName, $comment ];
	} else {
	    # FIXME: oops here
	    TWiki::writeDebug( "upload: zip->extractMemberWithoutPaths = $zipRet" );
	}
    }

    return ( $tmpDir, %good ); # return the $tmpDir here so we can remove it
}

sub zipErrorHandler
{
    TWiki::writeDebug (@_);
}

# EPIC
# Open a zip and perform a sanity check on it.
# Returns the opened zip object (to be passed to doUnzip) on success, or oops'es and dies on failure.
sub openZipSanityCheck
{
    my ( $archive, $lowerCase, $noSpaces, $noredirect, $query, $webName, $topic, $realname ) = @_;
    my $zip = Archive::Zip->new ();
    my (@memberNames, $mName, $member, %dupCheck, $sizeLimit, $size);

    if ( $zip->read ("$archive") != AZ_OK ) {
         handleError( $noredirect, "Zip read error or not a zip file.",
		      $query, $webName, $topic, "oopszip", $realname );
	 die;
    }

    # Scan for duplicates
    @memberNames = $zip->memberNames (); $size = 0;
    foreach $mName (@memberNames) {
         $member = $zip->memberNamed ($mName);
	 next if $member->isDirectory ();

	 $mName =~ /\/?(.*\/)?(.+)/; $mName = $2;

	 $size += $member->uncompressedSize ();

	 if ( $lowerCase ) { $mName = lc ($mName); }
	 unless ( $noSpaces ) { $mName =~ s/\s/_/go; }

	 $mName =~ s/$nonAlphaNum//go;
	 $mName =~ s/$TWiki::uploadFilter/$1\.txt/goi;

	 ##TWiki::writeDebug( "upload: zip member name: $mName" );
	 if ( defined $dupCheck{"$mName"} ) {
	      handleError ( $noredirect, "Duplicate file in archive.",
			    $query, $webName, $topic, "oopsduplicate", $realname );
	      die;
	 } else {
	      $dupCheck{"$mName"} = $mName;
	 }
    }

    # Check size
    $sizeLimit = &TWiki::Prefs::getPreferencesValue ( "UPLOADZIPLIMIT" );
    if ( $sizeLimit ) {
         $sizeLimit = limitTranslate ($sizeLimit);

    	 if ( $size > $sizeLimit ) {
	      handleError ( $noredirect, "Zip exceeds limit.",
			    $query, $webName, $topic, "oopstoobig", $realname );

	      die;
	 }
    }

    return $zip;
}

# EPIC
# Translates shorthand into actual bytes.
# 1[Kk] is 1024 bytes, 1[Mm] is 1024K.
sub limitTranslate
{
    my $limit = shift;

    my $multiplier;

    use integer;

    if ( $limit =~ /[Mm][Bb]?$/ ) {
         $multiplier = 1024 * 1024;
    } elsif ( $limit =~ /[Kk][Bb]?$/ ) {
         $multiplier = 1024;
    } else {
         $multiplier = 1;
    }

    $limit =~ s/[^\d]//go;
    if ( $limit ) {
	 $limit = $limit * $multiplier;
    } else {
	 $limit = 0;
    }

    no integer;

    return $limit;
}

sub makeTempName
{
    my $baseDir = shift;
    my $tempName = sprintf( "%d-%d.%d", $$, time(), rand( 10000 ) );
    return $baseDir ? $baseDir . "/" . $tempName : $tempName;
}

# EOF
