Check-in [4063c0a893]

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:Extended affilation schema to control mailability in campaign mails and website
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | active-on-core
Files: files | file ages | folders
SHA3-256:4063c0a893fbc289d1ca6f8443fb3e77b76665f1c0f6fde463e451fa83583bb0
User & Date: aku 2018-02-06 04:19:22
Context
2018-02-07
03:57
Add dummy variable to make_submission call where the data is not used. check-in: 1c18f4b5ac user: aku tags: active-on-core
2018-02-06
04:19
Extended affilation schema to control mailability in campaign mails and website check-in: 4063c0a893 user: aku tags: active-on-core
03:28
Check template for c:t:regopen check-in: 5745b9f3dc user: aku tags: active-on-core
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added fixes/017_affiliation_mailable.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
-- - - -- --- ----- -------- ------------- ---------------------
-- Added column "contact.is_dead"

-- - - -- --- ----- -------- ------------- ---------------------
CREATE TABLE new_affiliation (
    -- Relationship between contacts.
    -- People may be affiliated with an organization, like their employer
    -- A table is used as a person may be affiliated with several orgs.
    -- The flag `mailable` allows the person to control which of the
    -- affiliations should be listed in campaign mails.

    id		INTEGER NOT NULL PRIMARY KEY,
    person	INTEGER NOT NULL REFERENCES contact,
    company	INTEGER NOT NULL REFERENCES contact,
    mailable    INTEGER NOT NULL,
    UNIQUE (person, company)
);

-- - - -- --- ----- -------- ------------- ---------------------
-- default mailable to false.
INSERT INTO new_affiliation
SELECT id, person, company, 0
FROM affiliation
;

-- - - -- --- ----- -------- ------------- ---------------------
-- Switch things around
DROP TABLE affiliation
;
ALTER TABLE new_affiliation RENAME TO affiliation
;

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

Changes to lib/cm.tcl.

1790
1791
1792
1793
1794
1795
1796




1797
1798
1799
1800
1801
1802
1803
....
1816
1817
1818
1819
1820
1821
1822



















