Tkabber contrib

Check-in [2c2736ffd4]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment: bldjid2.tcl: Got rid of [lcontain] and [cequal] calls because they are about to be removed from Tkabber.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:2c2736ffd435947205c4c62f039ce4d74b21c375
User & Date: sgolovan 2015-03-30 07:04:43
Context
2015-03-30
07:06
gui_action.tcl: Got rid of [lempty] call because it will be removed from Tkabber in the nearest future. check-in: 1dfc897b2c user: sgolovan tags: trunk
07:04
bldjid2.tcl: Got rid of [lcontain] and [cequal] calls because they are about to be removed from Tkabber. check-in: 2c2736ffd4 user: sgolovan tags: trunk
07:02
Got rid of [lcontain] and [cequal] calls because they are about to be removed from Tkabber. check-in: b34ad81538 user: sgolovan tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to bldjid2/Changelog.













1
2
3
4
5
6
7












2011-02-09  Serge Yudin  <xmpp:bigote@jabber.ru> <mailto:bigote@gmail.com>

--- Version 0.1.0.1 of the plugin.

--- Files modified:
	bldjid2.tcl, log2base.tcl, README, README.ru, ChangeLog.

>
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
2015-03-30  Sergei Golovan  <xmpp:sgolovan@nes.ru> <mailto:sgolovan@nes.ru>

--- Version 0.1.0.2 of the plugin.

--- Files modified:
	bldjid2.tcl, ChangeLog.

--- Description:
	bldjid2.tcl:
	Got rid of [lcontain] and [cequal] calls because they are about
	to be removed from Tkabber.

2011-02-09  Serge Yudin  <xmpp:bigote@jabber.ru> <mailto:bigote@gmail.com>

--- Version 0.1.0.1 of the plugin.

--- Files modified:
	bldjid2.tcl, log2base.tcl, README, README.ru, ChangeLog.

Changes to bldjid2/bldjid2.tcl.

1
2
3
4
5
6
7
8
...
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
...
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
....
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
....
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
....
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
....
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
# "Bldjid2" plugin for Tkabber. 2011-02-09 v. 0.1.0.1
# Written by Serge Yudin xmpp:bigote@jabber.ru
# See README or README.ru file for usage.

