###############################################################################
#
#  Inout perl module
#
#  Input/output functions.
#
#   create_tmp_dir            Uses mktemp to create a temporary directory
#   create_tmp_fil            Uses mktemp to create a temporary file
#   error_exit                Displays an error message and exits
#   fprint_formatted          Formatted print to file
#   get_extension             Extracts the extension
#   get_path_and_extension    Extracts the path and extension
#   print_formatted           Formatted print to stdout
#   print_warning             Displays a warning
#   sprint_formatted          Formatted print to string
#   strip_path                Strips the path from a file
#   strip_path_and_extension  Strips the path and the extension from a file
#   syntax_error              Displays an error message and the syntax, and
#                             exits
#
###############################################################################

#
# Note: You have to include the directory you have installed this module in
#       into your $PERL5LIB environment variable (e.g. include a statement like
#          export PERL5LIB=${PERL5LIB}:directory_you_saved_these_modules_in
#       into your .bash_profile file).
#

# See http://www.deschutter.info/util/scripts.html for the latest version of
# these perl modules.

# Status: public

package Inout;

use strict;
use IO::File;

BEGIN {
   use Exporter   ();
   use vars       qw($VERSION @ISA @EXPORT);
   
   $VERSION     = 1.00;
   @ISA         = qw(Exporter);
   @EXPORT      = qw(
                      &create_tmp_dir
                      &create_tmp_fil
                      &error_exit
                      &fprint_formatted
                      &get_extension
                      &get_path_and_extension
                      &print_formatted
                      &print_warning
                      &sprint_formatted
                      &strip_path
                      &strip_path_and_extension
                      &syntax_error
                     );
}


###############################################################################
#
#  FUNCTION DEFINITIONS
#
###############################################################################


###############################################################################
#
#  syntax_error ($err_msg)
#
#  Displays an error message and the syntax of the command, and exits.
#
#  Inputs:  $err_msg  error message
#
#  Outputs: none
#
#
#  Created: Jul 29, 1999       by Bart De Schutter
#  Last revised: Feb 17, 2000  by Bart De Schutter
#
###############################################################################

sub syntax_error
{
   my ($err_msg) = @_;

   print STDERR "\n";
   fprint_formatted (\*STDERR, "ERROR: $err_msg", 79, 7, 0, 1);
   print STDERR "\n";
   system ("sed '/^\$/q;/^#!/d;s/^# //;s/^#//' $0 >&2");
   exit 1;
}      


###############################################################################
#
#  $base_name = strip_path_and_extension ($file_name)
#
#  Removes the path and the extension from a file name. If $max_ext equals
#  1 then the extension of the file a.b.c. is b.c and otherwise the extension
#  is c.
#
#  Inputs:  $file_name  file name
#           $max_ext    maximal extension flag, optional (default value: 1)
#
#  Outputs: $base_name  base name
#
#
#  Created: Jul 29, 1999       by Bart De Schutter
#  Last revised: Mar 18, 2000  by Bart De Schutter
#
###############################################################################

sub strip_path_and_extension
{
   my ($file_name, $max_ext) = @_;
  
   $max_ext = 1 if !defined($max_ext);
   if ( $file_name =~ /.*\/(.*)/ )
   {
      $file_name = $1;
   }
   if ( $max_ext == 1 )
   {
      if ( $file_name =~ /(.*?)\..*$/ )
      {
         $file_name = $1;
      }
   }
   elsif ( $file_name =~ /(.*)\..*$/ )
   {
      $file_name = $1;
   }
   return ($file_name);
}   


###############################################################################
#
#  ($base_name, $extension, $path) = get_path_and_extension ($file_name,
#                                                            $max_ext)
#
#  Extracts the path and the extension from a file name. If $max_ext equals
#  1 then the extension of the file a.b.c. is b.c and otherwise the extension
#  is c.
#
#  Inputs:  $file_name  file name
#           $max_ext    maximal extension flag, optional (default value: 1)
#
#  Outputs: $base_name  base name
#           $extension  extension
#           $path       path
#
#
#  Created: Mar 18, 2000       by Bart De Schutter
#  Last revised:
#
###############################################################################

