#---------------------------------------------------------------------#
# incith:pisg                                            $Rev:: 126 $ #
# $Id:: incith-pisg.tcl 126 2009-08-09 03:51:08Z incith             $ #
#                                                                     #
# manual and automatic pisg channel statistics generator              #
# tested on Eggdrop & Windrop v1.6.17                                 #
#                                                                     #
# Usage:                                                              #
#   .chanset #channel +pisg (required for automatic generation too)   #
#   !pisg [#channel|*]                                                #
#     runs the pisg program to generate channel statistics for the    #
#     current channel, or for #channel.  specifying * will generate   #
#     stats for all +pisg channels.                                   #
#   .pisg <#channel|*> (partyline support, same as above)             #
#                                                                     #
# Requirements:                                                       #
#   - pisg: http://pisg.sourceforge.net/                              #
#                                                                     #
# For Windows/Windrop users:                                          #
#   - Install ActivePerl: http://www.activestate.com/activeperl/      #
#   - Rename pisg to pisg.pl (from pisg-0.xx.zip) (maybe optional)    #
#   - If you are having problems with [exec], please see:             #
#     http://forum.egghelp.org/viewtopic.php?p=86629#86629            #
#                                                                     #
# ChangeLog (m/d/y):                                                  #
#   7/08/09: addition to remove previous time binds upon load/rehash. #
#   1/17/09: license changed to GPL3.                                 #
#   1/15/09: small tweaks for release.  released 1.0.                 #
#                                                                     #
# TODO:                                                               #
#   - Suggestions/Thanks/Bugs/Ideas, e-mail at bottom of header.      #
#                                                                     #
# LICENSE (GPLv3):                                                    #
#   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.              #
#   (http://www.gnu.org/licenses/gpl-3.0.txt)                         #
#                                                                     #
# Copyright (C) 2009, Jordan                                          #
# http://incith.com ~ incith@gmail.com ~ irc.freenode.net/#incith     #
#---------------------------------------------------------------------#
setudef flag pisg

# 0 (zero) will disable an optional variable, 1 or above enables
#
namespace eval incith::pisg {
  # the bind prefix/command char(s) ({!} or {! .} etc, separate with space)
  variable command_chars {! .}

  # binds {one two three}
  variable binds {pisg}

  # allow binds to be used in /msg's to the bot?
  variable private_messages 1

  # send public/channel output to the user instead?
  variable public_to_private 0

  # send replies as /notices instead of messages?
  variable notices 0

  # levels required to use the binds, global|channel.
  variable public_flags {n|o}
  variable private_flag {n|-}     # only the global flag matters.
  variable dcc_flag     {n|-}     # same here.

  # only send script 'errors' as notices? (not enough input etc)
  variable notice_errors_only 0

  # url where the stats files can be viewed
  variable url "http://incith.com/"

  # the message to send after pisg has updated a channel(s)
  # %url% will send url
  # %file% will add the OutputFile filename to url if wanted
  variable update_message "Channel Stats Updated @ %url%%file%"

  # WINDOWS USERS: SET THIS TO YOUR PERL.EXE (ignored on non-windows)
  variable perl {C:/Perl64/bin/perl.exe}

  # pisg settings
  variable pisg {/usr/bin/pisg}
  variable pisg_config {/home/incith/.pisg/pisg.cfg}

  # which hours to auto-update at ("0 6 12 18" will be midnight, 6am, noon, 6pm, "" will disable)
  variable auto_times "1"

  # disable/enable ftp upload (0/1)
  variable ftp 0
  variable ftp_server "incith.com"
  variable ftp_username "incith"
  variable ftp_password ""
  # path to PUT the html OutputFile's on the ftp server
  variable ftp_remote_folder "./public_html"
}

# script begings
namespace eval incith::pisg {
  variable version "incith:pisg-SVN"
  variable debug 1
  array set static {}
  array unset static *

  # [ipl] : a neat/handy putlog procedure, moved up here to use it sooner
  #
  proc ipl {who {where {}} {what {}}} {
    if {$where == "" && $what == ""} {
      # first argument only = data only
      putlog "${incith::pisg::version}: ${who}"
    } elseif {$where != "" && $what == ""} {
      # two arguments = who and data
      putlog "${incith::pisg::version}: <${who}> ${where}"
    } else {
      # all three...
      putlog "${incith::pisg::version}: <${who}/${where}> ${what}"
    }
  }