namespace eval bldjid2 {
    ::msgcat::mcload [file join [file dirname [info script]] msgs]
    if {![::plugins::is_registered bldjid2]} {
	::plugins::register bldjid2 \
................................................................................
	return
    }
    set group [::chat::get_jid $chatid]
    if {$options(rooms2log) != "" && ![string match *$group* $options(rooms2log)]} {
	return
    }
    if {[chat::is_groupchat $chatid]} {
	set user_already_here [lcontain [::muc::roster $chatid] $nick]
	if {!$user_already_here} {
	    return
	}
    } else {
	return
    }
    if {[::chat::is_opened $chatid] \
     && [::chat::is_groupchat $chatid]} {
................................................................................
    }
    if {![info exists grplist]} {
	return stop
    }
    foreach tmpchatid $grplist {
	set tmpgrp [::chat::get_jid $tmpchatid]
	set nick [get_our_groupchat_nick $tmpchatid]
	if {[lcontain [::muc::roster $tmpchatid] $nick]} {
	    switch -- $which {
		admin {
		    set iam [whoami $xlib $tmpgrp]
		    if {[string match *moderator* $iam] \
			&& ![string match *%*@irc* $tmpgrp]} {
			if {$options(rooms2log) == ""} {
			    lappend grpjids $tmpgrp
................................................................................

proc bldjid2::parse_info_iqversion {xlib chatid group nick node part_list full_list my_id res child} {
    variable options
    if {![winfo exists [chat::chat_win $chatid]]} {
	return
    }
    set jid $group/$nick
    if {![cequal $res ok]} {
	set cli " "
	set ver " "
	set os " "
    }

    ::xmpp::xml::split $child tag xmlns attrs cdata subels

    userinfo::parse_iqversion_item $jid $subels
    if {[info exists userinfo::userinfo(clientname,$jid)] && \
     ![cequal $userinfo::userinfo(clientname,$jid) ""]} {
	append cli " $userinfo::userinfo(clientname,$jid)"
	set cli [string trim $cli]
	if {[string equal \*NO\ CLIENT\* $cli] && $node != ""} {
	    set cli $node
	}
    } else {
	set cli "NO INFO"
................................................................................
	db eval {
	    INSERT INTO client
	    VALUES(NULL, $cli)
	}
	set cli_id [db eval {SELECT last_insert_rowid();}]
    }
    if {[info exists userinfo::userinfo(clientversion,$jid)] && \
     ![cequal $userinfo::userinfo(clientversion,$jid) ""]} {
	append ver " $userinfo::userinfo(clientversion,$jid)"
	set ver [string trim $ver]
	set ver [join [split $ver \n] ""]
    } else {
	set ver "NO INFO"
    }
    set ver_id [db eval {SELECT id FROM version WHERE ver=$ver}]
................................................................................
	db eval {
	    INSERT INTO version
	    VALUES(NULL, $ver)
	}
	set ver_id [db eval {SELECT last_insert_rowid();}]
    }
    if {[info exists userinfo::userinfo(os,$jid)] && \
     ![cequal $userinfo::userinfo(os,$jid) ""]} {
	append os " $userinfo::userinfo(os,$jid)"
	set os [string trim $os]
	set os [join [split $os \n] ""]
    } else {
	set os "NO INFO"
    }
    set os_id [db eval {SELECT id FROM osys WHERE os=$os}]
................................................................................
}

proc bldjid2::parse_info_iqtime {chatid group nick cli_id ver_id os_id part_list full_list my_id res child} {
    if {![winfo exists [chat::chat_win $chatid]]} {
	return
    }
    set jid $group/$nick
    if {![cequal $res ok]} {
	set tz " "
    }

    ::xmpp::xml::split $child tag xmlns attrs cdata subels
    userinfo::parse_iqtime_item $jid $subels
    if {[info exists userinfo::userinfo(tz,$jid)] && \
     ![cequal $userinfo::userinfo(tz,$jid) ""]} {
	append tz " $userinfo::userinfo(tz,$jid)"
	set tz [string trim $tz]
    } else {
	set tz "NO INFO"
    }
    set tz_id [db eval {SELECT id FROM timezone WHERE tz=$tz}]
    if {[string equal $tz_id ""]} {
|







 







|
<







 







|







 







|









|







 







|







 







|







 







|






|







1
2
3
4
5
6
7
8
...
254
255
256
257
258
259
260
261

262
263
264
265
266
267
268
...
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
....
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
....
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
....
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
....
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
# "Bldjid2" plugin for Tkabber. 2015-03-30 v. 0.1.0.2
# Written by Serge Yudin xmpp:bigote@jabber.ru
# See README or README.ru file for usage.

namespace eval bldjid2 {
    ::msgcat::mcload [file join [file dirname [info script]] msgs]
    if {![::plugins::is_registered bldjid2]} {
	::plugins::register bldjid2 \
................................................................................
	return
    }
    set group [::chat::get_jid $chatid]
    if {$options(rooms2log) != "" && ![string match *$group* $options(rooms2log)]} {
	return
    }
    if {[chat::is_groupchat $chatid]} {
	if {[lsearch -exact [::muc::roster $chatid] $nick] < 0} {

	    return
	}
    } else {
	return
    }
    if {[::chat::is_opened $chatid] \
     && [::chat::is_groupchat $chatid]} {
................................................................................
    }
    if {![info exists grplist]} {
	return stop
    }
    foreach tmpchatid $grplist {
	set tmpgrp [::chat::get_jid $tmpchatid]
	set nick [get_our_groupchat_nick $tmpchatid]
	if {[lsearch -exact [::muc::roster $tmpchatid] $nick] >= 0} {
	    switch -- $which {
		admin {
		    set iam [whoami $xlib $tmpgrp]
		    if {[string match *moderator* $iam] \
			&& ![string match *%*@irc* $tmpgrp]} {
			if {$options(rooms2log) == ""} {
			    lappend grpjids $tmpgrp
................................................................................

proc bldjid2::parse_info_iqversion {xlib chatid group nick node part_list full_list my_id res child} {
    variable options
    if {![winfo exists [chat::chat_win $chatid]]} {
	return
    }
    set jid $group/$nick
    if {$res ne "ok"} {
	set cli " "
	set ver " "
	set os " "
    }

    ::xmpp::xml::split $child tag xmlns attrs cdata subels

    userinfo::parse_iqversion_item $jid $subels
    if {[info exists userinfo::userinfo(clientname,$jid)] && \
	$userinfo::userinfo(clientname,$jid) ne ""} {
	append cli " $userinfo::userinfo(clientname,$jid)"
	set cli [string trim $cli]
	if {[string equal \*NO\ CLIENT\* $cli] && $node != ""} {
	    set cli $node
	}
    } else {
	set cli "NO INFO"
................................................................................
	db eval {
	    INSERT INTO client
	    VALUES(NULL, $cli)
	}
	set cli_id [db eval {SELECT last_insert_rowid();}]
    }
    if {[info exists userinfo::userinfo(clientversion,$jid)] && \
	$userinfo::userinfo(clientversion,$jid) ne ""} {
	append ver " $userinfo::userinfo(clientversion,$jid)"
	set ver [string trim $ver]
	set ver [join [split $ver \n] ""]
    } else {
	set ver "NO INFO"
    }
    set ver_id [db eval {SELECT id FROM version WHERE ver=$ver}]
................................................................................
	db eval {
	    INSERT INTO version
	    VALUES(NULL, $ver)
	}
	set ver_id [db eval {SELECT last_insert_rowid();}]
    }
    if {[info exists userinfo::userinfo(os,$jid)] && \
	$userinfo::userinfo(os,$jid) ne ""} {
	append os " $userinfo::userinfo(os,$jid)"
	set os [string trim $os]
	set os [join [split $os \n] ""]
    } else {
	set os "NO INFO"
    }
    set os_id [db eval {SELECT id FROM osys WHERE os=$os}]
................................................................................
}

proc bldjid2::parse_info_iqtime {chatid group nick cli_id ver_id os_id part_list full_list my_id res child} {
    if {![winfo exists [chat::chat_win $chatid]]} {
	return
    }
    set jid $group/$nick
    if {$res ne "ok"} {
	set tz " "
    }

    ::xmpp::xml::split $child tag xmlns attrs cdata subels
    userinfo::parse_iqtime_item $jid $subels
    if {[info exists userinfo::userinfo(tz,$jid)] && \
	$userinfo::userinfo(tz,$jid) ne ""} {
	append tz " $userinfo::userinfo(tz,$jid)"
	set tz [string trim $tz]
    } else {
	set tz "NO INFO"
    }
    set tz_id [db eval {SELECT id FROM timezone WHERE tz=$tz}]
    if {[string equal $tz_id ""]} {