| View previous topic :: View next topic |
| Author |
Message |
dj-zath
Op
Joined: 15 Nov 2008
Posts: 134
|
 Posted: Fri Feb 08, 2013 12:44 pm Post subject: [SOLVED] a simple quickie (thats NOT so simple!) |
 |
|
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: |
([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: |
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
Last edited by dj-zath on Tue Mar 05, 2013 9:30 am; edited 1 time in total |
|
| Back to top |
|
 |
Madalin
Master
Joined: 24 Jun 2005
Posts: 310
Location: Constanta, Romania
|
| Posted: Fri Feb 08, 2013 2:14 pm Post subject: |
|
|
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: |
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"
}
}
|
_________________
https://github.com/MadaliNTCL - To chat with me: https://tawk.to/MadaliNTCL |
|
| Back to top |
|
|
speechles
Revered One
Joined: 26 Aug 2006
Posts: 1398
Location: emerald triangle, california (coastal redwoods)
|
| Posted: Fri Feb 08, 2013 4:15 pm Post subject: Re: a simple quickie (thats NOT so simple!) |
|
|
| dj-zath wrote: | | Code: | ([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: | 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: | 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
}
} |
_________________
speechles' eggdrop tcl archive
Last edited by speechles on Fri Feb 08, 2013 4:24 pm; edited 1 time in total |
|
| Back to top |
|
|
Madalin
Master
Joined: 24 Jun 2005
Posts: 310
Location: Constanta, Romania
|
| Posted: Fri Feb 08, 2013 4:19 pm Post subject: |
|
|
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
_________________
https://github.com/MadaliNTCL - To chat with me: https://tawk.to/MadaliNTCL |
|
| Back to top |
|
|
speechles
Revered One
Joined: 26 Aug 2006
Posts: 1398
Location: emerald triangle, california (coastal redwoods)
|
| Posted: Fri Feb 08, 2013 4:37 pm Post subject: |
|
|
| Madalin wrote: | 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
_________________
speechles' eggdrop tcl archive |
|
| Back to top |
|
|
Madalin
Master
Joined: 24 Jun 2005
Posts: 310
Location: Constanta, Romania
|
| Posted: Fri Feb 08, 2013 4:44 pm Post subject: |
|
|
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
_________________
https://github.com/MadaliNTCL - To chat with me: https://tawk.to/MadaliNTCL |
|
| Back to top |
|
|
dj-zath
Op
Joined: 15 Nov 2008
Posts: 134
|
| Posted: Sat Feb 09, 2013 5:56 am Post subject: |
|
|
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-
|
|
| Back to top |
|
|
dj-zath
Op
Joined: 15 Nov 2008
Posts: 134
|
| Posted: Tue Mar 05, 2013 10:20 am Post subject: |
|
|
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: |
if {(($DetX == "1") ||($DetY == "0"))&&($DetZ == "Hi there!")} {
putserv "PRIVMSG $Chan : $nick says $DetZ"
}
|
actually loads in as:
| Code: |
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: |
proc TestMe {nick uhost hand chan arg} {
|
loads in as:
| Code: |
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: |
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-
|
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
