Latest Urban Dictionary tcl

[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.....

[spithash]

anything new with urban? or any other similar script ? thanks.

[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.

[horgh]

me too
http://github.com/horgh/eggdrop-scripts ... /slang.tcl

[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";

[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

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

[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

[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"

[spithash]

anyone cares to update this script?

[x0x]

Broken again?

[spithash]

Apparently

[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"

[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.

[neocharles]

herpderp. I hear this needs an update.

[goalie204]

script just says nothing found now for everything.

anyone have a fix?