[SOLVED] a simple quickie (thats NOT so simple!)

[dj-zath]

hi gang!

I got one for ya...

recently I was messing around, trying to come up with a simple "link detector" script..

not as simple as it seems!

the problem was, it wasn't finding a link/parts of a link if it was part of a longer line...

example:

it would find '.com' fine, but not if it was 'warp-radio.com', etc etc

so I started messing around a little...

to combat this, I tried using regsub.. worked, but it acted strange under some/cirtain matches; for example, etv read as .tv so when someone typed "the TV guy" they got booted!

example:

Code: Select all

([regsub -all -nocase "http\:\/\/" $arg "" VarA] > "0")||
([regsub -all -nocase "www\." $arg "" VarA] > "0")||
([regsub -all -nocase "irc\." $arg "" VarA] > "0")||
([regsub -all -nocase ".com" $arg "" VarA] > "0")||
([regsub -all -nocase ".net" $arg "" VarA] > "0")||
([regsub -all -nocase ".org" $arg "" VarA] > "0")||
([regsub -all -nocase ".info" $arg "" VarA] > "0")||
([regsub -all -nocase ".gov" $arg "" VarA] > "0")||
([regsub -all -nocase ".eu" $arg "" VarA] > "0")||
([regsub -all -nocase ".uk" $arg "" VarA] > "0")||
([regsub -all -nocase ".tv" $arg "" VarA] > "0")||
([regsub -all -nocase ".tw" $arg "" VarA] > "0")||
([regsub -all -nocase ".jp" $arg "" VarA] > "0")||
([regsub -all -nocase ".kr" $arg "" VarA] > "0")||
([regsub -all -nocase ".ca" $arg "" VarA] > "0")||
([regsub -all -nocase ".nyan\.cat" $arg "" VarA] > "0")

so I tried a different approach.. this one works BETTER but still triggers on double quotes in/and some lines with spaces in them..

Code: Select all

bind pubm - * NoLink;

proc  NoLink {nick args} {
        global MyChan
        set arg "[lindex $args end-0]";
        set arg "[string map -nocase {" " ""} $arg]";
        if {
                ([isop $nick] != "1")&&(

                ([lsearch -exact $arg [string map -nocase {"http://" ""} $arg]] < "0")||
                ([lsearch -exact $arg [string map -nocase {"ftp://" ""} $arg]] < "0")||
                ([lsearch -exact $arg [string map -nocase {"rtmp://" ""} $arg]] < "0")||
                ([lsearch -exact $arg [string map -nocase {"ftp." ""} $arg]] < "0")||
                ([lsearch -exact $arg [string map -nocase {"www." ""} $arg]] < "0")||
                ([lsearch -exact $arg [string map -nocase {"irc." ""} $arg]] < "0")||
                ([lsearch -exact $arg [string map -nocase {".com" ""} $arg]] < "0")||
                ([lsearch -exact $arg [string map -nocase {".org" ""} $arg]] < "0")||
                ([lsearch -exact $arg [string map -nocase {".net" ""} $arg]] < "0")||
                ([lsearch -exact $arg [string map -nocase {".gov" ""} $arg]] < "0")||
                ([lsearch -exact $arg [string map -nocase {".tv" ""} $arg]] < "0")||
                ([lsearch -exact $arg [string map -nocase {".info" ""} $arg]] < "0")||
                ([lsearch -exact $arg [string map -nocase {".uk" ""} $arg]] < "0")||
                ([lsearch -exact $arg [string map -nocase {".eu" ""} $arg]] < "0")||
                ([lsearch -exact $arg [string map -nocase {".jp" ""} $arg]] < "0")||
                ([lsearch -exact $arg [string map -nocase {".kr" ""} $arg]] < "0")||
                ([lsearch -exact $arg [string map -nocase {".ca" ""} $arg]] < "0")
        )} {
                putquick "PRIVMSG #$MyChan :DETECTED!"
                putquick "KILL $nick :**NO** links allowed in the lobby channel... OUT YOU GO!!";
        };
        return "0";
};

you'd think this would be straightforward.. but, I sure had a fun time trying to figure this one out!

just wondered what ya think...

