Check-in [59fe76a455]

Not logged in
Tcl 2015 Conference, Manassas/VA, US, Oct 19-23
Send your abstracts to tclconference@googlegroups.com by Aug 24.

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

Overview
Comment:Added flag and command to mark contacts as dead. Show this flag in listing and details.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | active-on-core
Files: files | file ages | folders
SHA1:59fe76a4557499e9b7ac0146deec3d2595839c2e
User & Date: aku 2017-09-13 04:22:55
Context
2017-09-13
21:27
Oops. Forgot new flag in contact creation. Fixed. check-in: 2a4296c83b user: aku tags: active-on-core
04:22
Added flag and command to mark contacts as dead. Show this flag in listing and details. check-in: 59fe76a455 user: aku tags: active-on-core
2017-09-12
21:37
Added new entity "series", which refers to a group of conferences which belong together in some way. For the Tcl conferences going on in North-America, distinct from the conferences in Europe. Extended the database and added a basic set of commands to create, destroy and use series. Extended the conference commands to deal with the new series. This required an extension of the conference table schema. The information about the series is available for insertion into templates (@c:series@). The same is true for the detail information of a series, the link to its index page (@c:series:link@). At the moment this index page has to be maintained manually. It is planned to extend the website generator in the long-term future to generate the sites of all known conferences, plus indices. Beyond the above the contact commands got extensions as well. Creation of a contact is now able to set tags, bio information, and related contacts (affiliations, reps). check-in: 204b098bff user: aku tags: active-on-core
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added fixes/016_contact_dead.sql.



















































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
-- - - -- --- ----- -------- ------------- ---------------------
-- Added column "contact.is_dead"

-- - - -- --- ----- -------- ------------- ---------------------
CREATE TABLE new_contact (
	-- General data for any type of contact:
	-- actual person, mailing list, company
	-- The flags determine what we can do with a contact.

	id		INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
	tag		TEXT 	UNIQUE,			-- for html anchors, and quick identification
	type		INTEGER NOT NULL REFERENCES contact_type,
	name	 	TEXT	NOT NULL UNIQUE,	-- identification NOCASE -- lower(dname)
	dname	 	TEXT	NOT NULL,		-- display name
	biography	TEXT,				-- a person's bio, or list/project/company description
	bio_public	INTEGER NOT NULL,		-- bio is generally public
	can_recvmail	INTEGER NOT NULL,	-- valid recipient of conference mail (call for papers)
	can_register	INTEGER NOT NULL,	-- actual person can register for attendance
	can_book	INTEGER NOT NULL,	-- actual person can book hotels
	can_talk	INTEGER NOT NULL,	-- actual person can do presentation
	can_submit	INTEGER NOT NULL,	-- actual person, or company can submit talks
	is_dead         INTEGER NOT NULL	-- true for deceased person ...
);

-- - - -- --- ----- -------- ------------- ---------------------
-- default dead to false.
INSERT INTO new_contact
SELECT id, tag, type, name, dname, biography, 0,
       can_recvmail, can_register, can_book, can_talk, can_submit, 0
FROM contact
;

-- - - -- --- ----- -------- ------------- ---------------------
-- Switch things around
DROP TABLE contact
;
ALTER TABLE new_contact RENAME TO contact
;

-- Done
-- - - -- --- ----- -------- ------------- ---------------------

Changes to lib/cm.tcl.

2008
2009
2010
2011
2012
2013
2014








2015
2016
2017
2018
2019
2020
2021
		generate [stop!] }
	    input secondary {
		Name of the secondary contacts to merge into the primary
	    } { optional ; list ; interact ; validate [cm::vt contact]
		generate [stop!] }
	} [cm::call contact cmd_merge]









	# TODO: change flags?
	# TODO: set link title
    }
    alias contacts = contact list

    # # ## ### ##### ######## ############# ######################
    ## Schedule management







>
>
>
>
>
>
>
>







