# Path parsing library module,
# Rick Smereka, Copyright (C) 2006.

# 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, get a copy via the Internet at
# http://gnu.org/copyleft/gpl.html or write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA

# You can contact the author via email at rsmereka@future-lab.com

# Initial tcl version. Jul/2006, Rick Smereka

proc path_split {pin has_fname drive path fname} {
   # Split a path into it's component parts. Parts are returned
   # in 'drive' (single character), 'path' and 'fname'. 'drive'
   # is always an empty string in a Unix/Linux/BSD system. Paths
   # must be supplied in absolute form, not in relative form. The
   # last component of the path is assumed to be the file name.
   # The flag 'has_fname' indicates whether a file name is
   # present in the input path ('pin'). Returns 1 upon success,
   # 0 otherwise.
   global PATH_SEP tcl_platform
   upvar $drive udrive
   upvar $path upath
   upvar $fname ufname
   set mname "path_split"
   set udrive ""
   set upath ""
   set ufname ""

   # basic checks
   if {$pin == ""} {
      logman "$mname:empty(pin)"
      return 0
   }

   # path must contain a minimum of 3 words if the file name
   # is present, 2 words otherwise
   set nwords [ll_words $pin $PATH_SEP]

   if {$has_fname} {
      if {$nwords < 3} {
         logman "$mname:invalid path(pin) s/b min of 3 words"
         return 0
      }
   } else {
      if {$nwords < 2} {
         logman "$mname:invalid path(pin) s/b min of 2 words"
         return 0
      }
   }

   # isolate drive first, a colon in the second byte is required
   # under Windows
   if {$tcl_platform(platform) == "windows"} {
      if {[string index $pin 1] != ":"} {
         logman "$mname:drive ID must be present under Windows systems"
         return 0
      }

      set drive_id [string toupper [string index $pin 0]]

      if {![string is alpha -strict $drive_id]} {
         logman "$mname:'$drive_id' is not a valid drive letter"
         return 0
      }

   set udrive $drive_id
   }

   # isolate the path next
   if {$has_fname} {
      set last_dir [expr $nwords - 1]
   } else {
      set last_dir $nwords
   }

   # start from word 2
   set tmp_path ""

   for {set i 2} {$i <= $last_dir} {incr i} {
      if {![ll_word $pin tmp $i $PATH_SEP]} {
         logman "$mname:bad rc(0) from ll_word($i)"
         return 0
      }

      set len [string length $tmp]

      for {set j 0} {$j < $len} {incr j} {
         append tmp_path [string index $tmp $j]
      }

      if {$i < $last_dir} {
         append tmp_path $PATH_SEP
      }
   }

   set upath $tmp_path

   # isolate file name last
   if {$has_fname} {
      if {![ll_word $pin tmp $nwords $PATH_SEP]} {
         logman "$mname:bad rc from ll_word($nwords)"
         return 0
      }

   set ufname $tmp
   }

   return 1
}

proc path_join {drive path fname pout} {
   # Join a path from it's component parts. In Windows, the 'drive'
   # is required to be a single alphabetic character representing
   # the drive ID. The 'path' must not begin with a path separator.
   # Upon success, the joined path will be placed into 'pout'. The
   # file name ('fname') may be an empty string which indicates no
   # file name. Returns 1 upon success, 0 otherwise.
   global PATH_SEP tcl_platform
   upvar $pout upout
   set mname "path_join"
   set upout ""

   # check drive ID in Windows
   if {$tcl_platform(platform) == "windows"} {
      if {![string is alpha -strict $drive]} {
         logman "$mname:'$drive' is not a valid drive letter"
         return 0
      }
   }

   if {$path == ""} {
      logman "$mname:empty(path)"
      return 0
   }

   # make sure 'path' does not start with separator
   if {[string index $path 0] == $PATH_SEP} {
      logman "$mname:'path' component must not start with a separator"
      return 0
   }

   if {$fname != "" } {
      set has_fname 1
   } else {
      set has_fname 0
   }

   # build joined path
   if {$tcl_platform(platform) == "windows"} {
      if {$has_fname} {
         set upout [format "%s:%s%s%s%s" $drive $PATH_SEP $path $PATH_SEP \
                           $fname]
      } else {
         set upout [format "%s:%s%s" $drive $PATH_SEP $path]
      }
   }

   if {$tcl_platform(platform) == "unix"} {
      if {$has_fname} {
         set upout [format "%s%s%s%s" $PATH_SEP $path $PATH_SEP $fname]
      } else {
         set upout [format "%s%s" $PATH_SEP $path]
      }
   }

   return 1
}