1823
1824
1825
1826
1827
1828
1829
	} [cm::call contact cmd_create_company]

	# TODO: contact delete -- delete a superfluous contact - not referenced...

	private add-affiliate {
	    section {Contact Management}
	    description {Add one or more contacts (companies, projects, ...) as the affiliations of the specified person}




	    input name {
		Name of the contact to modify
	    } { optional ; interact ; validate [cm::vt contact] ; # TODO validator only persons
		generate [stop!] }
	    input company {
		Names of the companies to add as affiliations
	    } { optional ; list ; interact ; validate [cm::vt contact] } ; # TODO validator only company
................................................................................
	    input company {
		Names of the companies to remove from the set of affiliations
	    } { optional ; list ; interact ; validate [cm::vt contact] } ; # TODO validator only company
	} [cm::call contact cmd_drop_company]
	alias remove-org
	alias remove-company
	alias remove-project




















	# Reverse affiliation. A personal contact into the company
	# ... A liaison, point of contact, representative
	private add-liaison {
	    section {Contact Management}
	    description {Add one or more liaisons to the specified company}
	    input company {







>
>
>
>







 







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







1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
....
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
	} [cm::call contact cmd_create_company]

	# TODO: contact delete -- delete a superfluous contact - not referenced...

	private add-affiliate {
	    section {Contact Management}
	    description {Add one or more contacts (companies, projects, ...) as the affiliations of the specified person}
	    option mailable {
		Indicator that this affiliation can be used in
		campaign mails.
	    } { validate boolean }
	    input name {
		Name of the contact to modify
	    } { optional ; interact ; validate [cm::vt contact] ; # TODO validator only persons
		generate [stop!] }
	    input company {
		Names of the companies to add as affiliations
	    } { optional ; list ; interact ; validate [cm::vt contact] } ; # TODO validator only company
................................................................................
	    input company {
		Names of the companies to remove from the set of affiliations
	    } { optional ; list ; interact ; validate [cm::vt contact] } ; # TODO validator only company
	} [cm::call contact cmd_drop_company]
	alias remove-org
	alias remove-company
	alias remove-project

	private flag-affiliate {
	    section {Contact Management}
	    description {Set or reset the mailable flag for the combination of person and affiliation}
	    option mailable {
		Indicator that this affiliation can be used in
		campaign mails.
	    } { validate boolean }
	    input name {
		Name of the contact to modify
	    } { optional ; interact ; validate [cm::vt contact] ; # TODO validator only persons
		generate [stop!] }
	    input company {
		Names of the companies to change the mailable-flag for
	    } { optional ; list; interact ; validate [cm::vt contact] } ; # TODO validator only company
	} [cm::call contact cmd_flag_company]
	alias flag-org
	alias flag-company
	alias flag-project

	# Reverse affiliation. A personal contact into the company
	# ... A liaison, point of contact, representative
	private add-liaison {
	    section {Contact Management}
	    description {Add one or more liaisons to the specified company}
	    input company {

Changes to lib/conference.tcl.

5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
....
5688
5689
5690
5691
5692
5693
5694
5695
5696
5697
5698
5699
5700
5701
5702

    set mdcommittee {}
    foreach cname $cnames {
	# Get full details of person, and pull affiliations, if any.
	# Get link for affiliation, if any.
	set contact     [dict get $cdata $cname]
	set affiliation {}
	foreach {aid aname} [contact affiliated $contact] {
	    set alink [contact get-the-link $aid]
	    if {$alink ne {}} {
		set aname [link $aname $alink]
	    }
	    lappend affiliation $aname
	}
	set affiliation [join $affiliation {, }]
................................................................................

	# Get full details, and pull the affiliation, if any.

	set contact     [dict get $cdata $c]
	set affiliation {}
	set prefix      "   * "

	foreach {aid aname} [contact affiliated $contact] {
	    lappend affiliation $aname
	}

	if {![llength $affiliation]} {
	    lappend committee $prefix[string trim $clabel]
	} else {
	    foreach a $affiliation {







|







 







|







5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
....
5688
5689
5690
5691
5692
5693
5694
5695
5696
5697
5698
5699
5700
5701
5702

    set mdcommittee {}
    foreach cname $cnames {
	# Get full details of person, and pull affiliations, if any.
	# Get link for affiliation, if any.
	set contact     [dict get $cdata $cname]
	set affiliation {}
	foreach {aid aname} [contact affiliated $contact 1] {
	    set alink [contact get-the-link $aid]
	    if {$alink ne {}} {
		set aname [link $aname $alink]
	    }
	    lappend affiliation $aname
	}
	set affiliation [join $affiliation {, }]
................................................................................

	# Get full details, and pull the affiliation, if any.

	set contact     [dict get $cdata $c]
	set affiliation {}
	set prefix      "   * "

	foreach {aid aname} [contact affiliated $contact 1] {
	    lappend affiliation $aname
	}

	if {![llength $affiliation]} {
	    lappend committee $prefix[string trim $clabel]
	} else {
	    foreach a $affiliation {

Changes to lib/contact.tcl.

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
...
190
191
192
193
194
195
196

197
198
199
200
201
202
203
204



205

206
207
208
209
210
211
212
....
1025
1026
1027
1028
1029
1030
1031
1032



1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
....
1058
1059
1060
1061
1062
1063
1064
























1065
1066
1067
1068
1069
1070
1071
....
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176

1177
1178
1179
1180
1181
1182
1183
1184











1185
1186
1187
1188
1189
1190
1191
....
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469













1470
1471
1472
1473
1474
1475
1476
....
2048
2049
2050
2051
2052
2053
2054


2055
2056
2057
2058

2059
2060
2061
2062
2063

2064
2065
2066
2067
2068
2069
2070
....
2188
2189
2190
2191
2192
2193
2194
2195
2196

2197
2198
2199
2200
2201
2202
2203

2204
2205




2206
2207
2208
2209
2210
2211
2212
	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 \
	cmd_rename_link cmd_title_link cmd_links
    namespace ensemble create

    namespace import ::cmdr::color
    namespace import ::cmdr::ask

    namespace import ::cm::campaign
    namespace import ::cm::db
................................................................................

	    # Affiliations. Expected for persons, to list companies,
	    # their, well, affiliations
	    
	    set first 1
	    db do eval {
		SELECT C.dname

		FROM   contact     C,
		       affiliation A
		WHERE  A.person  = :contact
		AND    A.company = C.id
		ORDER BY C.dname
	    } {
		if {$first} { $t add Affiliations {} }
		set first 0



		$t add - [color name $dname]

	    }

	    # Liaisons. Expected for companies, to list persons, their
	    # representatives
	    
	    set first 1
	    db do eval {
................................................................................
}

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

    set contact [$config @name]




    db do transaction {
	puts "Extend affiliations of \"[color name [get $contact]]\" ... "

	foreach company [$config @company] {
	    puts -nonewline "+ \"[color name [get $company]]\" ... "
	    flush stdout

	    add-affiliation $contact $company

	    puts [color good OK]
	}
    }
    return
}

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

	foreach company [$config @company] {
	    puts -nonewline "- \"[color name [get $company]]\" ... "
	    flush stdout

	    drop-affiliation $contact $company

























	    puts [color good OK]
	}
    }
    return
}

proc ::cm::contact::cmd_add_liaison {config} {
................................................................................
proc ::cm::contact::+issue {text} {
    debug.cm/contact {}
    upvar 1 issues issues
    lappend issues "- [color bad $text]"
    return
}

proc ::cm::contact::affiliated {contact} {
    debug.cm/contact {}
    Setup

    return [db do eval {
	SELECT C.id, C.dname
	FROM   contact     C,
	       affiliation A
	WHERE  A.person  = :contact
	AND    A.company = C.id
	ORDER BY C.dname
    }]











}

proc ::cm::contact::liaisons {contact} {
    debug.cm/contact {}
    Setup
    return [db do eval {
	SELECT C.id, C.dname
................................................................................
    return [db do onecolumn {
	SELECT biography
	FROM   contact
	WHERE  id = :contact
    }]
}

proc ::cm::contact::add-affiliation {contact affiliation} {
    debug.cm/contact {}
    Setup

    db do eval {
	INSERT
	INTO affiliation
	VALUES (NULL, :contact, :affiliation)













    }
    return
}

proc ::cm::contact::add-liaison {contact liaison} {
    debug.cm/contact {}
    Setup
................................................................................
    }

    if {![dbutil initialize-schema ::cm::db::do error affiliation {
	{
	    -- Relationship between contacts.
	    -- People may be affiliated with an organization, like their employer
	    -- A table is used as a person may be affiliated with several orgs.



	    id		INTEGER NOT NULL PRIMARY KEY,
	    person	INTEGER NOT NULL REFERENCES contact,
	    company	INTEGER NOT NULL REFERENCES contact,

	    UNIQUE (person, company)
	} {
	    {id		INTEGER 1 {} 1}
	    {person	INTEGER 1 {} 0}
	    {company	INTEGER 1 {} 0}

	} {}
    }]} {
	db setup-error affiliation $error
    }

    if {![dbutil initialize-schema ::cm::db::do error liaison {
	{
................................................................................
	cm dump step
    }

    # Step II. Relationships
    # (Affiliations & Liaisons (aka Representatives, Points of Contact))

    db do eval {
	SELECT C.dname AS ncompany,
	       P.dname AS nperson

	FROM   affiliation A,
	       contact     C,
	       contact     P
	WHERE  A.company = C.id
	AND    A.person  = P.id
	ORDER BY nperson, ncompany
    } {

	cm dump save \
	    contact add-affiliate $nperson $ncompany




    }

    cm dump step

    db do eval {
	SELECT C.dname AS ncompany,
	       P.dname AS nperson







|







 







>
|
|






>
>
>
|
>







 







|
>
>
>





|


|







 







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







 







|


>
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>







 







|






|
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>




>





>







 







|
|
>
|
|
|




>
|
|
>
>
>
>







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
...
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
....
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
....
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
....
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
....
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
....
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
....
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
	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 \
	cmd_rename_link cmd_title_link cmd_links cmd_flag_company
    namespace ensemble create

    namespace import ::cmdr::color
    namespace import ::cmdr::ask

    namespace import ::cm::campaign
    namespace import ::cm::db
................................................................................

	    # Affiliations. Expected for persons, to list companies,
	    # their, well, affiliations
	    
	    set first 1
	    db do eval {
		SELECT C.dname
		,      A.mailable
		FROM   contact     C
		,      affiliation A
		WHERE  A.person  = :contact
		AND    A.company = C.id
		ORDER BY C.dname
	    } {
		if {$first} { $t add Affiliations {} }
		set first 0
		if {$mailable} {
		    $t add - "[color name $dname] ([color note mailable])"
		} else {
		    $t add - [color name $dname]
		}
	    }

	    # Liaisons. Expected for companies, to list persons, their
	    # representatives
	    
	    set first 1
	    db do eval {
................................................................................
}

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

    set contact  [$config @name]
    set mailable [$config @mailable]

    set m [expr {$mailable ? " ([color note mailable])" : ""}]

    db do transaction {
	puts "Extend affiliations of \"[color name [get $contact]]\" ... "

	foreach company [$config @company] {
	    puts -nonewline "+ \"[color name [get $company]]\"$m ... "
	    flush stdout

	    add-affiliation $contact $company $mailable

	    puts [color good OK]
	}
    }
    return
}

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

	foreach company [$config @company] {
	    puts -nonewline "- \"[color name [get $company]]\" ... "
	    flush stdout

	    drop-affiliation $contact $company

	    puts [color good OK]
	}
    }
    return
}

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

    set contact [$config @name]
    set mailable [$config @mailable]
    set m [expr {$mailable ? " mailable" : "[color bad not] mailable"}]

    db do transaction {
	puts "Flag mailability of affiliations for \"[color name [get $contact]]\" ... "

	foreach company [$config @company] {
	    puts -nonewline "- \"[color name [get $company]]\": $m ... "
	    flush stdout

	    flag-affiliation $contact $company $mailable

	    puts [color good OK]
	}
    }
    return
}

proc ::cm::contact::cmd_add_liaison {config} {
................................................................................
proc ::cm::contact::+issue {text} {
    debug.cm/contact {}
    upvar 1 issues issues
    lappend issues "- [color bad $text]"
    return
}

proc ::cm::contact::affiliated {contact {mailable {}}} {
    debug.cm/contact {}
    Setup
    if {$mailable eq {}} {
        return [db do eval {
	    SELECT C.id, C.dname
	    FROM   contact     C
	    ,      affiliation A
	    WHERE  A.person  = :contact
	    AND    A.company = C.id
	    ORDER BY C.dname
	}]
    } else {
        return [db do eval {
	    SELECT C.id, C.dname
	    FROM   contact     C
	    ,      affiliation A
	    WHERE  A.person  = :contact
	    AND    A.company = C.id
	    AND    A.mailable == :mailable
	    ORDER BY C.dname
	}]
    }
}

proc ::cm::contact::liaisons {contact} {
    debug.cm/contact {}
    Setup
    return [db do eval {
	SELECT C.id, C.dname
................................................................................
    return [db do onecolumn {
	SELECT biography
	FROM   contact
	WHERE  id = :contact
    }]
}

proc ::cm::contact::add-affiliation {contact affiliation {mailable 0}} {
    debug.cm/contact {}
    Setup

    db do eval {
	INSERT
	INTO affiliation
	VALUES (NULL, :contact, :affiliation, :mailable)
    }
    return
}

proc ::cm::contact::flag-affiliation {contact affiliation mailable} {
    debug.cm/contact {}
    Setup

    db do eval {
	UPDATE affiliation
	SET    mailable = :mailable
	WHERE  person  = :contact
	AND    company = :affiliation
    }
    return
}

proc ::cm::contact::add-liaison {contact liaison} {
    debug.cm/contact {}
    Setup
................................................................................
    }

    if {![dbutil initialize-schema ::cm::db::do error affiliation {
	{
	    -- Relationship between contacts.
	    -- People may be affiliated with an organization, like their employer
	    -- A table is used as a person may be affiliated with several orgs.
	    -- The flag `mailable` allows the person to control which of the
            -- affiliations should be listed in campaign mails.

	    id		INTEGER NOT NULL PRIMARY KEY,
	    person	INTEGER NOT NULL REFERENCES contact,
	    company	INTEGER NOT NULL REFERENCES contact,
	    mailable    INTEGER NOT NULL,
	    UNIQUE (person, company)
	} {
	    {id		INTEGER 1 {} 1}
	    {person	INTEGER 1 {} 0}
	    {company	INTEGER 1 {} 0}
	    {mailable	INTEGER 1 {} 0}
	} {}
    }]} {
	db setup-error affiliation $error
    }

    if {![dbutil initialize-schema ::cm::db::do error liaison {
	{
................................................................................
	cm dump step
    }

    # Step II. Relationships
    # (Affiliations & Liaisons (aka Representatives, Points of Contact))

    db do eval {
	SELECT C.dname AS ncompany
	,      P.dname AS nperson
	,      A.mailable AS mailable
	FROM   affiliation A
	,      contact     C
	,      contact     P
	WHERE  A.company = C.id
	AND    A.person  = P.id
	ORDER BY nperson, ncompany
    } {
	if {$mailable} {
	    cm dump save \
		contact add-affiliate $nperson $ncompany --mailable
	} else {
	    cm dump save \
		contact add-affiliate $nperson $ncompany --no-mailable
	}
    }

    cm dump step

    db do eval {
	SELECT C.dname AS ncompany,
	       P.dname AS nperson