2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
		generate [stop!] }
	    input secondary {
		Name of the secondary contacts to merge into the primary
	    } { optional ; list ; interact ; validate [cm::vt contact]
		generate [stop!] }
	} [cm::call contact cmd_merge]

	private mark-dead {
	    section {Contact Management}
	    description { Mark the contacts as deceased }
	    input name {
		Name of the contacts to modify.
	    } { list ; optional ; interact ; validate [cm::vt contact] }
	} [cm::call contact cmd_dead]

	# TODO: change flags?
	# TODO: set link title
    }
    alias contacts = contact list

    # # ## ### ##### ######## ############# ######################
    ## Schedule management

Changes to lib/contact.tcl.

38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
..
84
85
86
87
88
89
90
91

92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108



109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
...
276
277
278
279
280
281
282
283

284
285
286
287
288
289
290
...
300
301
302
303
304
305
306

307
308
309
310
311
312
313
314
315
316
317
318
...
668
669
670
671
672
673
674






















675
676
677
678
679
680
681
...
688
689
690
691
692
693
694

695
696
697
698
699
700
701
....
1635
1636
1637
1638
1639
1640
1641
1642

1643
1644
1645
1646
1647
1648
1649
....
1863
1864
1865
1866
1867
1868
1869

1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882

1883
1884
1885
1886
1887
1888
1889
....
1986
1987
1988
1989
1990
1991
1992
1993







1994
1995
1996
1997
1998
1999
2000
....
2015
2016
2017
2018
2019
2020
2021



2022
2023
2024
2025
2026
2027
2028
}
namespace eval ::cm::contact {
    namespace export \
	cmd_create_person cmd_create_mlist cmd_create_company \
	cmd_add_mail cmd_add_link cmd_list cmd_show cmd_merge \
	cmd_set_tag cmd_set_bio cmd_hide_bio cmd_publish_bio cmd_get_bio cmd_disable \
	cmd_enable liaisons cmd_disable_mail cmd_hide_mail cmd_publish_mail \
	cmd_squash_mail cmd_squash_link cmd_mail_fix cmd_retype \
	cmd_rename \
	cmd_add_company cmd_add_liaison cmd_drop_company cmd_drop_liaison \
	select label get known known-email known-type details affiliated \
	get-name get-links get-email get-link get-the-link related-formatted
    namespace ensemble create

    namespace import ::cmdr::color
    namespace import ::cmdr::ask
................................................................................
	           C.dname        AS name,
	    	   C.biography    AS bio,
	    	   C.bio_public   AS bio_public,
	           C.can_recvmail AS crecv,
	    	   C.can_register AS creg,
	    	   C.can_book     AS cbook,
	    	   C.can_talk     AS ctalk,
	    	   C.can_submit   AS csubm

	    FROM  contact      C,
	          contact_type CT
	    WHERE C.id   = :contact
	    AND   C.type = CT.id
	} {
	    set issues [issues  [details $id]]
	    if {$issues ne {}} {
		$t add [color bad Issues] $issues
		$t add {} {}
	    }

	    set flags {}
	    if {$crecv} { lappend flags Receive  }
	    if {$creg } { lappend flags Register }
	    if {$cbook} { lappend flags Book     }
	    if {$ctalk} { lappend flags Talk     }
	    if {$csubm} { lappend flags Submit   }




	    set biodisplay [util adjust $w $bio]
	    if {!$bio_public} {
		set biodisplay [color bad (Private)]\n$biodisplay
	    }
	    
	    $t add Tag                $tag
	    $t add Name               [color name $name]
	    $t add Type               $type
	    $t add Flags              [join $flags {, }]
	    $t add Biography          $biodisplay

	    # Coded left self-joins for various relations...

	    # Submissions, and associated talks
................................................................................
	           C.type         AS typecode,
	           C.biography    AS bio,
	           CT.text        AS type,
	           C.can_recvmail AS crecv,
	    	   C.can_register AS creg,
	    	   C.can_book     AS cbook,
	    	   C.can_talk     AS ctalk,
	    	   C.can_submit   AS csubm

	    FROM  contact      C,
	          contact_type CT
	    WHERE (C.name  GLOB :pattern
	     OR    C.dname GLOB :pattern)
	    AND   CT.id = C.type
	    ORDER BY name
	} {
................................................................................
	    if {$norel} {
		set related {}
	    } else {
		set related [related-formatted $contact $typecode]
	    }

	    set    flags {}

	    append flags [expr {$crecv ? "M" :"-"}]
	    append flags [expr {$creg  ? "R" :"-"}]
	    append flags [expr {$cbook ? "B" :"-"}]
	    append flags [expr {$ctalk ? "T" :"-"}]
	    append flags [expr {$csubm ? "S" :"-"}]

	    if {$withmail} {
		# Show mail addresses in detail
		set mails {}
		db do eval {
		    SELECT email, inactive, public
		    FROM   email
................................................................................
	    } 
	}

	puts [color good OK]
    }
    return
}























