forum.eggdrop.org.ru / всё о eggdrop/windrop, tcl скриптах, модулях, генераторах статистики -> Сравнение записей из файла

eggdrop.org.ru - The Russian Eggdrop Resource

eggdrop.org.ru · Правила

Помощь

Поиск

Участники

Календарь

Здравствуйте Гость ( Вход | Регистрация )

Выслать повторно письмо для активации

forum.eggdrop.org.ru / всё о eggdrop/windrop, tcl скриптах, модулях, генераторах статистики > EggDrop > TCL скрипты

Сравнение записей из файла

Подписка на тему | Сообщить другу | Версия для печати

drilly	Отправлено: Apr 1 2009, 02:54 PM
Новичок Группа: Участник Сообщений: 4 Пользователь №: 8935 Регистрация: 8-October 08	Всем привет! Есть скриптик который записывает в файлик все интернет ссылки которые постили на канале. По комманде можно запросить последние 10 ссылок из файла. Не могу никак сообразить как сделать так, чтобы в файлик заносились только те ссылки которых нет ещё в файле. Т.е. нужно проверять перед добавлением в файл, что такая ссылка отстутствует в файле. Помогите плиз. Спасибо! -------------------- Сайт приколов TomZone - приколы, картинки, игры, видео, анекдоты, юмор.

Deniska	Отправлено: Apr 1 2009, 04:20 PM
Гуру Группа: #eggdrop opers Сообщений: 334 Пользователь №: 510 Регистрация: 17-March 05	Скрипт в студию. Поди lasturls.tcl ? Это не скрипт, это так, скриптик.

Vertigo

Отправлено: Apr 1 2009, 04:31 PM

Почти Профи

Группа: Участник
Сообщений: 166
Пользователь №: 5641
Регистрация: 25-October 07

Все предельно просто. Ваяем процедуру вроде

CODE

proc existstitle {query} {
set file [open urls.dat r]
set data [read $file]
close $file
foreach line [split $data \n] {
if {![string match -nocase "*http*://*$query*" "*$line*"]} {continue}
if {[string match -nocase "*http*://*$query*" "*$line*"]} {catch {unset data}; return 1}
}
catch {unset data}
return 0
}

В urls.dat у нас ссылки.
В процедуре которая их пишет в файл, добавить перед записью нечто вроде:

CODE

if {[existstitle "$query"] eq "1"} {return} else {set file [open urls.dat a]; puts $file "$query"; close $file}

drilly

Отправлено: Apr 2 2009, 11:08 AM

Новичок

Группа: Участник
Сообщений: 4
Пользователь №: 8935
Регистрация: 8-October 08

Vertigo, спасибо большое!
Идея с foreach'eм, а точнее вот этот кусочек:

CODE

foreach line [split $data \n] {
if {![string match -nocase "*http*://*$query*" "*$line*"]} {continue}
if {[string match -nocase "*http*://*$query*" "*$line*"]} {catch {unset data}; return 1}
}

помогли мне дописать проверку в скрипте. Единственное я не понял зачем здесь нужна вот эта строчка:

CODE

if {![string match -nocase "*http*://*$query*" "*$line*"]} {continue}

так зачем же оно?

--------------------

Сайт приколов TomZone - приколы, картинки, игры, видео, анекдоты, юмор.

Kein	Отправлено: Apr 2 2009, 12:33 PM
Совсем Продвинутый Группа: Участник Сообщений: 142 Пользователь №: 4459 Регистрация: 24-August 07	Just for lulz. -------------------- Гражданин Советской Империи.

drilly

Отправлено: May 25 2009, 04:10 PM

Новичок

Группа: Участник
Сообщений: 4
Пользователь №: 8935
Регистрация: 8-October 08

совсем забыл поделиться с вами скриптом.

CODE

set piccheck(version) "0.1"
set filePath /home/eggdrop/files.txt

bind pubm - * urlcheck

setudef flag piccheck

