WebPFix.tcl

### WebPFix.tcl 1.2.0 mNct0SYj

#SUGGESTED
# PBinSrc.tcl fMrtKqyq
# TCLLoader.tcl smApj15u

#LICENSE
# Copyright © 2013 Alberto Dietze "DoctorD90"
#
#    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 3 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, see <http://www.gnu.org/licenses/>.
#
# Full GPLv3 Text: http://www.gnu.org/licenses/gpl.txt

#PATERNITY
#Coder: DoctorD90
#Network: irc.OnlineGamesNet.net
#Chan: #eHito
#Mail: [email protected]
#Script's List: www.EggTcl.tk

#PURPOSE
#Check links like 'google.com' and add protocol and www.
#Is possible choice type (www, m, wap, etc)
#and protocol (http, ftp, irc, mail, etc)

#USAGE
#Ex. [webpfix_adder "google.com"] => http://www.google.com
#Ex. [webpfix_adder "google.com" "m" "ftp"] => ftp://m.google.com
#By default is http and www


### DON'T EDIT ANYTHING BELOW ###

proc webpfix_adder {link {mod "www"} {ptc "http"}} {
  if {[string length [string trim $ptc]] && ![string match -nocase "*://" $ptc]} {
    append ptc "://"
  }
  if {[string length [string trim $mod]] && ![string match -nocase "*." $mod]} {
    append mod "."
  }
  set m [string match -nocase "${mod}*" $link]
  set p [string match -nocase "${ptc}*" $link]
  set t [string match -nocase "${ptc}${mod}*" $link]
  if {!$p && !$m} {
    set fix "${ptc}${mod}"
  } elseif {!$p && $m} {
    set fix "${ptc}"
  } elseif {$p && !$t} {
    set fix "${ptc}${mod}"
    set link [string range $link [string length $ptc] end]
  } else {
    set fix ""
  }
  return "${fix}$link"
}

###
putlog "WebPFix.tcl LOADED"