proc ::cm::contact::cmd_retype {config} {
    debug.cm/contact {}
    Setup
    db show-location

    set type   [$config @type]
................................................................................
	db do transaction {
	    db do eval {
		UPDATE contact
		SET    type = :type
		WHERE  id   = :contact
	    }
	    # wish for more dynamic behaviour here

	    switch -exact -- $type {
		1 { # Person
		    db do eval {
			UPDATE contact
			SET    can_register = 1,
			       can_book     = 1,
			       can_talk     = 1,
................................................................................
	       'xname',         name,
	       'xdname',        dname,
	       'xbiography',    biography,
	       'xcan_recvmail', can_recvmail,
	       'xcan_register', can_register,
	       'xcan_book',     can_book,
	       'xcan_talk',     can_talk,
	       'xcan_submit',   can_submit

	FROM  contact
	WHERE id = :id
    }]
}

proc ::cm::contact::label {tag name} {
    debug.cm/contact {}
................................................................................
	    bio_public   INTEGER NOT NULL,		-- bio is generally public
	    
	    can_recvmail INTEGER NOT NULL,	-- valid recipient of conference mail (call for papers)
	    can_register INTEGER NOT NULL,	-- actual person can register for attendance
	    can_book	 INTEGER NOT NULL,	-- actual person can book hotels
	    can_talk	 INTEGER NOT NULL,	-- actual person can do presentation
	    can_submit	 INTEGER NOT NULL	-- actual person, or company can submit talks

	} {
	    {id			INTEGER 1 {} 1}
	    {tag		TEXT    0 {} 0}
	    {type		INTEGER 1 {} 0}
	    {name		TEXT    1 {} 0}
	    {dname		TEXT    1 {} 0}
	    {biography		TEXT    0 {} 0}
	    {bio_public		INTEGER 1 {} 0}
	    {can_recvmail	INTEGER 1 {} 0}
	    {can_register	INTEGER 1 {} 0}
	    {can_book		INTEGER 1 {} 0}
	    {can_talk		INTEGER 1 {} 0}
	    {can_submit		INTEGER 1 {} 0}

	} {
	    type
	}
    }]} {
	db setup-error contact $error
    }

................................................................................

