##*****************************************************************************
## Unordered internal helper functions.
##*****************************************************************************



##*****************************************************************************
## Creates a directory if needed and stops on failure.
##
## PARAMETER: String directory
## RETURN:    Boolean success (true, on fail, execution stops)
##*****************************************************************************
dirCreateStop <- function( dir=NULL ) {
  if( !is.null( dir ) && !file.exists( dir ) ) {
    if( dir.create( dir, recursive=TRUE ) ) {
      message( "Created directory: ", dir )
      return( invisible( TRUE ) );
    }
    else
      stop( "UNABLE to create directory: ", dir )
  }

  ## Never reached.
  return( invisible( FALSE ) );
}

##***************************************************************************
## Add a file (with absolute path) to remove list after sfStop().
## Used for save/restore-files.
##
## PARAMETER: file String abs. filepath
##***************************************************************************
addRestoreFile <- function( file=NULL ) {
  if( !is.null( file ) )
    if( is.vector( .sfOption$RESTOREFILES ) )
      .sfOption$RESTOREFILES <<- c( .sfOption$RESTOREFILES, file )
    else
      .sfOption$RESTOREFILES <<- c( file )

##  cat( "Added file for delete: ", file, "\n" )

  return( invisible( length( .sfOption$RESTOREFILES ) ) )
}

##***************************************************************************
## Clean up save/restore files after successfull cluster shutdown.
##***************************************************************************
deleteRestoreFiles <- function() {
  if( !is.null( .sfOption$RESTOREFILES ) ) {
    ## File names are absolute: just unlink all.
##    lapply( .sfOption$RESTOREFILES, unlink )
    for( file in .sfOption$RESTOREFILES ) {
      if( unlink( file ) != 0 )
        cat( "Unable to delete save/restore file:", file, "\n" )
      else
        cat( "Deleted save/restore file:", file, "\n" )
    }

    .sfOption$RESTOREFILES <- NULL
  }
}

##***************************************************************************
## Check if any element of a given list produced a stop or try-error.
## RETURN: Vector of logicals (true: ok, false: try error caught).
##***************************************************************************
checkTryErrorAny <- function( res ) {
  return( sapply( res,
                  function( x ) {                   
                    if( inherits( x, "try-error" ) )
                      return( FALSE )
                    else
                      return( TRUE )
                  }
                 ) )
}

##***************************************************************************
## Check if given argument is a function.
##***************************************************************************
checkFunction <- function( fun, stopOnError=TRUE ) {
  return( TRUE )

  state <- FALSE

  try( if( !exists( as.character( substitute( fun ) ), inherit=TRUE ) ||
          !is.function( fun ) ||
          is.null( get( as.character( substitute( fun ) ), inherit=TRUE ) ) ||
          !is.function( fun ) ) state <- TRUE )
  
  if( !state ) {
##    if( !is.function( fun ) ) cat( "FAIL SYMBOL\n" )
##    if( !exists( as.character( substitute( fun ) ), inherit=TRUE ) ) cat( "FAIL EXIST\n" )
##    if( is.null( get( as.character( substitute( fun ) ), inherit=TRUE ) ) ) cat( "FAIL GET\n" )
##    if( !is.function( fun ) ) cat( "FAIL FUNCTION\n" )

    if( stopOnError )
      stop( paste( "Not a function in sfCluster function call: '", fun, "'" ) )
  }

  return( state )
}

errHandler <- function( ... ) {
  print( "ERROR IN HANDLING STUFF!\n" )
}

##***************************************************************************
## Treat given three dot arguments as strings (for names listings
## like in sfExport).
## Ripped from buildin R function rm (by XXX).
## Returns list with names, stops on errors.
##***************************************************************************
fetchNames <- function( ... ) {
  ## Dot argument to list of characters: ripped from rm()...
  dots <- match.call(expand.dots = FALSE)$...

  if( length(dots) &&
      !all( sapply( dots, function(x) is.symbol(x) || is.character(x) ) ) )
    stop( "... must contain names or character strings in function ",
          as.character( sys.call( -1 ) ) )

  names <- sapply(dots, as.character)
  ## End ripp.

  return( names )
}

##***************************************************************************
## Create named list with all parameters from an function call.
## Idea somewhere from R-help (not tracked).
## This does not work if above env is not global env!
##***************************************************************************
getNamedArguments <- function( ... ) {
  pars <- as.list( substitute( {...} )[-1] )

##  pars <- as.list( substitute( {...} )[-1] )
##  pars <- lapply( pars, function( x ) {
##                                        if( is.atomic( x ) )
##                                          return( x )
##                                        else
##                                          return( deparse( x ) )
##                                      } )

  return( pars )
}

##***************************************************************************
## Ensure a given filename contains an absolute path.
## Kind of silly and lame. But works in most cases.
##***************************************************************************
absFilePath <- function( file ) {
  ## If not starting with separator, path is most likely relative.
  ## Make it absolute then.
  if( substr( file, 0, 1 ) != .Platform$file.sep )
    file <- file.path( getwd(), file )

  return( file )
}

.onLoad <- function( lib, pkg ) {
##  options( "error"=errHandler )
}