-DjZ

[Madalin]

I think this is all you need
If you need further modification on this code please reply
It will match everything that will start with 'http://...' or 'www.'

Code: Select all

bind PUBM - * check:pubm

proc check:pubm {nick uhost hand chan arg} {

	if {[string match -nocase "http://*" $arg] || [string match -nocase "www.*" $arg]} {
		putserv "PRIVMSG $chan :Found $arg.... links not allowed here"
	}
}

[speechles]

Code: Select all

([regsub -all -nocase "http\:\/\/" $arg "" VarA] > "0")||
([regsub -all -nocase "www\." $arg "" VarA] > "0")||
([regsub -all -nocase "irc\." $arg "" VarA] > "0")||
([regsub -all -nocase ".com" $arg "" VarA] > "0")||
([regsub -all -nocase ".net" $arg "" VarA] > "0")||
...rest snipped irrelevant...

See that lats one there. The one ".net" there specifically. To regexp, an atom is signified by the . in this case, it will match literally any character. To make it literally match, say, a period, "\.net" is used. Whats odd is you use this escaping on some of your masks, and then again not on others. To avoid this, you can use [string] which does not make use of the period to signify any special meaning.

To make this far easier you need a list of matches you want to do, just like I have done below...

Note: The code below uses some string/list tricks to avoid having to iterate both the masks lists and the text split on space.

Code: Select all

proc return_urls {text} {
   # masks to signify urls within text
   set matches [list "*.com" "www.*" "http:*"]
   # iterate mask matches
   foreach match $matches {
      # do we have a match?
      if {[string match -nocase $match $text]} {
         #yes, catch where the last space is after the url match
         set lastspace [string first " " $text [string first [string map [list * "" \? ""] $match] $text]]
         # split off the url from our captured text
         # and store a temp variable to rebuild text surrounding
         set url [lindex [set temp [split [string trim [string range $text 0 $lastspace]]]] end]
         # rejoin text with url we parsed out removed
         set text [join [lrange $temp 0 end-1]][string range $text $lastspace end]
         # add url to list of urls found in text
         lappend urls $url
      }
   }
   # did anything match, is there a url list?
   if {[info exists urls]} {
     # yes, return the list of urls with dupes removed.
     return [lsort -unique $urls]
   } else {
     # no return 0, to signify nothing matched
     return 0
   }
}

You would use it in another procedure, say, like so...

Code: Select all

set urls [return_urls $text]
# are there urls, anything but 0 = a url list exists
if {$urls !=0} {
   foreach url $urls {
       # do stuff with each url found
   }
}

[Madalin]

speechless - I understood that he only wants to match the www. http:// links and not the links containing specified extentions like .com .org etc i thought he was only playing with the code to see if it matches

If you want i can make a script on which you can add/remove the "com/org/tw" using public commands

[speechles]

speechless - I understood that he only wants to match the www. http:// links and not the links containing specified extentions like .com .org etc i thought he was only playing with the code to see if it matches

If you want i can make a script on which you can add/remove the "com/org/tw" using public commands

I'm betting he meant the urls that aren't directly clickable as well. Usually only www. and http:// cause a clickable url. I think he also wanted to react on url's that people may copy/paste. It's also clear this fellow doesn't clearly know core tcl concepts as evidenced by his use of "args" in his procedure header bound to an eggdrop bind. And his use of lindex then on $args with an end-0 argument. It's very confusing, and knowing this fellow has been posting on egghelp for quite some time. Its disheartening that nothing has been gained or learned from any of these experiences. This is why the code I put above has so many #comments, I am trying to teach the guy at least... heh

[Madalin]

Yeah well i just said if he really wants what you said (because from what he tryed to request i didnt understood well) i could write a script with public commands i think it will be much easier for him insted of trying to learn TCL. I learned (atleast what i know) TCL the hard way but i learned it because i liked it... and if you say he is here for sometime and he still didnt learned anything it would be best for a script like im thinking.

Easy for him easy for you