proc ::cm::contact::Dump {} {
    # We can assume existence of the 'cm dump' ensemble.
    debug.cm/contact {}

    # Step I. Core contact information.
    db do eval {
	SELECT id, tag, type, dname, biography, bio_public, can_recvmail







	FROM   contact
	ORDER BY dname
    } {
	set links [db do eval {
	    SELECT link
	    FROM   link
	    WHERE contact = :id
................................................................................

	if {!$can_recvmail} {
	    cm dump save  contact disable $dname
	}
	if {$tag ne {}} {
	    cm dump save  contact set-tag $dname $tag
	}




	if {$type != 3} {
	    # not a list, multiple mails, can be inactive.
	    foreach {mail inactive public} $mails {
		cm dump save  contact add-mail $dname -E $mail
	    }
	    foreach {mail inactive public} $mails {







|
<







 







|
>












|
|
|
|
|
>
>
>







|







 







|
>







 







>
|
|
|
|
|







 







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







 







>







 







|
>







 







>













>







 







|
>
>
>
>
>
>
>







 







>
>
>







38
39
40
41
42
43
44
45

46
47
48
49
50
51
52
..
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
...
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
...
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
...
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
...
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
....
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
....
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
....
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
....
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
}
namespace eval ::cm::contact {
    namespace export \
	cmd_create_person cmd_create_mlist cmd_create_company \
	cmd_add_mail cmd_add_link cmd_list cmd_show cmd_merge \
	cmd_set_tag cmd_set_bio cmd_hide_bio cmd_publish_bio cmd_get_bio cmd_disable \
	cmd_enable liaisons cmd_disable_mail cmd_hide_mail cmd_publish_mail \
	cmd_squash_mail cmd_squash_link cmd_mail_fix cmd_retype cmd_dead cmd_rename \

	cmd_add_company cmd_add_liaison cmd_drop_company cmd_drop_liaison \
	select label get known known-email known-type details affiliated \
	get-name get-links get-email get-link get-the-link related-formatted
    namespace ensemble create

    namespace import ::cmdr::color
    namespace import ::cmdr::ask
................................................................................
	           C.dname        AS name,
	    	   C.biography    AS bio,
	    	   C.bio_public   AS bio_public,
	           C.can_recvmail AS crecv,
	    	   C.can_register AS creg,
	    	   C.can_book     AS cbook,
	    	   C.can_talk     AS ctalk,
	    	   C.can_submit   AS csubm,
	    	   C.is_dead      AS cisdead
	    FROM  contact      C,
	          contact_type CT
	    WHERE C.id   = :contact
	    AND   C.type = CT.id
	} {
	    set issues [issues  [details $id]]
	    if {$issues ne {}} {
		$t add [color bad Issues] $issues
		$t add {} {}
	    }

	    set flags {}
	    if {$crecv}   { lappend flags Receive  }
	    if {$creg }   { lappend flags Register }
	    if {$cbook}   { lappend flags Book     }
	    if {$ctalk}   { lappend flags Talk     }
	    if {$csubm}   { lappend flags Submit   }

	    set annotations ""
	    if {$cisdead} { append annotations "[color bad \u2020]" }

	    set biodisplay [util adjust $w $bio]
	    if {!$bio_public} {
		set biodisplay [color bad (Private)]\n$biodisplay
	    }
	    
	    $t add Tag                $tag
	    $t add Name               [color name $name]$annotations
	    $t add Type               $type
	    $t add Flags              [join $flags {, }]
	    $t add Biography          $biodisplay

	    # Coded left self-joins for various relations...

	    # Submissions, and associated talks
................................................................................
	           C.type         AS typecode,
	           C.biography    AS bio,
	           CT.text        AS type,
	           C.can_recvmail AS crecv,
	    	   C.can_register AS creg,
	    	   C.can_book     AS cbook,
	    	   C.can_talk     AS ctalk,
	    	   C.can_submit   AS csubm,
	    	   C.is_dead      AS cisdead
	    FROM  contact      C,
	          contact_type CT
	    WHERE (C.name  GLOB :pattern
	     OR    C.dname GLOB :pattern)
	    AND   CT.id = C.type
	    ORDER BY name
	} {
................................................................................
	    if {$norel} {
		set related {}
	    } else {
		set related [related-formatted $contact $typecode]
	    }

	    set    flags {}
	    append flags [expr {$cisdead ? "[color bad \u2020]" :""}]
	    append flags [expr {$crecv   ? "M" :"-"}]
	    append flags [expr {$creg    ? "R" :"-"}]
	    append flags [expr {$cbook   ? "B" :"-"}]
	    append flags [expr {$ctalk   ? "T" :"-"}]
	    append flags [expr {$csubm   ? "S" :"-"}]

	    if {$withmail} {
		# Show mail addresses in detail
		set mails {}
		db do eval {
		    SELECT email, inactive, public
		    FROM   email
................................................................................
	    } 
	}

	puts [color good OK]
    }
    return
}

proc ::cm::contact::cmd_dead {config} {
    debug.cm/contact {}
    Setup
    db show-location

    foreach contact [$config @name] {
	puts -nonewline "Marking contact \"[color name [get $contact]]\" as dead ... "
	flush stdout

	db do transaction {
	    db do eval {
		UPDATE contact
		SET    is_dead = 1
		WHERE  id   = :contact
	    }
	}

	puts [color good OK]
    }
    return
}

proc ::cm::contact::cmd_retype {config} {
    debug.cm/contact {}
    Setup
    db show-location

    set type   [$config @type]
................................................................................
	db do transaction {
	    db do eval {
		UPDATE contact
		SET    type = :type
		WHERE  id   = :contact
	    }
	    # wish for more dynamic behaviour here
	    # is_dead is not influenced by the type change
	    switch -exact -- $type {
		1 { # Person
		    db do eval {
			UPDATE contact
			SET    can_register = 1,
			       can_book     = 1,
			       can_talk     = 1,
................................................................................
	       'xname',         name,
	       'xdname',        dname,
	       'xbiography',    biography,
	       'xcan_recvmail', can_recvmail,
	       'xcan_register', can_register,
	       'xcan_book',     can_book,
	       'xcan_talk',     can_talk,
	       'xcan_submit',   can_submit,
	       'xis_dead',      is_dead
	FROM  contact
	WHERE id = :id
    }]
}

proc ::cm::contact::label {tag name} {
    debug.cm/contact {}
................................................................................
	    bio_public   INTEGER NOT NULL,		-- bio is generally public
	    
	    can_recvmail INTEGER NOT NULL,	-- valid recipient of conference mail (call for papers)
	    can_register INTEGER NOT NULL,	-- actual person can register for attendance
	    can_book	 INTEGER NOT NULL,	-- actual person can book hotels
	    can_talk	 INTEGER NOT NULL,	-- actual person can do presentation
	    can_submit	 INTEGER NOT NULL	-- actual person, or company can submit talks
	    is_dead	 INTEGER NOT NULL	-- contact is deceased
	} {
	    {id			INTEGER 1 {} 1}
	    {tag		TEXT    0 {} 0}
	    {type		INTEGER 1 {} 0}
	    {name		TEXT    1 {} 0}
	    {dname		TEXT    1 {} 0}
	    {biography		TEXT    0 {} 0}
	    {bio_public		INTEGER 1 {} 0}
	    {can_recvmail	INTEGER 1 {} 0}
	    {can_register	INTEGER 1 {} 0}
	    {can_book		INTEGER 1 {} 0}
	    {can_talk		INTEGER 1 {} 0}
	    {can_submit		INTEGER 1 {} 0}
	    {is_dead		INTEGER 1 {} 0}
	} {
	    type
	}
    }]} {
	db setup-error contact $error
    }

................................................................................

proc ::cm::contact::Dump {} {
    # We can assume existence of the 'cm dump' ensemble.
    debug.cm/contact {}

    # Step I. Core contact information.
    db do eval {
	SELECT id
	,      tag
	,      type
	,      dname
	,      biography
	,      bio_public
	,      can_recvmail
	,      is_dead
	FROM   contact
	ORDER BY dname
    } {
	set links [db do eval {
	    SELECT link
	    FROM   link
	    WHERE contact = :id
................................................................................

	if {!$can_recvmail} {
	    cm dump save  contact disable $dname
	}
	if {$tag ne {}} {
	    cm dump save  contact set-tag $dname $tag
	}
	if {$is_dead} {
	    cm dump save  contact mark-dead $dname
	}

	if {$type != 3} {
	    # not a list, multiple mails, can be inactive.
	    foreach {mail inactive public} $mails {
		cm dump save  contact add-mail $dname -E $mail
	    }
	    foreach {mail inactive public} $mails {