sub get_path_and_extension
{
   my ($file_name, $max_ext) = @_;
   my ($extension, $path);

   $max_ext = 1 if !defined($max_ext);
   $extension = $path = "";
   if ( $file_name =~ /(.*)\/(.*)/ )
   {
      $path = $1;
      $file_name = $2;
   }
   if ( $max_ext == 1 )
   {
      if ( $file_name =~ /(.*?)\.(.*)$/ )
      {
         $file_name = $1;
         $extension = $2;
      }
   }
   elsif ( $file_name =~ /(.*)\.(.*)$/ )
   {
      $file_name = $1;
      $extension = $2;
   }
   return ($file_name, $extension, $path);
}   


###############################################################################
#
#  ($path_and_base_name, $extension) = get_extension ($file_name, $max_ext)
#
#  Extracts the extension from a file name. If $max_ext equals 1 then the
#  extension of the file a.b.c. is b.c and otherwise the extension is c.
#
#  Inputs:  $file_name  file name
#           $max_ext    maximal extension flag, optional (default value: 1)
#
#  Outputs: $path_and_base_name  path and base name
#           $extension           extension
#
#
#  Created: Aug  6, 2004       by Bart De Schutter
#  Last revised:
#
###############################################################################

sub get_extension
{
   my ($file_name, $max_ext) = @_;
   my ($extension);

   $max_ext = 1 if !defined($max_ext);
   $extension = "";
   if ( $max_ext == 1 )
   {
      if ( $file_name =~ /(.*?)\.([^\/]*)$/ )
      {
         $file_name = $1;
         $extension = $2;
      }
   }
   elsif ( $file_name =~ /(.*)\.([^\/]*)$/ )
   {
      $file_name = $1;
      $extension = $2;
   }
   return ($file_name, $extension);
}   


###############################################################################
#
#  $no_path = strip_path ($file_name)
#
#  Removes the path from a file name.
#
#  Inputs:  $file_name  file name
#
#  Outputs: $no_path  file name without path.
#
#
#  Created: Jul 29, 1999       by Bart De Schutter
#  Last revised:
#
###############################################################################

sub strip_path
{
   my ($file_name) = @_;

   if ( $file_name =~ /.*\/(.*)/ )
   {
      $file_name = $1;
   }
   return ($file_name);
}   


###############################################################################
#
#  error_exit ($errmsg)
#
#  Displays an error message and exits.
#
#  Inputs:  $err_msg  error message
#
#  Outputs: none
#
#
#  Created: Jul 29, 1999       by Bart De Schutter
#  Last revised:
#
###############################################################################

sub error_exit
{
   my ($err_msg) = @_;

   print STDERR "\n";
   fprint_formatted (\*STDERR, "ERROR: $err_msg", 79, 7, 0, 1);
   print STDERR "\n";
   exit 1;
}    


###############################################################################
#
#  print_warning ($msg)
#
#  Displays a warning message on STDERR output.
#
#  Inputs:  $msg  warning message
#
#  Outputs: none
#
#
#  Created: Feb 17, 2000       by Bart De Schutter
#  Last revised:
#
###############################################################################

sub print_warning
{
   my ($msg) = @_;

   print STDERR "\n";
   fprint_formatted (\*STDERR, "WARNING: $msg", 79, 9);
   print STDERR "\n";
}    


###############################################################################
#
#  $buffer = sprint_formatted ($string, $width, $next_indent, $first_indent,
#                              $truncate)
#
#  Formatted print to string with given width and indents.
#
#  Inputs: $string        string to be printed
#          $width         line width, optional (default value: 80)
#                         Note: words longer than $width will be truncated
#          $next_indent   index for the second, third, ... lines,
#                         optional (default value: 0)
#          $first_indent  indent for the first line,
#                         optional (default value: 0)
#          $truncate      truncate word if longer than $width,
#                         optional (default value: 0)
#
#  Outputs: $buffer  printed string
#
#
#  Created: Feb 17, 2000       by Bart De Schutter
#  Last revised: May  8, 2011  by Bart De Schutter
#
###############################################################################