But if you teach TCL ) im willing to learn i clearly don`t that much as you yet everyone thinks a script in his way. A script can be written in many ways simple/harder

[dj-zath]

hi there and thanks to the BOTH of you!

Madalin:

I appreciate your effort here, however, Speechles was correct in that I want to detect ANY link, from a copy, paste "drag out" (ex: w w w . w a r p - r a d i o . c o m)and the like..

some trolls in chatrooms can get pretty CLEVER!

Speechles:

I appreciate the lessons; I DO try to understand what you, NML375 and others have posted in the past.. but, at the same time, I'm trying to build this custom bot thingy to do everything from reading URLs, to parsing streams, to writing and generating a dynamic website.. to most everything in-between!

difficult or not, I seemed to have created a language of TCL of all my own.. I can bet it would be really hard for someone to follow along, but, in the end, I managed (to my surprise) to have gotten it working! I do understand SOME concepts, but those limited only to the tasks being handled in this bot/project; outside of that, I haven't gotten a clue.

let it be known, I HATE TCL.. TCL EATS BABIES! heheh but I understand that I have to adapt to using it for this purpose exclusively..

I do read the docs, manuals.. and ask you guys a lot.. and I value the advice from each and every one of you..

Now, I'll take your example and "take it apart" so that I can understand how each part works, I don't simply "copy and paste" but I do TRY to learn what you are trying to teach me.. you and NML375 have been instrumental in teaching me what I need to know, to make that super bot

though I'd rather hire you 2 to write it over hehehe

-DjZ-

[dj-zath]

hi gang!

just a quick follow up here..

I did manage to get it working... however, I have found a few "strange" issues that I should try to explain.. they are, indeed, the reason this thing acts up the way that it does.. Is this a result from my lack of total understanding of TCL? YOU BET! but I couldn't find anything on these issues anywhere- not in the manuals, not online.. nowhere...

it appears that there seems to be some kind of "string length limit" and this limit is variable, too (I say "string" for clarity and not meaning an actual string itself) this limit seems to change/be different on each boot/reboot of the code and/or host OS; anything after this "limit" will simply be "cut off" and ignored; even though it exists there, in the written code itself.

example:

Code: Select all

if {(($DetX == "1") ||($DetY == "0"))&&($DetZ == "Hi there!")} {
putserv "PRIVMSG $Chan : $nick says $DetZ"
}

actually loads in as:

Code: Select all

if {(($DetX == "1") || ($DetY == "0")) && ($De} {
    putserv "PRIVMSG $Chan : $nick sa
}

and, of course, it will BREAK with a undefined/cryptic error message (if a message is even given at all!)

this also happens for procedure init/argument strings (sorry, I don't know what these are actually called)

example:

Code: Select all

proc TestMe {nick uhost hand chan arg} {

loads in as:

Code: Select all

proc TestMe {nick uhost hand cha} {
}

and, yes.. of course it ERRORS and it can be very difficult to FIND said errors sometimes!

for example: the code would bitch saying "wrong number of arguments, should be <whatever I have in there>" VERY PUZZLING!

I have also discovered that putting a ; with a space at the end of most lines helps with this issue; it doesn't solve it- just more of a "work-around". I have become accustomed to adding the ; after most every line as a terminator.

Now, to my friend, Speechles:

the reason I used "args" was because I needed a way to "seclect" a different output based on if it was a message, or in public...

Code: Select all

proc AP-On {nick args} {
global DetAP;
    if {([llength $args] == "4")} {set VarA {NOTICE};} else {set VarA {PRIVMSG};};
    if {($DetAP != "1")} {set DetAP "1"; putquick "$VarA $nick :AutoPlay now\002 ON";} else {putquick "$VarA $nick :AutoPlay is already\002 ON";};
    return "0";
};

this was one of the many many things I learned in this forum of how to do it!

and finally, in the previous post, as mentioned above, it seems that "args" works perfect, while "nick uhost hand chan arg" only works on occasion/intermittently (again that strange variable string cutoff issue?) I found little help or explanation as to why this happens.

and once again, I want to thank each and every one of you who have helped "this strange fellow" (myself) in making some kind of a functioning piece of code.. its been running for YEARS, and, though quirky at times; but, only during coding. it does seem to work OKay if I just leave it alone hehe

-DjZ-