proc urlcheck { nick uhost hand chan str } {
global piccheck
set urlcheck(ext) {
jpg
jpe
jpeg
gif
png
}
if {![regexp {((?:http://|www\.)+[^ ]+)} $str str]} { return 0 }
set extension ""
set wlink $str
regsub -all -- {(http://)+} $str "" str
regexp {(www.)?[A-z|0-9|\-|\.|\_]*\.[A-z]{2,3}} $str host
regexp {[/]+(.)*} $str url
regexp {[A-z]{3,4}$} $str extension
set ispic 0
foreach i $urlcheck(ext) {
if {[string match -nocase $extension $i]} {
set ispic 1
}
}
if {$ispic != 1} { return 0 }
set linecheck "[getdata $host $url $chan]"
set ispic 0
if {[string match *error* $linecheck]} { set ispic 1 }
if {[string match "*<html>*" $linecheck]} { set ispic 1 }
global filePath
set file [open $filePath r]
set data [read $file]
close $file
set already 0;
foreach line [split $data \n] {
if { [string match -nocase $wlink $line] == 1 } {catch {unset data}; set already 1; }
}
if { $ispic == 0 && $already == 0 } {
set file [open $filePath "a"]
puts $file "$wlink"
close $file
}
}
proc getdata { host url chan } {
global sock
if {[string match "*error*" [open_socket $host $url $chan]]} { return "error"}
gets $sock line
if {[string match -nocase "*HTTP/1.? 301 Moved*" $line]} {
while {![eof $sock]} {
gets $sock line
if {[string match -nocase "*Location*" $line]} {
set url [lindex [split $line] 1]
regsub -all -- {(http://)+} $url "" url
regexp {[/]+(.)*} $url url
close $sock
open_socket $host $url $chan
gets $sock line
break
}
}
}
if {![string match "HTTP/1.? 200 OK" $line]} { close $sock;return "error($line)" }
while {(![eof $sock]) && ([string length $line] != 0)} {
gets $sock line
# if {[string match -nocase *content*type* $line]} {putlog "$line" }
}
gets $sock line
close $sock
return $line
}

proc open_socket { host url chan } {
global sock
# putlog "Host: $host - url : $url"

if {[catch {set sock [socket [string map -nocase {www. ""} $host] 80] } sockerror]} {
putserv "PRIVMSG $chan: Error: $sockerror"
return "error: $sockerror"
} else {
puts $sock "GET $url HTTP/1.1"
puts $sock "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
puts $sock "Accept :*/*"
puts $sock "Host: $host"
puts $sock ""
flush $sock
}
}

putlog "Drilly's Picture-URL-Saver $piccheck(version) loaded..."

Написал как смог, ибо желания вникать в сам язык не было никакого абсолютно, потому как не вижу в этом выгоды для себя.
Что делает скрипт:
- соберает все ссылки на картинки в файлик;
- проверяет, что ссылки живые, что по ссылке реально отдаётся картинка и только тогда пишет в файл;
- проверяет, что в файле нет повторов.
Хотел ещё сделать эти штуки, но как-то стало лень:
!links - выдаёт последние 5 ссылок из базы
!links10 - аналогично, только ссылок 10.
Добавить время в базу, чтобы перед ссылкой указывалась дата и время когда ссылка была добавлена в базу.
Так что если кто-то захочет улучшить скрипт, буду только рад.
Планировал на его основе набросать скриптик на php, который бы генерил страничку с этими картинками, однако после анализа двухмесячной базы понял, что контент достаточно тухлый и состоит чуть менее чем полностью из фоток из вкантактика.

--------------------

Сайт приколов TomZone - приколы, картинки, игры, видео, анекдоты, юмор.

username	Отправлено: Jan 13 2010, 07:11 PM
Сдвинутый Группа: #eggdrop opers Сообщений: 612 Пользователь №: 770 Регистрация: 2-July 05	Если кому интересен этот скрипт то вот http://forum.egghelp.ru/viewtopic.php?p=509#p509 продолжение работы над ним. -------------------- Архив TCL скриптов, Форум и Egg.Wiki: http://egghelp.ru/

drilly

Отправлено: Feb 11 2010, 02:46 PM

Новичок

Группа: Участник
Сообщений: 4
Пользователь №: 8935
Регистрация: 8-October 08

QUOTE (username @ Jan 13 2010, 07:11 PM)

Если кому интересен этот скрипт то вот http://forum.egghelp.ru/viewtopic.php?p=509#p509 продолжение работы над ним.

что-то не открывается твой сайт.
выложи копипастю сюда плиз.

--------------------

Сайт приколов TomZone - приколы, картинки, игры, видео, анекдоты, юмор.

username	Отправлено: Feb 11 2010, 11:19 PM
Сдвинутый Группа: #eggdrop opers Сообщений: 612 Пользователь №: 770 Регистрация: 2-July 05	Работает. -------------------- Архив TCL скриптов, Форум и Egg.Wiki: http://egghelp.ru/

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)

0 Пользователей:

« Предыдущая тема | TCL скрипты | Следующая тема »

Упрощённая версия

[ Script Execution time: 0.1028 ] [ 13 queries used ] [ GZIP включён ]