  # error checking
  if {[info exists ::env(WINDIR)]} {
    if {[info exists incith::pisg::perl]} {
      regsub -all -- {\\} $incith::pisg::perl {/} incith::pisg::perl
      regsub -all -- {//} $incith::pisg::perl {/\\} incith::pisg::perl
      if {![file executable $incith::pisg::perl]} {
        ipl "Perl not found or not executable at '${incith::pisg::perl}', loading aborted."
      }
    }
  }
  regsub -all -- {\\} $incith::pisg::pisg {/} incith::pisg::pisg
  regsub -all -- {//} $incith::pisg::pisg {/\\} incith::pisg::pisg
  regsub -all -- {\\} $incith::pisg::pisg_config {/} incith::pisg::pisg_config
  regsub -all -- {//} $incith::pisg::pisg_config {/\\} incith::pisg::pisg_config
  if {![file readable $incith::pisg::pisg]} {
    ipl "pisg not found or not executable at '${incith::pisg::pisg}', loading aborted."
    return
  } elseif {![file readable $incith::pisg::pisg_config]} {
    ipl "error reading pisg configuration at '${incith::pisg::pisg_config}', loading aborted."
    return
  } else {
    # add a trailing slash if needed
    if {![string match "*/" $incith::pisg::url]} {
      set incith::pisg::url "${incith::pisg::url}/"
    }
    if {![string match "*/" $incith::pisg::ftp_remote_folder]} {
      set incith::pisg::ftp_remote_folder "${incith::pisg::ftp_remote_folder}/"
    }
    # read the pisg config and fetch the channels and OutputFiles
    set static(pisgcfg) "" ; set static(channels) ""
    set cfgpipe [open ${incith::pisg::pisg_config} "r"]
    while {![eof $cfgpipe]} {
      append static(pisgcfg) "[gets $cfgpipe]\n"
    }
    close $cfgpipe
    foreach cfgline [split $static(pisgcfg) "\n"] {
      if {[string match "*<channel*" [string tolower $cfgline]]} {
        regexp -nocase -- {<channel\=\"?(.+?)\"?>} $cfgline - tmp
      }
      if {[string match "*outputfile*" [string tolower $cfgline]]} {
        regexp -nocase -- {OutputFile\s*\=\s*\"?(.+?)\"?} $cfgline - tmpfile
        if {[info exists tmp] && [info exists tmpfile]} {
          set tmp [string tolower $tmp]
          regsub -all -- {\\} $tmpfile {/} tmpfile
          regsub -all -- {//} $tmpfile {/\\} tmpfile
          # if OutputFile does not contain a path, pisg will be run from eggdrops working directory, so...
          if {![string match "*/*" $tmpfile]} {
            set tmpfile "[pwd]/${tmpfile}"
          }
          append static(channels) "${tmp};"
          set static(${tmp}) $tmpfile
          set static(${tmp},basename) [file tail $tmpfile]
          # putlog "${tmp} = ${tmpfile} (basename = $static(${tmp},basename))"
          unset tmp; unset tmpfile
          continue
        }
      }
    }
    set static(channels) [string trimright $static(channels) {;}]
  }
}

# bind the binds
foreach command_char [split [string trim $incith::pisg::command_chars] " "] {
  foreach bind [split [string trim $incith::pisg::binds] " "] {
    # public message binds
    bind pub ${incith::pisg::public_flags} "${command_char}${bind}" incith::pisg::message_handler

    # private message binds
    if {${incith::pisg::private_messages} >= 1} {
      bind msg ${incith::pisg::private_flag} "${command_char}${bind}" incith::pisg::message_handler
    }
    bind dcc ${incith::pisg::dcc_flag} ${bind} incith::pisg::generate_dcc
  }
}

# unbind any previous auto-update times
foreach pisg_timebind [binds *generate_auto*] {
  regexp -- {^(time) (\-\|\-) \{(.+?)\}\ \d+\ (incith::pisg::generate_auto)} $pisg_timebind - type flags cmd proc
  unbind $type $flags "$cmd" $proc
}

# bind the auto-update times
foreach update_hour [split [string trim $incith::pisg::auto_times] " "] {
  bind time - "00 [format "%02d" ${update_hour}] * * *" incith::pisg::generate_auto
}

namespace eval incith::pisg {
  # [message_handler] : handles public & private messages
  #
  proc message_handler {nick uhand hand args} {
    global lastbind
    upvar #0 incith::pisg::static static
    set input(who) $nick
    if {[llength $args] >= 2} { # public message
      set input(where) [lindex $args 0]
      if {${incith::pisg::public_to_private} >= 1} {
        set input(chan) $input(who)
      } else {
        set input(chan) $input(where)
      }
      set input(query) [lindex $args 1]
      if {[channel get $input(where) pisg] != 1} {
        return
      }
    } else {                    # private message
      set input(where) "private"
      set input(chan) $input(who)
      set input(query) [lindex $args 0]
      if {${incith::pisg::private_messages} <= 0} {
        return
      }
    }

    # TODO: check flood protection here

    # log it
    if {${input(where)} == "private" && [regexp -- {^\s*$} $input(query)]} {
      ipl "<${input(who)}/${input(where)}> ${lastbind}"
      send_output $input(chan) "Please supply a channel to generate stats for." $input(who)
      return
    } else {
      if {[regexp -- {^\s*$} $input(query)]} {
        set input(query) $input(where)
      }
      ipl ${input(who)} ${input(where)} "${lastbind} ${input(query)}"
      if {![string match "#*" $input(query)] && ![string match "&*" $input(query)] && $input(query) != "*"} {
        set input(query) "#${input(query)}"
      }
      set input(query) [string tolower $input(query)]
      if {$input(query) == "*"} {
        incith::pisg::generate [array get input]
      } else {
        incith::pisg::generate [array get input] $input(query)
      }
    }
  }

  # [generate_dcc] : for partyline support
  #
  proc generate_dcc {hand idx text} {
    global lastbind    
    if {$text == ""} {
      putdcc $idx "Please supply a channel name, or * for all channels."
    } else {
      ipl "<${hand}/dcc> \.${lastbind} $text"
      if {![string match "#*" $text] && ![string match "&*" $text] && $text != "*"} {
        set text "#${text}"
      }
      set text [string tolower $text]
      set input(dcc) 1
      set input(idx) $idx
      if {$text == "*"} {
        incith::pisg::generate [array get input]
      } else {
        incith::pisg::generate [array get input] $text
      }
    }
  }

  # [generate_auto] : called by the timer
  #
  proc generate_auto {args} {
    incith::pisg::generate [array get args]
  }

  # [generate] : I know my shameless hacks for if it's a dcc session suck.
  #
  proc generate {tmpInput {chan {}}} {
    upvar #0 incith::pisg::static static
    if {[info exists tmpInput]} {
      array set input $tmpInput
    }
    if {$chan != ""} {
      if {![info exists incith::pisg::static($chan)]} {
        if {![info exists input(dcc)]} {
          send_output $input(chan) "No configuration found for '${chan}', you may need to .rehash, or update your pisg configuration." $input(who)
        } else {
          putdcc $input(idx) "No configuration found for '${chan}', you may need to .rehash, or update your pisg configuration."
        }
        return
      }
      if {[info exists ::env(WINDIR)] && [info exists incith::pisg::perl]} {
        catch {set - [exec $incith::pisg::perl $incith::pisg::pisg -co $incith::pisg::pisg_config -cc $chan]} gen_errs
      } else {
        catch {set - [exec $incith::pisg::pisg -co $incith::pisg::pisg_config -cc $chan]} gen_errs
      }
      if {[string match {} $gen_errs]} {
        set file $incith::pisg::static(${chan},basename)
        set reply ${incith::pisg::update_message}
        set reply "[string map "{%url%} {${incith::pisg::url}}" $reply]"
        set reply "[string map "{%file%} {$file}" $reply]"
        if {${incith::pisg::ftp} >= 1} {
          incith::pisg::sendftp $incith::pisg::static(${chan}) $incith::pisg::ftp_server $incith::pisg::ftp_username $incith::pisg::ftp_password "${incith::pisg::ftp_remote_folder}${file}"
        }
        if {[info exists input(dcc)]} {
          putdcc $input(idx) "${incith::pisg::version}: $reply"
        } else {
          send_output $input(chan) $reply
        }
      } else {
        if {[info exists input(dcc)]} {
          putdcc $input(idx) "${incith::pisg::version}: Stats Update failed: $gen_errs"
        } else {
          send_output $input(chan) "Stats Update failed: $gen_errs" $input(who)
        }
      }
      return 1
    } else {
      foreach channel [channels] {
        set channel [string tolower $channel]
        if {[channel get $channel pisg] != 1 || ![info exists incith::pisg::static(${channel})]} {
          continue
        } else {
          if {[info exists ::env(WINDIR)] && [info exists incith::pisg::perl]} {
            catch {set - [exec $incith::pisg::perl $incith::pisg::pisg -co $incith::pisg::pisg_config -cc $channel]} gen_errs
          } else {
            catch {set - [exec $incith::pisg::pisg -co $incith::pisg::pisg_config -cc $channel]} gen_errs
          }
          if {[string match {} $gen_errs]} {
            set file $incith::pisg::static(${channel},basename)
            set reply ${incith::pisg::update_message}
            set reply "[string map "{%url%} {${incith::pisg::url}}" $reply]"
            set reply "[string map "{%file%} {$file}" $reply]"
            if {${incith::pisg::ftp} >= 1} {
              incith::pisg::sendftp $incith::pisg::static(${channel}) $incith::pisg::ftp_server $incith::pisg::ftp_username $incith::pisg::ftp_password "${incith::pisg::ftp_remote_folder}${file}"
            }
            if {![info exists input(dcc)]} {
              send_output $channel $reply
              # send_output $input(chan) $reply
            }
          } else {
            if {[info exists input(dcc)]} {
              putdcc $input(idx) "${incith::pisg::version}: Stats Update failed: $gen_errs"
            } else {
              send_output $channel "Stats Update failed: $gen_errs" $input(who)
              # send_output $input(chan) "Stats Update failed: $gen_errs" $input(who)
            }
          }
        }
      }
      if {[info exists input(dcc)]} {
        putdcc $input(idx) "${incith::pisg::version}: All configured channel statistics have been updated."
      }
      # move stats updated for * messaged here?
    }
    return 0
  }

  # [send_output] : sends $data appropriately out to $where
  #
  proc send_output {where data {isErrorNick {}}} {
    if {${incith::pisg::notices} >= 1} {
      foreach line [incith::pisg::line_wrap $data] {
        putquick "NOTICE $where :${line}"
      }
    } elseif {${incith::pisg::notice_errors_only} >= 1 && $isErrorNick != ""} {
      foreach line [incith::pisg::line_wrap $data] {
        putquick "NOTICE $isErrorNick :${line}"
      }
    } else {
      foreach line [incith::pisg::line_wrap $data] {
        putquick "PRIVMSG $where :${line}"
      }
    }
  }

  # [line_wrap] : takes a long line in, and chops it before the specified length
  # http://forum.egghelp.org/viewtopic.php?t=6690
  #
  proc line_wrap {str {splitChr { }}} {
    set out [set cur {}]
    set i 0
    set len 400
    foreach word [split [set str][set str ""] $splitChr] {
      if {[incr i [string len $word]] > $len} {
        lappend out [join $cur $splitChr]
        set cur [list $word]
        set i [string len $word]
      } else {
        lappend cur $word
      }
      incr i
    }
    lappend out [join $cur $splitChr]
  }

  # [sendftp] : modified to support *nix and windows
  # originals by Ernst: http://www.egghelp.org/tclhtml/3478-4-0-0-1-sendftp.htm
  # Windrop 1.6.18+ having exec problems? http://forum.egghelp.org/viewtopic.php?t=12191
  #
  proc sendftp {localfile server user pass remotefile} {
    if {![file exist $localfile]} {
      ipl "sendftp: File $localfile does not exist."
      return 2
    }
    # windows       
    if {[info exists ::env(WINDIR)]} {
      if {[file executable $::env(WINDIR)/system32/ftp.exe]} {
        set ftpprog $::env(WINDIR)/system32/ftp.exe ; set noftp 0
      } elseif {[file executable $::env(WINDIR)/ftp.exe]} {
        set ftpprog $::env(WINDIR)/ftp.exe ; set noftp 0
      } elseif {[file executable "ftp.exe"]} {
        set ftpprog "ftp.exe" ; set noftp 0
      } else {
        set errmsg "Could not find the 'ftp.exe' program."
      }
    } else {
      if {[file executable /usr/bin/ftp]} {
        set ftpprog /usr/bin/ftp ; set noftp 0
      } elseif {[file executable /bin/ftp]} {
        set ftpprog /bin/ftp ; set noftp 0
      } else {
        set errmsg "Could not find the 'ftp' program."
      }
    }

    if {[info exists errmsg]} {
      ipl $errmsg
      return 2
    }

    set pipe [open "|$ftpprog -n $server" w]
    puts $pipe "user $user $pass"
    puts $pipe "bin"
    puts $pipe "put $localfile $remotefile"
    puts $pipe "quit"
    close $pipe
    return 1
  }
}

incith::pisg::ipl "loaded."