This is the new home of the egghelp.org community forum.
All data has been migrated (including user logins/passwords) to a new phpBB version.


For more information, see this announcement post. Click the X in the top right-corner of this box to dismiss this message.

Latest Urban Dictionary tcl

Support & discussion of released scripts, and announcements of new releases.
d
doubleu
Voice
Posts: 11
Joined: Sun Feb 10, 2008 11:19 pm

Post by doubleu »

Sigh, is urbandictionary.com jerking things around? It's not working again today. I obviously reference http://perplexa.ugug.org/web/projects/ first, but it's still v1.10 there and was working yesterday. Very weird.....
User avatar
spithash
Master
Posts: 248
Joined: Thu Jul 12, 2007 9:21 am
Location: Libera
Contact:

Post by spithash »

anything new with urban? or any other similar script ? thanks.
Libera ##rtlsdr & ##re - Nick: spithash
Click here for troll.tcl
User avatar
Trixar_za
Op
Posts: 143
Joined: Wed Nov 18, 2009 1:44 pm
Location: South Africa
Contact:

Post by Trixar_za »

I just wrote my own to be honest. Too much hassle using older scripts really.
You can grab it here if you want it.
h
horgh
Voice
Posts: 10
Joined: Sat Feb 13, 2010 3:12 pm

Post by horgh »

s
shadrach
Halfop
Posts: 74
Joined: Fri Dec 14, 2007 6:29 pm

Post by shadrach »

This is perplexa's last update of urbandictionary before his site closed. Still works for me.

Code: Select all

# Urban Dictionary
# Copyright (C) 2006-2008 perpleXa
# http://perplexa.ugug.org / #perpleXa on QuakeNet
#
# Redistribution, with or without modification, are permitted provided
# that redistributions retain the above copyright notice, this condition
# and the following disclaimer.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
#
# Usage:
#  -ud [id] <term>

# fsck is available at http://perplexa.ugug.co.uk
package require fsck 1.10;
package require http;

namespace eval urbandict {
  variable version 1.13;

  # flood protection (seconds)
  variable antiflood 10;
  
  # maximum number of lines to output
  variable max_lines 3;

  variable encoding "utf-8";
  variable client "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8.1.14) Gecko/20080420 Firefox/2.0.0.14";
  bind pub -|- "-ud" [namespace current]::pub;
  namespace export pub;
}

proc urbandict::getdefinition {definition} {
  variable client;
  http::config -useragent $client;
  set url "http://www.urbandictionary.com/define.php?term=[urlencode $definition]";
  if {[catch {http::geturl $url -timeout 20000} token]} {
    return [list 0 "Warning: Couldn't connect to \[$url\]"];
  }
  upvar 0 $token state;
  if {![string equal -nocase $state(status) "ok"]} {
    return [list 0 "Warning: Couldn't connect to \[$url\] (connection $state(status))."];
  }
  set data [http::data $token];
  http::cleanup $token;
  # Those [censored] keep switching between those options:
  #set matches [regexp -all -inline {<div class="def_p">(.*?)</div>} $data];
  #set matches [regexp -all -inline {<td class='text' colspan='2'>(.*?)</td} $data];
  # yet another change...
  set matches [regexp -all -inline {<td class='text' colspan='2' id='.*?'>(.*?)</td} $data];
  set list [list];
  foreach {null match} $matches {
    set definition "n/a"
    #regexp -nocase -- {<p>(.*?)</p>} $match -> definition
    regexp -nocase -- {<div class='definition'>(.*?)</div>} $match -> definition
    regsub -all {[\r\n\s\t]+} $definition " " definition
    regsub -all {<[^>]*?>} [string trim [decode $definition]] "" definition;
    set example ""
    #regexp -nocase -- {<p style="font-style: italic">(.*?)</p>} $match -> example
    regexp -nocase -- {<div class='example'>(.*?)</div>} $match -> example
    regsub -all {[\r\n\s\t]+} [string trim $example] " " example
    regsub -all {<[^>]*?>} [string trim [decode $example]] "" example;
    lappend list "$definition[expr {$example == "" ? "" : " ($example)"}]";
  }
  return [concat [llength $list] $list];
}

proc urbandict::urlencode {i} {
  variable encoding
  set index 0;
  set i [encoding convertto $encoding $i]
  set length [string length $i]
  set n ""
  while {$index < $length} {
    set activechar [string index $i $index]
    incr index 1
    if {![regexp {^[a-zA-Z0-9]$} $activechar]} {
      append n %[format "%02X" [scan $activechar %c]]
    } else {
      append n $activechar
    }
  }
  return $n
}