sub sprint_formatted
{
   my ($string, $width, $next_indent, $first_indent, $truncate,
       $level) = @_;
   my ($buffer, $first, $block, @blocks, $len, $word, @words, $i);
   my ($line_pos, $n_words);

   $width = 80 if ( !defined ($width) );
   $next_indent = 0 if ( !defined ($next_indent) );
   $first_indent = 0 if ( !defined ($first_indent) );
   $truncate = 0 if ( !defined ($truncate) );

   if ( !defined ($level) )
   {
      $buffer = "";
      @blocks = split(/\n/, $string."\nXXX");
      for ( $i = 0; $i < $#blocks; $i++ )
      {
         if ( $i == 0 )
         {
            $buffer .= sprint_formatted ($blocks[$i], $width, $next_indent,
                              $first_indent, $truncate, "recursive");
         }
         else
         {
            $buffer .= sprint_formatted ($blocks[$i], $width, $next_indent,
                              $next_indent, $truncate, "recursive");
         }
      }
      return ($buffer);
   }
   #
   #   Now all newlines have been removed.
   #
   $buffer = ( $first_indent > 0 ) ? sprintf("%${first_indent}s", " ") : "";
   $line_pos = $first_indent;
   @words = split (/ /, $string);
   $n_words = $#words;
   for ( $i = 0;  $i <= $n_words; $i++ )
   {
      $word = $words[$i];
      $len = length ($word);
      if ( $line_pos + $len > $width )        # start new line
      {
         if ( $i != 0 )
         {
            $buffer .= "\n";
            $buffer .= ( $next_indent > 0 ) ?
                       sprintf("%${next_indent}s", " ") : "";
            $line_pos = $next_indent;
         }
         if ( $line_pos + $len > $width )     # word has to be truncated
         {
            $len = $width-$line_pos;
            $word = substr ($word, 0, $len) if ( $truncate );
         }
      }
      $buffer .= $word;
      $line_pos += $len;
      if ( $line_pos < $width )       # space fits on line
      {
         $buffer .= " ";
         $line_pos++;
      }
      else                            # end of line reached
      {
         if ( $i < $n_words )
         {
            $buffer .= "\n";
            $buffer .= ( $next_indent > 0 ) ?
                       sprintf("%${next_indent}s", " ") : "";
            $line_pos = $next_indent;
         }
      }
   }
   return ("$buffer\n");
}    


###############################################################################
#
#  fprint_formatted ($file_h, $string, $width, $next_indent, $first_indent,
#                    $truncate)
#
#  Formatted print to file with given width and indents.
#
#  Inputs: $file_h        output file handle
#          $string        string to be printed.
#          $width         line width, optional (default value: 80)
#                         Note: words longer than $width will be truncated
#          $next_indent   index for the second, third, ... lines,
#                         optional (default value: 0)
#          $first_indent  indent for the first line,
#                         optional (default value: 0)
#          $truncate      truncate word if longer than $width,
#                         optional (default value: 0)
#
#  Outputs: none
#
#
#  Created: Feb 17, 2000       by Bart De Schutter
#  Last revised: May  8, 2011  by Bart De Schutter
#
###############################################################################

sub fprint_formatted
{
   my ($file_h, @other) = @_;

   print $file_h sprint_formatted (@other);
}


###############################################################################
#
#  print_formatted ($string, $width, $next_indent, $first_indent, $truncate)
#
#  Formatted print to standard output with given width and indents.
#
#  Inputs: $string        string to be printed.
#          $width         line width, optional (default value: 80)
#                         Note: words longer than $width will be truncated
#          $next_indent   index for the second, third, ... lines,
#                         optional (default value: 0)
#          $first_indent  indent for the first line,
#                         optional (default value: 0)
#          $truncate      truncate word if longer than $width,
#                         optional (default value: 0)
#
#  Outputs: none
#
#
#  Created: Mar  9, 2000       by Bart De Schutter
#  Last revised:
#
###############################################################################

sub print_formatted
{
#   my ($string, $width, $next_indent, $first_indent, $truncate) = @_;
#
#   fprint_formatted (\*STDOUT,  $string, $width, $next_indent,
#                     $first_indent, $truncate);
   fprint_formatted (\*STDOUT, @_);
}


###############################################################################
#
#  $tmp_dir = create_tmp_dir ($prefix)
#
#  Uses mktemp to create a temperary directory rooted in
#   . HOME/tmp, if it exists,
#   . or otherwise TMPDIR, if defined
#   . or otherwise /tmp
#   . or otherwise the current directory
#  The template used consists of the prefix $prefix, followed by the date, 
#  the time, and 12 Xs (all separated by underscores).
#
#  Inputs:  $prefix  prefix string
#
#  Outputs: $tmp_dir  temporary directory
#
#
#  Created: Aug  4, 2007       by Bart De Schutter
#  Last revised: Jan  2, 2011  by Bart De Schutter
#
###############################################################################

sub create_tmp_dir
{
   my ($prefix) = @_;
   my ($tmp_dir, $tmp_template);
   
   if (  !defined($ENV{'HOME'})  ||  ! -d ( $tmp_dir = $ENV{'HOME'}."/tmp" )  )
   {
      if (  !defined ($tmp_dir = $ENV{'TMPDIR'})  ||  ! -d ( $tmp_dir )  )
      {
         if ( ! -d ( $tmp_dir = "/tmp" ) )
         {
            $tmp_dir=`pwd`;
         }
      }
   }
   $tmp_template = "${prefix}__`date '+%Y_%m_%d__%H_%M_%S'`__XXXXXXXXXXXX";
   chomp ($tmp_dir = `mktemp -d $tmp_dir/$tmp_template`);
   error_exit ("Error while creating temporary directory $tmp_dir.")
       if ( ! -d ( $tmp_dir ) );
   return ($tmp_dir);
}


###############################################################################
#
#  $tmp_fil = create_tmp_fil ($prefix)
#
#  Uses mktemp to create a temperary file located in
#   . HOME/tmp, if it exists,
#   . or otherwise TMPDIR, if defined
#   . or otherwise /tmp
#   . or otherwise the current directory
#  The template used consists of the prefix $prefix, followed by the date, 
#  the time, and 12 Xs (all separated by underscores).
#
#  Inputs:  $prefix  prefix string
#
#  Outputs: $tmp_fil  temporary file
#
#
#  Created: Aug  4, 2007       by Bart De Schutter
#  Last revised: Jan  2, 2012  by Bart De Schutter
#
###############################################################################

sub create_tmp_fil
{
   my ($prefix) = @_;
   my ($tmp_fil, $tmp_dir, $tmp_template);

   if (  !defined($ENV{'HOME'})  ||  ! -d ( $tmp_dir = $ENV{'HOME'}."/tmp" )  )
   {
      if (  !defined ($tmp_dir = $ENV{'TMPDIR'})  ||  ! -d ( $tmp_dir )  )
      {
         if ( ! -d ( $tmp_dir = "/tmp" ) )
         {
            $tmp_dir=`pwd`;
         }
      }
   }
   $tmp_template = "${prefix}__`date '+%Y_%m_%d__%H_%M_%S'`__XXXXXXXXXXXX";
   chomp ($tmp_fil = `mktemp $tmp_dir/$tmp_template`);
   error_exit ("Error while creating temporary file $tmp_fil.")
       if ( ! -f ( $tmp_fil ) );
   return ($tmp_fil);
}


###############################################################################
#
#  END OF FUNCTION DEFINITIONS
#
###############################################################################


1;

#END { }       # module clean-up code here (global destructor)