proc urbandict::pub {nick host hand chan argv} {
  variable flood; variable antiflood; variable max_lines;
  if {![info exists flood($chan)]} { set flood($chan) 0; }
  if {![string compare $argv ""]} {
    puthelp "NOTICE $nick :Usage: !ud \[id\] <definition>";
    return 1;
  }
  if {[string is digit -strict [getword $argv 0]]} {
    if {[splitline $argv cargv 2]!=2} {
      puthelp "NOTICE $nick :Usage: !ud \[id\] <definition>";
      return 1;
    }
    set id [lindex $cargv 0];
    set argv [lindex $cargv 1];
    if {!$id} {
      set id 1;
    }
  } else {
    set id 1;
  }

  if {[unixtime] - $flood($chan) <= $antiflood} { return 0; }
  set flood($chan) [unixtime];

  set definitions [getdefinition $argv];
  set count [lindex $definitions 0];
  if {!$count} {
    puthelp "PRIVMSG $chan :Nothing found for \"$argv\".";
    return 1;
  } elseif {$id > $count} {
    puthelp "PRIVMSG $chan :Only $count results found for \"$argv\".";
    return 1;
  }
  set definition [lindex $definitions $id];
  if {[string length $definition] <= 400} {
    puthelp "PRIVMSG $chan :\[$id/$count\] $definition";
    return 0;
  }
  set skip 0;
  set definition [splitmsg $definition];
  set required_lines [llength $definition];
  foreach line $definition {
    puthelp "PRIVMSG $chan :\[$id/$count\] $line";
    if {[incr skip] == $max_lines && $required_lines != $max_lines} {
      puthelp "PRIVMSG $chan :\[$id/$count\] Truncated output to 3 of $required_lines lines.";
      break;
    }
  }
  return 0;
}

proc urbandict::decode {content} {
  if {![string match *&* $content]} {
    return $content;
  }
  set escapes {
      \x20 " \x22 & \x26 &apos; \x27 – \x2D
    < \x3C > \x3E ˜ \x7E € \x80 ¡ \xA1
    ¢ \xA2 £ \xA3 ¤ \xA4 ¥ \xA5 ¦ \xA6
    § \xA7 ¨ \xA8 © \xA9 ª \xAA « \xAB
    ¬ \xAC ­ \xAD ® \xAE &hibar; \xAF ° \xB0
    ± \xB1 ² \xB2 ³ \xB3 ´ \xB4 µ \xB5
    ¶ \xB6 · \xB7 ¸ \xB8 ¹ \xB9 º \xBA
    » \xBB ¼ \xBC ½ \xBD ¾ \xBE ¿ \xBF
    À \xC0 Á \xC1 Â \xC2 Ã \xC3 Ä \xC4
    Å \xC5 Æ \xC6 Ç \xC7 È \xC8 É \xC9
    Ê \xCA Ë \xCB Ì \xCC Í \xCD Î \xCE
    Ï \xCF Ð \xD0 Ñ \xD1 Ò \xD2 Ó \xD3
    Ô \xD4 Õ \xD5 Ö \xD6 × \xD7 Ø \xD8
    Ù \xD9 Ú \xDA Û \xDB Ü \xDC Ý \xDD
    Þ \xDE ß \xDF à \xE0 á \xE1 â \xE2
    ã \xE3 ä \xE4 å \xE5 æ \xE6 ç \xE7
    è \xE8 é \xE9 ê \xEA ë \xEB ì \xEC
    í \xED î \xEE ï \xEF ð \xF0 ñ \xF1
    ò \xF2 ó \xF3 ô \xF4 õ \xF5 ö \xF6
    ÷ \xF7 ø \xF8 ù \xF9 ú \xFA û \xFB
    ü \xFC ý \xFD þ \xFE ÿ \xFF
  };
  set content [string map $escapes $content];
  set content [string map [list "\]" "\\\]" "\[" "\\\[" "\$" "\\\$" "\\" "\\\\"] $content];
  regsub -all -- {&#([[:digit:]]{1,5});} $content {[format %c [string trimleft "\1" "0"]]} content;
  regsub -all -- {&#x([[:xdigit:]]{1,4});} $content {[format %c [scan "\1" %x]]} content;
  regsub -all -- {&#?[[:alnum:]]{2,7};} $content "?" content;
  return [subst $content];
}

putlog "Script loaded: Urban Dictionary v$urbandict::version by perpleXa";
User avatar
spithash
Master
Posts: 248
Joined: Thu Jul 12, 2007 9:21 am
Location: Libera
Contact:

fsck.tcl

Post by spithash »

I know most of you guys can't find fsck.tcl that's needed to make perplexa's urban TCL working, so here's what you need :)

It was hard to find it again, but huh, here it is :D

Code: Select all

# fsck function library v1.19
# Copyright (C) 2004-2007 perpleXa
# http://perplexa.ugug.org / #perpleXa on QuakeNet
#
# Redistribution, with or without modification, are permitted provided
# that redistributions retain the above copyright notice, this condition
# and the following disclaimer.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
#
# To update this package you need to _RESTART_ your bot.
# A rehash will most likely cause a crash...
#
# You do _not_ need to load any other scripts. This package will do all that
# work for you, just copy it to your scripts directory.
# You can optionally set the script-path variable to let fsck load scripts
# only from directories you specified:
#   set script-path {
#    "scripts"
#    "scripts/news"
#    "scripts/quakenet"
#   };
#
# This file carries 35 functions, which are listed in alphabetical order below:
# * assert <expression>
# * bytify <integer>
# * cat <file>
# * compiled
# * crypthost <user>
# * delchars  <string> <chars>
# * do <body> while <condition>
# * duration <integer>
# * durationtolong <string>
# * Error <source> <severity> <reason>
# * getword <string> <start?-end?>
# * hand2nick:all <hand>
# * initseed
# * iptolong <ip>
# * lines <file>
# * longtoduration <integer>
# * longtoip <integer>
# * merge <arguments ...>
# * minmaxrand <min> <max>
# * mmax <integer> <integer>
# * mmin <integer> <integer>
# * pretty_mask <string>
# * putamsg <text>
# * randstr [minlength] [maxlength] [chars]
# * rputquick <string>
# * sendmail <sender> <recipient> <subject> <message>
# * shuffle <list>
# * sortfile <file>
# * splitline <string> <variable> <maxparams>
# * splitmsg <string>
# * strcom <variable>
# * strreverse <string>
# * strtoul <string>
# * tree <directory>
# * urandom <limit>
# * validip <ip>
#
# Additional features:
# * Prints G-line reasons to the logfile.
#
# * Removes flood triggers for friendly users with one of the +fmno flags.
set NOFLOOD_FOR_FRIENDS true;
#
# * Loads all other scripts from fsck's parent directory or script-path, using
#   enhanced error catching to prevent the bot from crashing when it's loading
#   an erroneous script during startup.
set LOAD_ALL_SCRIPTS false;

###############################################################################
# DO NOT EDIT CODE BELOW THIS LINE UNLESS YOU REALLY KNOW WHAT YOU ARE DOING! #
###############################################################################

# Log debug messages
set LOG_DEBUG false;

# Package stuff
package require Tcl 8.4;
package provide fsck 1.19;

# splitmsg:
#  Splits a message into 400byte chunks.
#  Some messages exceed the 512 byte buffer of most ircds,
#  so here's the solution, this function splits each message
#  into a list with 400byte chunks (400+channelname+userhost etc).
#  The message will not be split in words, only between them.
proc splitmsg {string} {
  set buf1 ""; set buf2 [list];
  foreach word [split $string] {
    append buf1 " " $word;
    if {[string length $buf1]-1 >= 400} {
      lappend buf2 [string range $buf1 1 end];
      set buf1 "";
    }
  }
  if {$buf1 != ""} {
    lappend buf2 [string range $buf1 1 end];
  }
  return $buf2;
}

# compiled: Gets the eggdrop's file modifytime.
proc compiled {args} {
  return [strftime "%d/%m/%y %H:%M" [file mtime [info nameofexecutable]]];
}

# putamsg: Port of mirc's amsg function.
proc putamsg {text} {
  set channels [list];
  foreach channel [channels] {
    if {[botonchan $channel]} {
      lappend channels $channel;
    }
  }
  set channels [join $channels ","];
  puthelp "PRIVMSG $channels :$text";
}

# hand2nick:all: Returns a list of all users with that hand.
proc hand2nick:all {hand} {
  set users [list];
  foreach chan [channels] {
    foreach user [chanlist $chan] {
      if {[string equal -nocase [nick2hand $user] $hand] && ![isbotnick $user]} {
        lappend users $user;
      }
    }
  }
  return [lsort -unique $users];
}

# pretty_mask:
#  Canonify a mask.
#  The following transformations are made:
#   1)   xxx           -> nick!*@*
#   2)   xxx.xxx       -> *!*@host
#   3)   xxx!yyy       -> nick!user@*
#   4)   xxx@yyy       -> *!user@host
#   5)   xxx!yyy@zzz   -> nick!user@host
proc pretty_mask {mask} {
  set star "*";
  set retmask "";
  set last_dot 0;
  set nick $mask;
  set user $star;
  set host $star;
  set char $star;
  for {set x 0} {$char != ""} {incr x} {
    set char [string index $mask $x]
    if {$char == "!"} {
      set user [string range $mask [expr $x+1] end];
      set host $star;
    } elseif {$char == "@"} {
      set nick $star;
      set user [string range $mask 0 [expr $x-1]];
      set host [string range $mask [expr $x+1] end];
    } elseif {$char == "."} {
      set last_dot $x;
    } else {
      continue;
    }
    for {} {$char != ""} {incr x; set char [string index $mask $x]} {
      if {$char == "@"} {
        set host [string range $mask [expr $x+1] end];
      }
    }
    break;
  }
  if {$user == $star && $last_dot} {
    set nick $star;
    set user $star;
    set host $mask;
  }
  if {$nick != $star} {
    set char [string first "!" $nick];
    set nick [string range $nick 0 [expr {($char > -1) ? $char-1 : "end"}]];
    if {$nick == ""} {
      set nick $star;
    }
  }
  if {$user != $star} {
    set char [string first "@" $user];
    set user [string range $user 0 [expr {($char > -1) ? $char-1 : "end"}]];
    if {$user == ""} {
      set user $star;
    }
  }
  if {$host == ""} {
    set host $star;
  }
  format "%s!%s@%s" $nick $user $host;
}

# duration:
#  Converts a specified number of seconds into a duration string.
#  Changes to the original duration function:
#  * supports milliseconds
#  * removed year value
#  * sizes between values are always displayed
#    i.e. days>0, minutes>0, but hours=0
#    will return 1 day 0 hours 3 minutes
proc duration {interval} {
  set mseconds [expr ($interval)-int($interval)];
  set seconds [expr int($interval)%60];
  set minutes [expr (int($interval)%3600)/60];
  set hours [expr (int($interval)%(3600*24))/3600];
  set days [expr (int($interval)%(3600*24*7))/(3600*24)];
  set weeks [expr int($interval)/(3600*24*7)];
  set outstring "";
  if {$weeks>0} {
    append outstring [format "%d week%s " $weeks [expr $weeks==1?"":"s"]];
  }
  if {$days>0 || ($weeks>0 && ($hours>0 || $minutes>0 || $seconds>0 || $mseconds>0))} {
    append outstring [format "%d day%s " $days [expr $days==1?"":"s"]];
  }
  if {$hours>0 || (($weeks>0 || $days>0) && ($minutes>0 || $seconds>0 || $mseconds>0))} {
    append outstring [format "%d hour%s " $hours [expr $hours==1?"":"s"]];
  }
  if {$minutes>0 || (($weeks>0 || $days>0 || $hours>0) && ($seconds>0 || $mseconds>0))} {
    append outstring [format "%d minute%s " $minutes [expr $minutes==1?"":"s"]];
  }
  if {$mseconds>0} {
    append outstring [format "%.3f seconds " [expr $seconds+$mseconds]];
  } elseif {$seconds>0} {
    append outstring [format "%d second%s " $seconds [expr $seconds==1?"":"s"]];
  }
  return [string range $outstring 0 end-1];
}

# longtoduration:
#  Converts a specified number of seconds into a duration string.
#  format: 0 for the "/stats u" compatible output, 1 for more human-friendly output.
proc longtoduration {interval {format 1}} {
  set days [expr $interval/(3600*24)]
  if {($interval>86400 && ($interval % 86400)) || !$format} {
    set seconds [expr $interval%60]
    set minutes [expr ($interval%3600)/60]
    set hours [expr ($interval%(3600*24))/3600]
    return [format "%d day%s, %02d:%02d:%02d" $days [expr {($days==1)?"":"s"}] $hours $minutes $seconds]
  }
  return [format "%d day%s" $days [expr {($days==1)?"":"s"}]]
}

# durationtolong:
#  Converts the specified string into a number of seconds.
#  Valid switches are:
#   s (seconds)  m (minutes)  h (hours)    d (days)
#   w (weeks)    M (months)   y (years)
#  i.e. 2w3d will return a value of 2 weeks and 3 days.
proc durationtolong {string} {
  set total 0
  set current ""
  for {set x 0} {$x < [string length $string]} {incr x} {
    set ch [string index $string $x]
    if {[string is digit -strict $ch]} {
      append current $ch
    }
    if {$current != ""} {
      switch -exact $ch {
        "s" {set total [expr $total + $current]}
        "m" {set total [expr $total + ($current * 60)]}
        "h" {set total [expr $total + ($current * 3600)]}
        "d" {set total [expr $total + ($current * 86400)]}
        "w" {set total [expr $total + ($current * 604800)]}
        "M" {set total [expr $total + ($current * 2592000)]}
        "y" {set total [expr $total + ($current * 31557600)]}
      }
      if {[string match \[smhdwMy\] $ch]} {
        set current ""
      }
    }
  }
  if {$current != ""} {
    set total [expr $total + $current]
  }
  format "%lu" $total
}

# bytify: Converts the specifiednumber of bytes into a more human-friendly string.
proc bytify {bytes} {
  for {set pos 0; set bytes [expr double($bytes)]} {$bytes >= 1024} {set bytes [expr $bytes/1024]} {
    incr pos;
  }
  set a [lindex {"B" "KB" "MB" "GB" "TB" "PB"} $pos];
  format "%.3f%s" $bytes $a;
}

# randstr: Returns a random string of "chars" between min and max.
proc randstr {{min "7"} {max "13"} {chars "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789\\|[{]}`^-_"}} {
  set length [minmaxrand $min $max];
  set count [string length $chars];
  set result [string index $chars [rand $count]];
  for {set index 1} {$index < $length} {incr index} {
    append result [string index $chars [rand $count]];
  }
  return $result;
}

# getword: Gets a word of a string, works independend of multiple spaces.
proc getword {inputstring index} {
  if {![regexp {^([[:digit:]]+)-([[:digit:]]+|end)} $index -> index end]} {
    set end 0;
  }
  set inputstring [string trim $inputstring]; set buf "";
  set params 0; set instr 1; incr index;
  if {$end != "end"} { incr end; }
  for {set i 0} {$i < [string length $inputstring]} {incr i} {
    set c [string index $inputstring $i];
    if {!($c==" " || $c=="\n" || $c=="\r" || $c=="\t")} {
      if {$instr} {
        incr params; set instr 0;
      }
    } else {
      set instr 1;
    }
    if {($params == $index) || (($params >= $index)
        && (($end == "end") || ($params <= $end)))} {
      append buf $c;
    }
  }
  return [string trim $buf];
}

# splitline:
#   This function splits lines on each space, up to a maximum of maxparams.
#   Spaces at the beginning/between words are removed/ignored.
#   Multiple spaces in the last parameter will not be removed.
proc splitline {inputstring outputvector maxparams} {
  upvar $outputvector cargv;
  set cargv [list];

  set inputstring [split $inputstring];
  set paramcount 0

  while {($paramcount<$maxparams || !$maxparams) && $inputstring!=""} {
    if {[lindex $inputstring 0]!=""} {
      if {[incr paramcount]==$maxparams} {
        lappend cargv [join $inputstring];
        break;
      }
      lappend cargv [lindex $inputstring 0];
    }
    set inputstring [lreplace $inputstring 0 0];
  }
  return $paramcount;
}

# rputquick: Sends text to the server _without_ any delay.
proc rputquick {text {options ""}} {
  # Thread options as this would be the real putquick function.
  # Due to sanity checks or something.. :)
  if {($options != "")} {
    if {![string equal -nocase "-normal" $options]
        && ![string equal -nocase "-next" $options]} {
      # Return an error if the specified option is neither -normal nor -next
      return -code error "unknown rputquick option: should be one of: -normal -next";
    }
  }
  if {![string equal [string index $text end] "\n"]} {
    # Add a newline to the end of the string, if not already.
    append text "\n";
  }
  # Must use catch here, because putdccraw returns a TCL_ERROR
  # if we aren't connected to the server and send something.
  catch {putdccraw 0 [string length $text] $text;}
  return;
}

# http://www.sendmail.org ;)
proc sendmail {sender recipient subject message} {
  set sendmail "/usr/sbin/sendmail";
  if {[catch {open "|$sendmail $recipient" "w"} fd]} {
    return 0;
  }
  puts $fd "To: $recipient";
  puts $fd "From: $sender";
  puts $fd "Subject: $subject\n";
  puts $fd "$message";
  close $fd;
  return 1;
}

# crypthost: An encrypted version of getchanhost
# I actually don't know why i made this...
proc crypthost {nick} {
  set host [getchanhost $nick];
  if {$host == ""} {return;}
  set salt $host;
  set ident [lindex [split $host "@"] 0];
  set host [lindex [split $host "@"] 1];
  set crypt [string range [encrypt $salt $host] 0 12];
  if {[string index $crypt 0] == "."} {
    set crypt "a[string range $crypt 1 12]";
  }
  if {[string index $crypt 12] == "."} {
    set crypt "[string range $crypt 0 11]a";
  }
  set host [split $host "."];
  if {([llength $host] == 4) && [string is digit -strict [lindex $host 3]]} {
    set host [join [lrange $host 0 2] "."];
    format "%s@%s.%s" $ident $host $crypt;
  } else {
    set host [join [lrange $host 1 end] "."];
    format "%s@qnet-%s.%s" $ident $crypt $host;
  }
}

# lines: Counts the lines of a file.
proc lines {file} {
  if {[catch {open $file "r"} fp]} {
    # We can not open the specified file, return -1
    return -1;
  }
  # Split the whole content on each newline char,
  set lines [llength [split [read $fp] "\n"]];
  # don't forget to close the file
  close $fp;
  # and return the list size.
  return $lines;
}

# sortfile:
#  Sorts a file in alphabetical order.
#  USE WITH CARE -- you don't have to worry about the original file
#  being untrusted, but you must get it sorted right :)
proc sortfile {file} {
  if {[catch {open $file "r"} fp]} {
    return -1;
  }
  set fcont [join [lsort -dictionary [split [read $fp] "\n"]] "\n"];
  close $fp;
  if {[catch {open $file "w"} fp]} {
    return -1;
  }
  puts $fp $fcont;
  close $fp;
  return 1;
}

# seed the pseudo-random number generator, rand()
proc initseed {args} {
  expr srand([clock clicks -milliseconds]%65536);
}; initseed

# returns a random number from /dev/urandom
proc urandom {limit} {
  if {[catch {open "/dev/urandom" "r"} fp]} {
    error "Could not open /dev/urandom";
  } elseif {![binary scan [read $fp 4] "i" rand]} {
    close $fp;
    error "Got weird input from /dev/urandom";
  } else {
    close $fp;
    return [expr ($rand & 0x7FFFFFFF) % $limit];
  }
}

# shuffle: Randomizes a list.
proc shuffle {list} {
  for {set i 0} {$i<[llength $list]} {incr i} {
    set j [rand [expr $i+1]];
    if {$i == $j} {continue;}
    set x [lindex $list $i];
    set list [lreplace $list $i $i [lindex $list $j]];
    set list [lreplace $list $j $j $x];
  }
  return $list;
}

# mmin: Returns the shorter value.
proc mmin {a b} {
  expr {$a > $b ? $b : $a}
}

# mmax: Returns the longer value.
proc mmax {a b} {
  expr {$a < $b ? $b : $a}
}

# minmaxrand: Returns a random number between min and max.
proc minmaxrand {min max} {
  expr ([rand [expr ($max - $min)]] + $min);
}

# strcom:
#  Strips C style comments from vars.
#  Comments in quotes " " will be ignored.
proc strcom {varName} {
  upvar $varName string;
  set sstring "";
  set instr 0;
  set incom 0;
  for {set i 0} {$i<[string length $string]} {incr i} {
    # Get the current char
    set c [string index $string $i];
    if {$c == "\""} {
      # Got a quote, check if it's escaped.
      set isesc 0;
      for {set x [expr $i-1]} {[string index $string $x] == "\\"} {incr x -1} {
        set isesc [expr !$isesc];
      }
      if {!$isesc && !$incom} {
        # It's not escaped.
        set instr [expr !$instr];
      }
    } elseif {$c == "/"} {
      # Got a slash, check if we reached begin/end of a comment.
      if {!$instr} {
        if {$incom} {
          # Currently not in string, check if trailing char was *.
          if {[string index $string [expr $i-1]] == "*"} {
            # End of comment.
            set incom 0;
            continue;
          }
        } else {
          # Check if following char is *.
          if {[string index $string [expr $i+1]] == "*"} {
            # Now we are in a comment.
            set incom 1;
            continue;
          }
        }
      }
    }
    if {!$incom} {
      # Not in comment, add char.
      append sstring $c;
    }
  }
  set string $sstring;
}

# delchars: Deletes characters occuring in badchars from string.
proc delchars {string badchars} {
  set newstring "";
  for {set i 0} {$i < [string length $string]} {incr i} {
    set isbad 0;
    foreach char [split $badchars ""] {
      if {[string index $string $i] == $char} {
        set isbad 1;
        break;
      }
    }
    if {!$isbad} {
      append newstring [string index $string $i];
    }
  }
  return $newstring;
}

# strreverse: Returns the inputstring in reversed order.
proc strreverse {string} {
  for {set i 0; set j [expr [string length $string]-1];} {$i < $j} {incr i 1; incr j -1} {
    set c [string index $string $i];
    set string [string replace $string $i $i [string index $string $j]];
    set string [string replace $string $j $j $c];
  }
  return $string;
}

# validip: Checks an IP for sanity.
proc validip {ip} {
  set tmp 0;
  if {!([llength [set ip [split $ip "."]]] == 4)} {
    return 0;
  }
  foreach num $ip {
    if {[string length $num] > 3 || $num < 0 || $num >= 256} {
      return 0;
    }
    incr tmp $num;
  }
  expr $tmp>=1;
}

# sevtostring: Returns a string of an error code. (internal function)
proc sevtostring {severity} {
  switch -exact $severity {
    DEBUG {
      return "debug";
    }
    INFO {
      return "info";
    }
    WARNING {
      return "warning";
    }
    ERROR {
      return "error";
    }
    FATAL {
      return "fatal error";
    }
    default {
      return "unknown error";
    }
  }
}

# Error: Provides enhanced error logging. :)
proc Error {source severity reason} {
  global LOG_DEBUG;
  if {$severity == "DEBUG" && !$LOG_DEBUG} return;
  putlog [format "%s(%s): %s" [sevtostring $severity] $source $reason];
}

# tree:
#  Calls itself recursively and returns the content of a directory in a tree structure.
#  Leave the 'prefix' parameter blank, it's for internal use only.
#  Note about the general implementation: The tcl interpreter sets a
#  tcl stack limit of 1000 levels to prevent infinite recursions from
#  running out of bounds. As this command is implemented recursively it
#  will fail for very deeply nested directory structures.
proc tree {location {prefix ""}} {
  if {$prefix != ""} {
    if {[string index $prefix end-1] == " "} {
      set result [list [string range $prefix 0 end-2]`-[lindex [split $location "/"] end]];
    } else {
      set result [list [string range $prefix 0 end-1]-[lindex [split $location "/"] end]];
    }
  } else {
    set result [list [lindex [split $location "/"] end]];
  }
  set files [lsort -dictionary [glob -nocomplain "[string trimright $location "/"]/*"]];
  set flcnt [llength $files];
  for {set i 0} {$i<$flcnt} {incr i} {
    set file [lindex $files $i]
    if {$i+1 == $flcnt} {
      set pre "$prefix`-";
      set fpre "$prefix  "
    } else {
      set pre "$prefix|-";
      set fpre "$prefix| ";
    }
    if {[file isdirectory $file]} {
      foreach file [tree $file $fpre] {
        lappend result $file;
      }
    } else {
      lappend result $pre[lindex [split $file "/"] end];
    }
  }
  return $result;
}

# do: TCL implementation of do while loops.
proc do {body while condition} {
  if {$while != "while"} {
    return -code error "Invalid function call.";
  }
  set ccondition [list expr $condition];
  while {1} {
    uplevel 1 $body;
    if {![uplevel 1 $ccondition]} {
      break;
    }
  }
}

# assert: TCL implementation of the C assert function
proc assert {expr} {
  set code [catch {uplevel 1 [list expr $expr]} res];
  if {$code} {
    return -code $code $res;
  }
  if {![string is boolean -strict $res]} {
    return -code error "invalid boolean expression: $expr";
  }
  if {$res} {return;}
  return -code error "assertion failed: $expr";
}

# cat:
#  TCL implementation of the UNIX "cat" command.
#  Returns the contents of the specified file.
proc cat {file} {
  # Don't bother catching errors, just let them propagate up.
  set fp [open $file "r"];
  # Use the [file size] command to get the size, which preallocates memory,
  # rather than trying to grow it as the read progresses.
  set size [file size $file];
  if {$size} {
    set data [read $fp $size];
  } else {
    # If the file has zero bytes it is either empty, or something
    # where [file size] reports 0 but the file actually has data (like
    # the files in the /proc filesystem)
    set data [read $fp];
  }
  close $fp;
  return $data;
}

# strtoul: Converts a string to an unsigned digit.
proc strtoul {string} {
  if {[catch {expr int($string)} val]} {
    return 0;
  }
  format "%lu" $val;
}

# merge: Connects arguments.
proc merge {args} {
  return [join $args ""];
}

# iptolong: Converts an ip to it's long value.
proc iptolong {ip} {
  if {[scan $ip {%[1234567890]%c%[1234567890]%c%[1234567890]%c%[1234567890]} a & b & c & d] != 7} {
    return 0;
  }
  # format "%lu" [expr ((((($a<<8)^$b)<<8)^$c)<<8)^$d];
  # fix for 64-bit systems
  format "%u" [format "0x%.2X%.2X%.2X%.2X" $a $b $c $d];
}

# longip: Converts the long value of an ip to it's dotted quad ip.
proc longtoip {long} {
  format "%u.%u.%u.%u" [expr $long>>24] [expr ($long>>16)&255] [expr ($long>>8)&255] [expr $long&255];
}

# Sends the G-line reason to the log file if the bot was banned from a server.
bind raw -|- "465" *raw:fsck:465;
proc *raw:fsck:465 {srv raw str} {
  set reason [string range $str [expr [string first ":" $str]+1] end];
  Error "server" ERROR "G-lined ($srv): $reason"
  return 0;
}

# Removes flood triggers for users with one of the +fmno flags.
bind flud -|- * flood;
proc flood {nick host hand type chan} {
  global NOFLOOD_FOR_FRIENDS;
  if {$NOFLOOD_FOR_FRIENDS && (([validchan $chan] && [matchattr $hand "fmno|fmno" $chan]) || [matchattr $hand "fmno"])} {
    return 1;
  }
  return 0;
}

# Load all *.tcl files in either this directory or "script-path".
if {$LOAD_ALL_SCRIPTS} {
  putlog "--------------------------------------";
  putlog "-------- Initialising scripts --------";
  if {![info exists script-path]} {
    set script-path [list [file dirname [info script]]];
  }
  foreach fsck(dir) ${script-path} {
    putlog "Current search path:";
    putlog $fsck(dir);
    set fsck(scripts) [lsort -dictionary [glob -nocomplain -- "[string trimright $fsck(dir) "/"]/*"]];
    set fsck(error) "";
    set fsck(x) 0; set fsck(y) 0;
    foreach fsck(script) $fsck(scripts) {
      if {![file isdirectory $fsck(script)] && [string match -nocase *?.tcl $fsck(script)]} {
        incr fsck(y);
        if {![string compare [info script] $fsck(script)]} {
          incr fsck(x);
          continue;
        }
        if {[catch {source $fsck(script)} fsck(error)]} {
          Error "fsck" FATAL "Couldn't load $fsck(script) \[$fsck(error)\]";
          continue;
        }
        incr fsck(x);
      }
    }
    putlog "$fsck(x) of $fsck(y) script[expr {($fsck(y) == 1) ? "" : "s"}] initialised.";
  }
  catch {unset fsck}
}
Enjoy, the script is awesome :)
Libera ##rtlsdr & ##re - Nick: spithash
Click here for troll.tcl
User avatar
spithash
Master
Posts: 248
Joined: Thu Jul 12, 2007 9:21 am
Location: Libera
Contact:

Post by spithash »

The script isn't working anymore.
[20:37:50] <@spithash> !urban pedophile
[20:37:53] <@nagger> [1/7] n/a
[20:38:02] <@spithash> !urban 2 pedophile
[20:38:04] <@nagger> [2/7] n/a
Libera ##rtlsdr & ##re - Nick: spithash
Click here for troll.tcl
User avatar
spithash
Master
Posts: 248
Joined: Thu Jul 12, 2007 9:21 am
Location: Libera
Contact:

SOLVED

Post by spithash »

Ok I found what the problem was.

change this:

Code: Select all

regexp -nocase -- {<div class='definition'>(.*?)</div>} $match -> definition
to this:

Code: Select all

regexp -nocase -- {<div class="definition">(.*?)</div>} $match -> definition
and this:

Code: Select all

regexp -nocase -- {<div class='example'>(.*?)</div>} $match -> example
to this:

Code: Select all

regexp -nocase -- {<div class="example">(.*?)</div>} $match -> example
and it will work again :)

*EDIT*

Generally, urbandictioary changed their website a little bit, so, all in all, 'definition' is now "definition" and 'example' is now "example"
Libera ##rtlsdr & ##re - Nick: spithash
Click here for troll.tcl
User avatar
spithash
Master
Posts: 248
Joined: Thu Jul 12, 2007 9:21 am
Location: Libera
Contact:

Post by spithash »

anyone cares to update this script?
Libera ##rtlsdr & ##re - Nick: spithash
Click here for troll.tcl
x
x0x
Op
Posts: 140
Joined: Tue Feb 10, 2009 6:42 am

Post by x0x »

Broken again?
User avatar
spithash
Master
Posts: 248
Joined: Thu Jul 12, 2007 9:21 am
Location: Libera
Contact:

Post by spithash »

Apparently :(
Libera ##rtlsdr & ##re - Nick: spithash
Click here for troll.tcl
x
x0x
Op
Posts: 140
Joined: Tue Feb 10, 2009 6:42 am

Post by x0x »

Working copy:

Code: Select all

# Urban Dictionary Script by Trixar_za
# Based on the Twitter script by Warlord v1.0
# Type in partyline: ".chanset #channel +urban" to enable it.

# Sets the logo
set urban(logo) "\002\[UD\]:\002"

# Sets the user agent
set urban(agent) "Mozilla/4.75 (X11; U; Linux 2.2.17; i586; Nav)"

setudef flag bcmds

if {[catch {package require http 2.5} e] != 0} {
  set urban(noutf8) 1
  package require http
}

bind pub - !urban proc:urban
bind pub - .urban proc:urban
bind pub - !ud proc:urban
bind pub - .ud proc:urban

# wordwrap code by speechless
proc msg {type dest data} {
   set len [expr {500-[string len ":$::botname $type $dest :\r\n"]}]
   foreach line [wordwrap $data $len] {
      putserv "$type $dest :$line"
   }
}

proc wordwrap {data len} {
   set out {}
   foreach line [split [string trim $data] \n] {
      set curr {}
      set i 0
      foreach word [split [string trim $line]] {
         if {[incr i [string len $word]]>$len} {
            lappend out [join $curr]
            set curr [list $word]
            set i [string len $word]
         } {
            lappend curr $word
         }
         incr i
      }
      if {[llength $curr]} {
         lappend out [join $curr]
      }
   }
   set out
} 

proc proc:urban {nick uhand handle chan input} {
  if {[channel get $chan bcmds]} {
     global urban

    if {![llength [split $input]]} {
       msg "PRIVMSG" $chan "$urban(logo) Please be more specific. Ex: !urban word"
    } else {
       putquick "PRIVMSG $chan :$urban(logo) Getting definition for $input..."
  
       if {[info exists urban(noutf8)]} {
          set http [::http::config -useragent $urban(agent)]
       } else {
          set http [::http::config -useragent $urban(agent) -urlencoding "utf-8"]
       }

       foreach word [split $input] {
          lappend query [lindex [split [http::formatQuery a $word] =] 1]
       }

       catch { set http [::http::geturl "http://www.urbandictionary.com/define.php?term=[join $query %20]" -timeout 10000]} error
 
       if {![string match -nocase "::http::*" $error]} {
          msg "PRIVMSG" $chan "$urban(logo) [string totitle [string map {"\n" " | "} $error]] \( $query \)"
          return 0
       }

       if {![string equal -nocase [::http::status $http] "ok"]} {
          msg "PRIVMSG" $chan "$urban(logo) [string totitle [::http::status $http]] \( $query \)"
          return 0
       }

       set html [::http::data $http]

       # Clean up :P
       regsub -all {\n} $html { } html
       regsub -all {\t} $html { } html
       regsub -all {<br/>} $html { } html
       regsub -all { } $html { } html
       regsub -all {    } $html { } html
       regsub -all {   } $html { } html
       regsub -all {  } $html { } html
       regsub -all {<a.+?>} $html {} html
       regsub -all {</a>} $html {} html
       regsub -all {<strong.+?>} $html {} html
       regsub -all {</strong>} $html {} html
       regsub -all {<span.+?</span>} $html {} html
       regsub -all {—} $html {-} html
       regsub -all {>} $html {>} html
       regsub -all {<} $html {<} html
       regsub -all {&} $html {\&} html
       regsub -all {×} $html {*} html
       regsub -all {(?:\x91|\x92|’|‘|'|')} $html {'} html
       regsub -all {(?:\x93|\x94|“|”|")} $html {"} html
       regsub -all {×} $html {x} html
       regsub -all {(?:<!\[CDATA\[)} $html {} html

       if {[regexp -- {<div class="definition">(.+?)</div>} $html - uddef]} {
          set uddef [string trim $uddef]
          regsub -all {<div.+?>} $uddef {} uddef
          regsub -all {</div>} $uddef {} uddef
       }

       if {[regexp -- {<div class="example"></div>} $html - -]} {
          set uddex "None"
       } elseif {[regexp -- {<div class="example">(.+?)</div>} $html - uddex] && $uddex != "None"} {
          set uddex [string trim $uddex]
          regsub -all {<div.+?>} $uddex {} uddex
          regsub -all {</div>} $uddex {} uddex
       }

       if {[info exists uddef]} {
          msg "PRIVMSG" $chan "$urban(logo) \002Definition:\002 $uddef"
          if {$uddex != "None"} {
             msg "PRIVMSG" $chan "$urban(logo) \002Example:\002 $uddex"
          }
       } else {
          msg "PRIVMSG" $chan "$urban(logo) Word not found or doesn't exist."
       }
    }
  }
}

putlog "Urban Dictionary Script by Trixar_za Loaded"
User avatar
spithash
Master
Posts: 248
Joined: Thu Jul 12, 2007 9:21 am
Location: Libera
Contact:

Post by spithash »

change this line:

Code: Select all

set matches [regexp -all -inline {<td class='text' colspan='2' id='.*?'>(.*?)</td} $data];
to this:

Code: Select all

set matches [regexp -all -inline {<td class='text' colspan='3' id='.*?'>(.*?)</td} $data];
Special thanks to arfer who helped me with this.
Libera ##rtlsdr & ##re - Nick: spithash
Click here for troll.tcl
n
neocharles
Voice
Posts: 34
Joined: Tue Apr 23, 2013 4:29 pm

Post by neocharles »

herpderp. I hear this needs an update.
g
goalie204
Halfop
Posts: 44
Joined: Thu Apr 28, 2011 7:31 pm

Post by goalie204 »

script just says nothing found now for everything.

anyone have a fix?
Post Reply