+ Benjamin Brink
OpenACS community
Spreadsheet package for collaboratively building and managing spreadsheets.
- Dekka Corp of Oregon
+ 2014-10-23
Spreadsheet package provides users with some spreadsheet-like functionality, such as ability to perform basic queries on package tables for generating customized reports. Smallest spreadsheet can be 1 by 1.
+ GPLv3
+ https://github.com/tekbasse/spreadsheet/blob/master/README.md
0
+ spreadsheet
-
+
Index: openacs-4/packages/spreadsheet/lib/affiliate-calculations.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/spreadsheet/lib/affiliate-calculations.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/spreadsheet/lib/affiliate-calculations.adp 14 Nov 2014 18:36:34 -0000 1.1
@@ -0,0 +1,111 @@
+According to Kickstarter[1] many of the projects have a slowing period in the middle of the pledge process,
+ where the pledges trickle in. Various reasons have been theorized by some Kickstarter fans,
+but we are not sure why.
+
+
+By adding a bonus reward incentive, we're hoping to eliminate the slower pledge period.
+The easiest way to explain the program is to show an example.
+
+
+Before we can model an incentive program for early backers, we need to make a
+reasonable model that resembles how pledges have been made for projects at Kickstarter.
+
+
+Since reaching the project's pledge goal is the main indicator of pledging success, and we're
+modeling successful projects, we choose the Kickstarter pledging goal as the deciding point for
+the model. When the goal is reached, the model stops making new pledges. With Kickstarter,
+there's a deadline. We're ignoring that time element for now.
+
+After generating a list of pledges and their backers that have reached the goal
+of this pretend scenario, we can compare the distribution
+of pledges for this model's "run" against the historical distribution provided by Kickstarter in their blog:
+
+
+@pdt_html;noquote@
+
+Test Scenario pledge results for @the_time@
+Kickstarter goal: $@ples_amount_target@
+Number of pledges: @ples_count@
+Total pledges made: $@ples_bal@
+
+Basically, we use the computer's linear random number generator to create a number that represents the
+area under the Kickstarter's pledge distribution curve[1] to determine each pledge.
+Since the curve is normalized for total area = 1, we can work backwards along
+the curve to see which pledge contributed that part of the total amount pledged.
+
+
+1. http://www.kickstarter.com/blog/trends-in-pricing-and-duration
+
+
+
+Now that we have a reasonable Kickstarter project pledge scenario,
+let's look at the reward bonus program for early backers.
+
+Affiliate program calculations, assuming a Kickstarter distribution of pledges
+Kickstarter goal: $@ples_amount_target@
+Total amount pledged: @ples_bal@
+Initial pool to be divided up: $@pot@ ie @pct_pooled@% of pledges.
+Number of "quantum" parts: @shares_tot@
+Sum of all bonus rewards: $@bonuses_tot@
+Each "quantum" part is valued at $@share_value@
+Amount of pledges used for bonus program in this run: @pct_of_ples@
+@apt_html;noquote@
+
+
+Notice the difference between the Kickstarter goal and the Total pledges made.
+For this scenario, the project is offering a limited number of reward levels.
+We are adapting the above pledges to fit into this project's reward offerings by
+reducing each pledge to the highest pledge that the project offers with a reward that is less than
+or equal to the pledge. This means that the amount of pledges for the scenario is
+less. Subsequently the number of pledges made had to be higher to reach this project's goal.
+Pragmatically perhaps these results will be a bit pessimistic
+compared to Kickstarter averages, but useful nevertheless.
+
+Now that we have a reasonable Kickstarter project pledge scenario,
+let's look at the reward bonus program for early backers.
+
+Affiliate program calculations using Kickstarter's normalized distribution adapted to this project's rewards
+Kickstarter goal: $@p_ples_amount_target@
+Total amount pledged: @p_ples_bal@
+Initial pool to be divided up: $@p_pot@ ie @p_pct_pooled@% of pledges.
+Number of "quantum" parts: @p_shares_tot@
+Sum of all bonus rewards: $@p_bonuses_tot@
+Each "quantum" part is valued at $@p_share_value@
+Amount of pledges used for bonus program in this run: @p_pct_of_ples@
+@p_apt_html;noquote@
+
+
+A bonus is rewarded in addition to a backer's pledge reward. The "bonus reward"
+refers to a reward as if the backer made another pledge equal to the "pledge reward" value.
+
+In some cases, a duplicate reward doesn't make sense. We'll do
+what we can to provide a substitute of equal or higher value.
+
+
+Here's how the bonus reward program works:
+Early backers get an extra reward for donating early.
+This bonus program uses the amount pooled from the total amount pledged as its high limit. The actual amount used is dependent on the specific data.
+Early backers get more of the pool.
+The actual calculation is a simple, scalable geometric one,
+but we'll save that for another discussion.
+You can see the progression by looking at this example
+scenario.
+
+
+This bonus reward program provides an incentive to pledge early
+without creating extra overhead to manage the bonus distribution
+or causing this bonus reward to be a primary motivation in
+making a pledge.
+
+This bonus is a thank you for being an early adopter,
+and giving us the benefit of any doubt you might have in hesitating to make a pledge.
+If you have any doubt about this project. We want to engage you, and hear about it,
+so we can be sure you're as convinced about this project as we are.
+
+A backer's bonus reward is limited to the amount they pledge.
+If there is some way you somehow pledge two or more times,
+your earliest pledge counts for your position in the progression.
+The total pledge amount is the sum of all your pledges.
+
+Refreshing the page creates a new scenario with different pledges chosen randomly.
+
Index: openacs-4/packages/spreadsheet/lib/affiliate-calculations.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/spreadsheet/lib/affiliate-calculations.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/spreadsheet/lib/affiliate-calculations.tcl 14 Nov 2014 18:36:34 -0000 1.1
@@ -0,0 +1,294 @@
+if { ![info exists ple_max] } {
+ set ple_max 10000.
+}
+if { ![info exists ples_amount_target] } {
+ set ples_amount_target 22222.
+}
+
+set p_ples_amount_target $ples_amount_target
+
+
+if { ![info exists p_rewards_list] } {
+ set p_rewards_list [list 1 10 25 50 100 200 400 800]
+ set project 1
+ # p_* refer to customized, project specific calculations
+}
+# c/pl/pledg/g
+
+if { ![info exists project] } {
+ set project 0
+}
+
+# randmize rand with seed from clock
+ expr { srand([clock clicks]) }
+set pct_pooled 1.
+set p_pct_pooled 2.
+# no need to make a distribution curve, since kickstarter
+# gave us the distribution data, we can create a table
+# using real data.
+
+# kickstarter data (reward amt, contribution of project)
+# rewards must be listed in lowest to highest
+set rewards_list [list 1 5 10 12 15 20 25 29 30 35 40 45 50 55 60 65 70 75 80 99 100 101 125 150 200 250 300 350 500 1000 2000]
+# last reward is a threashold of a range to 100% that gets interpolated up to $ple_max
+
+
+# contribution (as a percentage of total contribution) for each reward level measured
+# These values must be in 1:1 coorespondence with rewards list
+set reward_contribution_pct_list [list 0.53 1.07 2.82 0.15 1.71 3.01 8.14 0.13 2.2 1.31 1.14 0.3 11.44 0.19 0.74 0.31 0.18 2.51 0.22 0.15 16.36 0.2 0.76 2.52 2.81 5.43 1.78 0.59 8.46 8.51 14.33]
+if { [llength $rewards_list] ne [llength $reward_contribution_pct_list] } {
+ ns_log Error "spreadsheet/lib/aff-calcs: (L27) Reward data out of balance."
+ ad_script_abort
+}
+
+# build support arrays
+# r_amt(index) reward/ple tier amounts
+# rcp(index) percent of total contribution to project by ple amount
+# ple_counter(ple) counts the number of times a particular ple is made
+# area(index) is the area under the distribution curve to the left of the ple amt
+# area_list is the area(array) expressed as an ordered list
+# total_pct addus p all the rcp amounts to confirm it is 100%
+# count_max is the number of reward/ple tiers
+set area(-1) 0
+set count 0
+set area_list [list]
+set total_pct 0
+foreach reward $rewards_list {
+ set r_amt($count) $reward
+ set rcp($count) [lindex $reward_contribution_pct_list $count]
+ set ple_counter([lindex $rewards_list $count]) 0
+ set area($count) [expr $area([expr { $count -1} ]) + $rcp($count)]
+ set total_pct [expr { $total_pct + $rcp($count) } ]
+ lappend area_list $area($count)
+ set count_max $count
+ incr count
+}
+# add one more for max possible ple to the right of distribution curve
+set area($count) $ple_max
+
+# repeat for project set p_
+set p_count 0
+foreach p_reward $p_rewards_list {
+ set p_r_amt($p_count) $p_reward
+ set p_ple_counter([lindex $p_rewards_list $p_count]) 0
+ incr p_count
+}
+set p_count_max [expr { [llength $p_rewards_list] + 1 } ]
+
+# initial project conditions
+set ples_bal 0.
+set ples_count 0
+set p_ples_bal 0.
+set p_ples_count 0
+# every case assumes to reach target
+# projects require more pledges, because the pledge amounts are adjusted to lower reward tier
+
+while { ($project == 1 && $p_ples_bal < $p_ples_amount_target ) || ( $project == 0 && $ples_bal < $ples_amount_target) } {
+
+ set ple_seed [expr { [random ] * 100.) } ]
+ set count 0
+ # We have area under curve, let's find interval ie. ple
+ while { $ple_seed > $area($count) } {
+ incr count
+ }
+
+ if { $count == $count_max } {
+ # the last tier is reported as a range (2000+)
+ # interpolate a donation distribution
+ # slope = Dy/Dx
+# ns_log Notice "spreadsheet/lib/aff-calcs: ple_max $ple_max r_amt(count) $r_amt($count) rcp(count) $rcp($count)"
+ set count_1 [expr { $count - 1 } ]
+ set slope [expr { ($ple_max - $r_amt($count)) / $rcp($count) }]
+ set x_relative [expr { $ple_seed - $area($count_1) } ]
+# we add sqrt of dx in next step to help bias values to lower amounts.
+ set reward [expr { $slope * sqrt( $x_relative) + $r_amt($count) } ]
+ # clip to nearest cent.
+# set reward [expr { int( 100. * ( $reward)) / 100. } ]
+ # clip to dollar amount, like all the other ple/reward tiers
+ set reward [expr { int( $reward) } ]
+ if { $reward < $r_amt($count) || $reward > $ple_max } {
+ ns_log Warning "spreadsheet/lib/aff-calcs: reward $reward slope $slope x_relative $x_relative"
+ ns_log Error "spreadsheet/lib/aff-calcs: error, interpolated reward is out of range"
+ ad_script_abort
+ }
+ } else {
+ set reward $r_amt($count)
+ }
+ # now that we have the reward value, let's match it against the p_rewards_list
+ set p_reward 0
+ set p_rew_counter 0
+ foreach test_reward $p_rewards_list {
+ if { $test_reward <= $reward } {
+ set p_reward_index $p_rew_counter
+ set p_reward [lindex $p_rewards_list $p_reward_index]
+ }
+ incr p_rew_counter
+ }
+
+ # set the remaining items in the lop
+ incr p_ple_counter($p_r_amt($p_reward_index))
+ incr p_ples_count
+ incr ple_counter($r_amt($count))
+ incr ples_count
+ set ple_amt($ples_count) $reward
+ set p_ple_amt($p_ples_count) $p_reward
+ set ples_bal [expr { $ples_bal + $reward } ]
+ set p_ples_bal [expr { $p_ples_bal + $p_reward } ]
+ ns_log Notice "spreadsheet/lib/aff-calcs: count ${ples_count} ples_bal ${ples_bal} p_ples_bal ${p_ples_bal}"
+# ns_log Notice "spreadsheet/lib/aff-calcs: count: ${ples_count} area: $area($count) reward: [format "% 8.2f" $reward] pled: [format "% 8.2f" ${ples_bal}]"
+
+}
+
+#ns_log Notice "spreadsheet/lib/aff-calcs: reward count historical"
+# make a probability distribution table
+set pdt_html "Probability distribution for this run
\n"
+set p_pdt_html "Probability distribution for this run
\n"
+append pdt_html "| Pledge | Count | Base line |
\n"
+append p_pdt_html "| Pledge | Count | Base line |
\n"
+set count 0
+set p_count 0
+set reward_max [lindex $rewards_list $count_max]
+set p_reward_max [lindex $p_rewards_list $p_count_max]
+foreach reward_nbr $rewards_list {
+ if { $reward_nbr == $reward_max } {
+ set reward "${reward_max}+"
+ } else {
+ set reward $reward_nbr
+ }
+ append pdt_html "| $ [util_commify_number $reward] | [format "% 3.2f" [expr { 100. * $ple_counter($reward_nbr) / $ples_count } ]]% | $rcp($count)% |
\n"
+ incr count
+}
+foreach p_reward_nbr $p_rewards_list {
+ set p_reward $reward_nbr
+ append p_pdt_html "| $ [util_commify_number ${p_reward}] | [format "% 3.2f" [expr { 100. * $p_ple_counter($p_reward_nbr) / ${p_ples_count} } ]]% |
\n"
+ incr count
+}
+
+append pdt_html "
\n"
+
+#Total ples this run: $ples_count
"
+
+
+# Now we can play with the affiliate program numbers
+#ns_log Notice "spreadsheet/lib/aff-calcs: Affiliate modeling calculations"
+#ns_log Notice "spreadsheet/lib/aff-calcs: ples_count $ples_count"
+#ns_log Notice "spreadsheet/lib/aff-calcs: ples_bal $ples_bal"
+
+# ples_count
+# ples_bal
+# ple_amt()
+# pot (F3)
+set pot [expr $ples_bal * $pct_pooled / 100. ]
+set p_pot [expr $p_ples_bal * $p_pct_pooled / 100. ]
+#ns_log Notice "spreadsheet/lib/aff-calcs: pot $pot"
+
+set shares_tot 0
+set p_shares_tot 0
+set b_nbr_rev 1
+set p_b_nbr_rev 1
+# each donor gets share of own donation and all donations that follow.
+for { set b_nbr $ples_count } { $b_nbr > 0 } { incr b_nbr -1 } {
+#b_ = backer
+#ns_log Notice "spreadsheet/lib/aff-calcs: b_nbr $b_nbr"
+#ns_log Notice "spreadsheet/lib/aff-calcs: b_nbr_rev $b_nbr_rev"
+# b_nbr (N)
+# b_shares (M)
+ set shares_b($b_nbr) [expr { int( ( $b_nbr_rev + pow( $b_nbr_rev , 2 ) ) / 2. ) } ]
+ set shares_tot [expr { $shares_tot + $shares_b($b_nbr) } ]
+ incr b_nbr_rev
+}
+for { set p_b_nbr $p_ples_count } { $p_b_nbr > 0 } { incr p_b_nbr -1 } {
+#b_ = backer
+#ns_log Notice "spreadsheet/lib/aff-calcs: b_nbr $b_nbr"
+#ns_log Notice "spreadsheet/lib/aff-calcs: b_nbr_rev $b_nbr_rev"
+# b_nbr (N)
+# b_shares (M)
+ set p_shares_b($p_b_nbr) [expr { int( ( $p_b_nbr_rev + pow( $p_b_nbr_rev , 2 ) ) / 2. ) } ]
+ set p_shares_tot [expr { $p_shares_tot + $p_shares_b($p_b_nbr) } ]
+ incr p_b_nbr_rev
+}
+
+
+# shares_tot
+#ns_log Notice "spreadsheet/lib/aff-calcs: shares_tot $shares_tot"
+set share_value [expr { $pot / $shares_tot } ]
+set p_share_value [expr { $p_pot / $p_shares_tot } ]
+# share_value
+set shares_tot [expr { int( $shares_tot ) } ]
+set p_shares_tot [expr { int( $p_shares_tot ) } ]
+
+#ns_log Notice "spreadsheet/lib/aff-calcs: share_value $share_value"
+
+# now we can make a table with affiliate calculations
+set apt_html "Affiliate data and calculations
\n"
+set p_apt_html "Affiliate data and calculations
\n"
+append apt_html "| Backer number | Pledge | Number of parts | Bonus reward |
\n"
+append p_apt_html "| Backer number | Pledge | Number of parts | Bonus reward |
\n"
+set bonuses_tot 0.
+
+for { set b_nbr 1 } { $b_nbr <= $ples_count } { incr b_nbr 1 } {
+ set b_limit($b_nbr) $ple_amt($b_nbr)
+ set b_bonus_pot [expr { int( $share_value * $shares_b($b_nbr) * 100. ) / 100. } ]
+# set b_bonus_pot [format "% 8.2f" $b_bonus_pot]
+ # limit bonus reward to the amount of the ple
+ if { $b_limit($b_nbr) < $b_bonus_pot } {
+ set b_bonus($b_nbr) $b_limit($b_nbr)
+# backer limit exceeded
+# ns_log Notice "spreadsheet/lib/aff-calcs: b_nbr $b_nbr shares_b $shares_b($b_nbr) ple() $b_limit($b_nbr) b_bonus() $b_bonus($b_nbr)*"
+ } else {
+ # set b_bonus($b_nbr) equal to the reward just under $b_bonus_pot
+ set bonus_i_max [llength $rewards_list]
+ set bonus_index 0
+ set b_bonus($b_nbr) 0
+ while { ( $b_bonus_pot > [lindex $rewards_list $bonus_index] ) && ( $bonus_index <= $bonus_i_max ) } {
+ set b_bonus($b_nbr) [lindex $rewards_list $bonus_index]
+ incr bonus_index
+ }
+# ns_log Notice "spreadsheet/lib/aff-calcs: b_nbr $b_nbr shares_b $shares_b($b_nbr) ple() $b_limit($b_nbr) b_bonus() $b_bonus($b_nbr) b_pot $b_bonus_pot"
+ }
+ append apt_html "| $b_nbr | $ [util_commify_number $ple_amt($b_nbr)] | [util_commify_number $shares_b($b_nbr)] | $ [format "%0.0f" $b_bonus($b_nbr)] |
\n"
+ set bonuses_tot [expr { $bonuses_tot + $b_bonus($b_nbr) } ]
+}
+set p_bonuses_tot 0.
+for { set p_b_nbr 1 } { $p_b_nbr <= $p_ples_count } { incr p_b_nbr 1 } {
+ set p_b_limit($p_b_nbr) $p_ple_amt($p_b_nbr)
+ set p_b_bonus_pot [expr { int( $p_share_value * $p_shares_b($p_b_nbr) * 100. ) / 100. } ]
+ # limit bonus reward to the amount of the ple
+ if { $p_b_limit($p_b_nbr) < $p_b_bonus_pot } {
+# backer limit exceeded, setting bonus the same as pledge
+ set p_b_bonus($p_b_nbr) $p_b_limit($p_b_nbr)
+ } else {
+ # set b_bonus($b_nbr) equal to the reward just under $b_bonus_pot
+ set p_b_bonus($p_b_nbr) 0
+ foreach bonus $p_rewards_list {
+ if { $bonus <= $p_b_bonus_pot } {
+ set p_b_bonus($p_b_nbr) $bonus
+ }
+ }
+ }
+ append p_apt_html "| ${p_b_nbr} | $ [util_commify_number $p_ple_amt($p_b_nbr)] | [util_commify_number $p_shares_b($p_b_nbr)] | $ [format "%0.0f" $p_b_bonus($p_b_nbr)] |
\n"
+ set p_bonuses_tot [expr { $p_bonuses_tot + $p_b_bonus($p_b_nbr) } ]
+}
+
+append apt_html "
"
+append p_apt_html "
"
+# bonuses_tot s/b less than $pot
+if { $bonuses_tot > $pot } {
+ ns_log Error "spreadsheet/lib/aff-calcs: Error: bonuses awarded $bonuses_tot is more than pot $pot"
+}
+set pct_of_ples "% [format "% 8.2f" [expr { ${bonuses_tot} / ${ples_bal} * 100. } ] ] "
+set p_pct_of_ples "% [format "% 8.2f" [expr { ${p_bonuses_tot} / ${p_ples_bal} * 100. } ] ] "
+#ns_log Notice "spreadsheet/lib/aff-calcs: bonuses_tot $bonuses_tot pct_of_ples $pct_of_ples"
+# make pretty
+set bonuses_tot [util_commify_number [format "%0.2f" $bonuses_tot]]
+set pot [util_commify_number [format "%0.2f" $pot]]
+set ples_bal [util_commify_number [format "%0.2f" $ples_bal]]
+set ples_amount_target [util_commify_number [format "%0.2f" $ples_amount_target]]
+set shares_tot [util_commify_number [format "%0.0f" $shares_tot]]
+set the_time [clock format [clock seconds] -format "%Y %b %d %H:%M:%S"]
+
+set p_bonuses_tot [util_commify_number [format "%0.2f" $p_bonuses_tot]]
+set p_pot [util_commify_number [format "%0.2f" $p_pot]]
+set p_ples_bal [util_commify_number [format "%0.2f" $p_ples_bal]]
+set p_ples_amount_target [util_commify_number [format "%0.2f" $p_ples_amount_target]]
+set p_shares_tot [util_commify_number [format "%0.0f" $p_shares_tot]]
Index: openacs-4/packages/spreadsheet/tcl/simple-table-extras-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/spreadsheet/tcl/simple-table-extras-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/spreadsheet/tcl/simple-table-extras-procs.tcl 14 Nov 2014 18:36:34 -0000 1.1
@@ -0,0 +1,127 @@
+ad_library {
+
+ API extras for qss_simple_table
+ @creation-date 26 May 2014
+ @cs-id $Id:
+}
+
+ad_proc -public qss_tables_are_equiv_p {
+ table_1_lists
+ table_2_lists
+} {
+ Returns 1 if columns and data between tables are equivalent, but maybe differ in column order. Otherwise returns 0.
+} {
+ if { $table_1_lists eq $table_2_lists } {
+ set equiv_p 1
+ } else {
+ set equiv_p 0
+ set titles_1_list [lsort [lindex $table_1_lists 0]]
+ set titles_2_list [lsort [lindex $table_2_lists 0]]
+ if { $titles_1_list eq $titles_2_list } {
+ # check row data in order, column by column
+ set table_1_rows [llength $table_1_lists]
+ set table_2_rows [llength $table_2_lists]
+ set equiv_p [expr { $table_1_rows == $table_2_rows } ]
+ set col_idx 0
+ set col_count [llength $titles_1_list]
+ set column [lindex $titles_1_list $col_idx]
+ while { $equiv_p == 1 && $col_idx < $col_count } {
+ set t1_idx [lsearch -exact $table_1_lists $column]
+ set t2_idx [lsearch -exact $table_2_lists $column]
+ set row_num 1
+ while { $equiv_p == 1 && $row_num < $table_1_rows } {
+ set t1_val [lindex [lindex $table_1_lists $row_num] $t1_idx]
+ set t2_val [lindex [lindex $table_2_lists $row_num] $t2_idx]
+ set equiv_p [expr { ( $t1_val eq $t2_val ) } ]
+ incr row_num
+ }
+ incr col_idx
+ set column [lindex $titles_1_list $col_idx]
+ }
+ }
+ }
+ return $equiv_p
+}
+
+ad_proc -public qss_table_split {
+ table_id
+ column_name
+ {instance_id ""}
+ {user_id ""}
+} {
+ Splits a simple table by creating new tables whenever value in column_name changes. Table names are given the name of the original table with the value of the column appended (with a dash separator). Returns a list of the new table_ids, or empty list if no tables created.
+} {
+
+#code. Be sure to check permissions
+
+ if { $instance_id eq "" } {
+ # set instance_id package_id
+ set instance_id [ad_conn package_id]
+ }
+ if { $user_id eq "" } {
+ set user_id [ad_conn user_id]
+ set untrusted_user_id [ad_conn untrusted_user_id]
+ }
+ set create_p [permission::permission_p -party_id $user_id -object_id $instance_id -privilege create]
+ if { $create_p & $column_name ne "" } {
+ # read table_tid
+ set table_stats_list [qss_table_stats $table_id $instance_id $user_id]
+ # name, title, comments, cell_count, row_count, template_id, flags, trashed, popularity, time last_modified, time created, user_id.
+ set table_base_name [lindex $table_stats_list 0]
+ set table_title [lindex $table_stats_list 1]
+ set table_template_id [lindex $table_stats_list 5]
+ set table_flags [lindex $table_stats_list 6]
+ set table_comments "Split from '${table_title}' (${table_base_name})"
+ set table_lists [qss_table_read $table_id $instance_id $user_id ]
+ # identify column_name_idx
+ set title_row [lindex $table_lists 0]
+ # if column_name_idx exists, loop through all rows
+ set column_name_idx [lsearch -exact $title_row $column_name]
+ if { $column_name_idx > -1 } {
+ set row_list [lindex $table_lists 1]
+ set col_val_prev [lindex $row_list $column_name_idx]
+ set p_table_lists [list ]
+ lappend p_table_lists $title_row
+ lappend p_table_lists $row_list
+ set title $table_title
+ set name $table_base_name
+ set suffix "-"
+ append suffix $col_val_prev
+ append name $suffix
+ append title $suffix
+ set comments $table_comments
+ append comments " @ ${column_name}: ${col_val_prev}"
+ foreach row_list [lrange $table_lists 2 end] {
+ set col_val [lindex $row_list $column_name_idx]
+ if { $col_val ne $col_val_prev } {
+ # if value changes, create save table_name old_column_value, start collecting new
+ set table_id [qss_table_create $p_table_lists $name $title $comments $table_template_id $table_flags $instance_id $user_id]
+ ns_log Notice "qss_table_split.59: new table_id $table_id"
+ set p_table_lists [list ]
+ lappend p_table_lists $title_row
+ lappend p_table_lists $row_list
+ set title $table_title
+ set name $table_base_name
+ set suffix "-"
+ append suffix $col_val
+ append name $suffix
+ append title $suffix
+ set comments $table_comments
+ append comments " @ ${column_name}: ${col_val}"
+ } else {
+ # add row to existing partial table
+ lappend p_table_lists $row_list
+
+ }
+ set col_val_prev $col_val
+ }
+ if { [llength $p_table_lists] > 1 } {
+ # save final split
+ set table_id [qss_table_create $p_table_lists $name $title $comments $table_template_id $table_flags $instance_id $user_id]
+ ns_log Notice "qss_table_split.76: new table_id $table_id"
+ }
+ }
+ }
+}
+
+
Index: openacs-4/packages/spreadsheet/tcl/simple-table-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/spreadsheet/tcl/simple-table-procs.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/spreadsheet/tcl/simple-table-procs.tcl 15 Jun 2012 22:18:39 -0000 1.1
+++ openacs-4/packages/spreadsheet/tcl/simple-table-procs.tcl 14 Nov 2014 18:36:34 -0000 1.2
@@ -5,6 +5,212 @@
@cs-id $Id:
}
+ad_proc -public qss_tid_from_name {
+ table_name
+ {instance_id ""}
+ {user_id ""}
+} {
+ Returns the table_id (tid) of the most recent table_id of table name. If the table name contains a search glob, returns the newest tid of the name matching the glob.
+} {
+ if { $instance_id eq "" } {
+ # set instance_id package_id
+ ns_log Notice "qss_tid_from_name.17: no instance_id supplied."
+ set instance_id [ad_conn package_id]
+ }
+ if { $user_id eq "" } {
+ ns_log Notice "qss_tid_from_name.21: no user_id supplied."
+ set user_id [ad_conn user_id]
+ set untrusted_user_id [ad_conn untrusted_user_id]
+ }
+ # check permissions
+ set read_p [permission::permission_p -party_id $user_id -object_id $instance_id -privilege read]
+ set return_tid ""
+
+ if { $read_p } {
+ if { [regexp -- {[\?\*]} $table_name ] } {
+ regsub -nocase -all -- {[^a-z0-9_\?\*]} $table_name {_} table_name
+
+ set return_list_of_lists [db_list_of_lists simple_table_stats_sby_lm_1 { select id, name, last_modified from qss_simple_table where ( trashed is null or trashed = '0' ) and instance_id = :instance_id order by last_modified} ]
+ # create a list of names
+ #ns_log Notice "qss_tid_from_name.33: table_name '$table_name' return_list_of_lists $return_list_of_lists"
+ set names_list [list ]
+ foreach lol $return_list_of_lists {
+ lappend names_list [lindex $lol 1]
+ }
+ # find most recent matching name
+ set tid_idx [lsearch -nocase $return_list $table_name]
+ #ns_log Notice "qss_tid_from_name.40: tid_idx $tid_idx"
+ if { [llength $tid_idx_list ] > 0 } {
+ # set idx to first matching.
+ set return_tid [lindex [lindex $return_list_of_lists $tid_idx] 0]
+ }
+ } else {
+ # no glob in table_name
+ set return_tid [db_string simple_table_stats_tid_read { select id, last_modified from qss_simple_table where name =:table_name and ( trashed is null or trashed = '0' ) and instance_id = :instance_id order by last_modified desc limit 1 } -default "" ]
+ #ns_log Notice "qss_tid_from_name.48: table_name '$table_name' return_tid '$return_tid'"
+ }
+ }
+ return $return_tid
+}
+
+
+ad_proc -public qss_tid_scalars_to_array {
+ table_id
+ array_name
+ {scalars_unfiltered ""}
+ {scalars_required ""}
+ {instance_id ""}
+ {user_id ""}
+} {
+ Saves scalars in a 2 column table to an array array_name,
+ where array indexes are the scalars in the 'name' column, and
+ the value for each scalar is same row in 'value' column.
+ table_id is a reference to a qss_simple table.
+ Also, returns the name/value pairs in a list.
+ If scalars_required are not included,
+ includes these indexes and sets values to empty string.
+} {
+ upvar $array_name tid_arr
+
+ if { $scalars_unfiltered ne "" && [llength $scalars_unfiltered] == 1 } {
+ set scalars_unfiltered [split $scalars_unfiltered]
+ }
+ if { $scalars_required ne "" && [llength $scalars_required] == 1 } {
+ set scalars_required [split $scalars_required]
+ }
+ set names_values_list [list ]
+ # load table_id
+ set tid_lists [qss_table_read $table_id $instance_id $user_id]
+ # extract each name-value pair, saving into array
+ set titles_list [lindex $tid_lists 0]
+ set index 0
+ foreach title $titles_list {
+ if { [regexp -nocase -- {name[s]?} $title] } {
+ set name_idx $index
+ }
+ if { [regexp -nocase -- {value[s]?} $title] } {
+ set value_idx $index
+ }
+ incr index
+ }
+ if { [info exists value_idx] && [info exists name_idx] } {
+ foreach row_list [lrange $tid_lists 1 end] {
+ set name [lindex $row_list $name_idx]
+ set value [lindex $row_list $value_idx]
+ regsub -nocase -all -- {[^a-z0-9_]+} $name {_} name
+ set scalar_idx [lsearch $scalars_unfiltered $name]
+ if { $name ne "" && $scalar_idx > -1 } {
+ lappend names_values_list $name $value
+ set scalars_unfiltered [lreplace $scalars_unfiltered $scalar_idx $scalar_idx]
+ set scalar_idx [lsearch $scalars_required $name]
+ if { $scalar_idx > -1 } {
+ set scalars_required [lreplace $scalars_required $scalar_idx $scalar_idx]
+ }
+ set tid_arr($name) $value
+ }
+ }
+ # create blank defaults for missing, required name/value pairs.
+ foreach scalar $scalars_required {
+ set tid_arr($scalar) ""
+ lappend names_values_list $scalar ""
+ }
+ }
+ return $names_values_list
+}
+
+ad_proc -public qss_tid_columns_to_array_of_lists {
+ table_id
+ array_name
+ {columns_unfiltered ""}
+ {columns_required ""}
+ {instance_id ""}
+ {user_id ""}
+} {
+ Saves columns in lists where the first row of each column is a row_name;
+ row_name is an index in the passed array.
+ row_name is in the list columns_unfiltered.
+ Elements of list are the ordered set from same column in subsequent rows.
+ table_id is a reference to a qss_simple table.
+ If row_names don't exist for all elements of columns_required,
+ no values are saved to array_name.
+} {
+ upvar $array_name tid_arr
+ if { $columns_unfiltered ne "" && [llength $columns_unfiltered] == 1 } {
+ set columns_unfiltered_list [split $columns_unfiltered]
+ } else {
+ set columns_unfiltered_list $columns_unfiltered
+ }
+ if { $columns_required ne "" && [llength $columns_required] == 1 } {
+ set columns_required_list [split $columns_required]
+ } else {
+ set columns_required_list $columns_required
+ }
+ set success 0
+ # load table_id
+ set tid_lists [qss_table_read $table_id $instance_id $user_id]
+ # extract each column name
+ set titles_orig_list [lindex $tid_lists 0]
+ # filter column names
+ set titles_list [list ]
+ foreach title $titles_orig_list {
+ # Get values of column, one column at a time
+ if { ![regsub -nocase -all -- {[^a-z0-9_]+} $title {_} title2 ] } {
+ # assign title2 if regsub doesn't assign it
+ set title2 $title
+ }
+ lappend titles_list $title2
+ set column_idx [lsearch $columns_required_list $title2]
+ if { $column_idx > -1 } {
+ # required column found, remove from list
+ set columns_required_list [lreplace $columns_required_list $column_idx $column_idx]
+ }
+ }
+ ns_log Notice "qss_tid_columns_to_array_of_lists.166: titles_list '$titles_list'"
+ if { [llength $columns_required_list ] == 0 } {
+ # all required columns exist, if any
+
+ # convert tid_lists to list arrays (larr)
+ # columns_unfiltered ne "" ?
+ if { $columns_unfiltered ne "" } {
+ # only return list of specified columns
+
+ foreach title $titles_list {
+ set column_idx [lsearch -exact $titles_orig_list $title]
+ if { $column_idx > -1 } {
+ set arr_list [list ]
+ foreach row_list [lrange $tid_lists 1 end] {
+ lappend arr_list [lindex $row_list $column_idx]
+ }
+ set tid_arr($title) $arr_list
+ ns_log Notice "qss_tid_columns_to_array_of_lists.182: tid_arr($title) '$tid_arr($title)'"
+ }
+ }
+
+ } else {
+ # return all columns with unblank titles
+
+ foreach title $titles_list {
+ if { $title ne "" } {
+ set column_idx [lsearch -exact $titles_orig_list $title]
+ set arr_list [list ]
+ foreach row_list [lrange $tid_lists 1 end] {
+ lappend arr_list [lindex $row_list $column_idx]
+ }
+ set tid_arr($title) $arr_list
+ ns_log Notice "qss_tid_columns_to_array_of_lists.197: tid_arr($title) '$tid_arr($title)'"
+ }
+ }
+
+ }
+ set success 1
+ } else {
+ set success 0
+ ns_log Notice "qss_tid_columns_to_array_of_lists.206: not all columns_required_list '${columns_required_list}' exist in table_id '${table_id}'"
+ }
+ return $success
+}
+
+
ad_proc -public qss_table_create {
cells_list_of_lists
name
@@ -64,10 +270,11 @@
if { $template_id eq "" } {
set template_id $table_id
}
+ set nowts [dt_systime -gmt 1]
db_transaction {
db_dml simple_table_create { insert into qss_simple_table
- (id,template_id,name,title,comments,instance_id,user_id)
- values (:table_id,:template_id,:name,:title,:comments,:instance_id,:user_id) }
+ (id,template_id,name,title,comments,instance_id,user_id,flags,last_modified,created)
+ values (:table_id,:template_id,:name,:title,:comments,:instance_id,:user_id,:flags,:nowts,:nowts) }
set row 0
set cells 0
foreach row_list $cells_list_of_lists {
@@ -89,7 +296,7 @@
}
ns_log Notice "qss_table_create: total $row rows, $cells cells"
db_dml simple_table_update_rc { update qss_simple_table
- set row_count =:row,cell_count =:cells
+ set row_count =:row,cell_count =:cells, last_modified=:nowts
where id = :table_id }
} on_error {
@@ -127,7 +334,9 @@
set return_list_of_lists [db_list_of_lists simple_table_stats { select name, title, comments, cell_count, row_count, template_id, flags, trashed, popularity, last_modified, created, user_id from qss_simple_table where id = :table_id and instance_id = :instance_id } ]
# convert return_lists_of_lists to return_list
set return_list [lindex $return_list_of_lists 0]
-
+ if { [lindex $return_list 7 ] eq "" } {
+ set return_list [lreplace $return_list 7 7 "0"]
+ }
} else {
set return_list [list ]
}
@@ -188,9 +397,11 @@
} {
if { $instance_id eq "" } {
# set instance_id package_id
+ ns_log Notice "qss_table_read.398: no instance_id supplied."
set instance_id [ad_conn package_id]
}
if { $user_id eq "" } {
+ ns_log Notice "qss_table_read.402: no user_id supplied."
set user_id [ad_conn user_id]
set untrusted_user_id [ad_conn untrusted_user_id]
}
@@ -200,35 +411,78 @@
set cells_data_lists [db_list_of_lists qss_simple_cells_table_read { select cell_rc, cell_value from qss_simple_cells
where table_id =:table_id order by cell_rc } ]
-
- set prev_row "0001"
- set row_list [list ]
+ set cells2_data_lists [list ]
+ set col_ref_list [list ]
+ # filter row, column references
foreach cell_list $cells_data_lists {
set cell_rc [lindex $cell_list 0]
set cell_value [lindex $cell_list 1]
# following based on "0000" format used in create/write cell_rc r0001c0001
set row [string range $cell_rc 1 4]
+ regsub {^[0]+} $row {} row
set column [string range $cell_rc 6 9]
+ regsub {^[0]+} $column {} column
+ set row_list [list $row $column $cell_value]
+ lappend cells2_data_lists $row_list
+ lappend col_ref_list $column
+ }
+ # determine max referenced column
+ set column_max [f::lmax $col_ref_list]
+
+ set prev_row 1
+ set row_list [list ]
+ foreach cell_list $cells2_data_lists {
+ set row [lindex $cell_list 0]
+ set column [lindex $cell_list 1]
+ set cell_value [lindex $cell_list 2]
# ns_log Notice "qss_table_read: cell ${cell_rc} ($row,$column) value ${cell_value}"
+
# build row list
if { $row eq $prev_row } {
- # add cell to same row
+ # add cell to same row. column_next is column to fill as represented by cell column number 1...n
set column_next [expr { [llength $row_list ] + 1 } ]
set cols_to_add [expr { $column - $column_next } ]
+
# add blank cells, if needed
- for {set i 1} {$i < $cols_to_add} {incr i } {
+ for {set i 0} {$i < $cols_to_add} {incr i } {
lappend row_list ""
}
lappend row_list $cell_value
} else {
+ # check for any blank orphan cells to add
+ set column_next [expr { [llength $row_list ] + 1 } ]
+ set cols_to_add [expr { $column_max - $column_next + 1 } ]
+
+ # add blank cells, if needed
+ for {set i 0} {$i < $cols_to_add} {incr i } {
+ lappend row_list ""
+ }
+
# row finished, add row_list to cells_list_of_lists
lappend cells_list_of_lists $row_list
+
# start new row
- set row_list [list $cell_value]
+ set row_list [list ]
+ set column_next [expr { [llength $row_list ] + 1 } ]
+ set cols_to_add [expr { $column - $column_next } ]
+
+ # add blank cells, if needed
+ for {set i 0} {$i < $cols_to_add} {incr i } {
+ lappend row_list ""
+ }
+ lappend row_list $cell_value
}
set prev_row $row
}
+
+ # check for any blank orphan cells at end of row that need adding
+ set column_next [expr { [llength $row_list ] + 1 } ]
+ set cols_to_add [expr { $column_max - $column_next + 1 } ]
+ # add blank cells, if needed
+ for {set i 0} {$i < $cols_to_add} {incr i } {
+ lappend row_list ""
+ }
lappend cells_list_of_lists $row_list
}
return $cells_list_of_lists
@@ -259,10 +513,10 @@
if { $write_p } {
set table_exists_p [db_0or1row simple_table_get_id {select user_id as creator_id from qss_simple_table where id = :table_id } ]
if { $table_exists_p } {
-
+ set nowts [dt_systime -gmt 1]
db_transaction {
db_dml simple_table_update { update qss_simple_table
- set name =:name,title =:title,comments=:comments
+ set name =:name,title =:title,comments=:comments, flags=:flags, last_modified=:nowts
where id = :table_id and instance_id=:instance_id and user_id=:user_id }
# get list of cell_rc referencs in this table. We need to track updates, and delete any remaining ones.
@@ -296,8 +550,9 @@
}
}
}
+ set nowts [dt_systime -gmt 1]
db_dml simple_table_update_rc { update qss_simple_table
- set row_count =:row,cell_count =:cells
+ set row_count =:row,cell_count =:cells, last_modified=:nowts
where id = :table_id }
# delete remaining cells in cells_list from qss_simple_cells
@@ -376,16 +631,31 @@
set user_id [ad_conn user_id]
set untrusted_user_id [ad_conn untrusted_user_id]
}
- set delete_p [permission::permission_p -party_id $user_id -object_id $instance_id -privilege delete]
- if { $delete_p } {
+
+ set write_p [permission::permission_p -party_id $user_id -object_id $instance_id -privilege write]
+ set allowed_p $write_p
+ if { $write_p } {
if { $trash_p } {
- db_dml simple_table_trash_tog { update qss_simple_table set trashed = '1'
- where id=:table_id and instance_id =:instance_id and user_id=:user_id }
+ db_dml simple_table_trash_togc { update qss_simple_table set trashed = '1'
+ where id=:table_id and instance_id =:instance_id }
} else {
- db_dml simple_table_trash_tog { update qss_simple_table set trashed = '0'
- where id=:table_id and instance_id =:instance_id and user_id=:user_id }
+ db_dml simple_table_trash_togc { update qss_simple_table set trashed = '0'
+ where id=:table_id and instance_id =:instance_id }
}
+ } else {
+ set create_p [permission::permission_p -party_id $user_id -object_id $instance_id -privilege create]
+ set allowed_p $create_p
+ if { $create_p } {
+ if { $trash_p } {
+ db_dml simple_table_trash_togw { update qss_simple_table set trashed = '1'
+ where id=:table_id and instance_id =:instance_id and user_id=:user_id }
+ } else {
+ db_dml simple_table_trash_togw { update qss_simple_table set trashed = '0'
+ where id=:table_id and instance_id =:instance_id and user_id=:user_id }
+ }
+ }
}
- return $delete_p
+ return $allowed_p
}
+
Index: openacs-4/packages/spreadsheet/tcl/spreadsheet-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/spreadsheet/tcl/spreadsheet-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/spreadsheet/tcl/spreadsheet-procs.tcl 6 Sep 2010 11:00:17 -0000 1.4
+++ openacs-4/packages/spreadsheet/tcl/spreadsheet-procs.tcl 14 Nov 2014 18:36:34 -0000 1.5
@@ -1,185 +1,424 @@
ad_library {
- routines for accessing and managing spreadsheets
+ API for spreadsheets package
+ @author (c) Benjamin Brink
@creation-date 25 August 2010
+ @license: See spreadsheet/LICENSE.html
@cs-id $Id:
}
# orientation defaults to RC (row column reference and format, where rows within a column are the same data type)
# for CR orientation, switch the references so a column ref is a row reference and a row ref is a column ref.
-# this could get confusing... All internal should orient at RC. if CR orientation, just display by switching axis
+# this could get confusing...
+# All internal should orient at RC to handle column titles.
+# If CR orientation, just display by switching axis
# user input would then be converted before passing to procs.
+# CREATE TABLE qss_sheets (
+# id integer not null primary key,
+# template_id integer,
+# instance_id integer,
+# user_id integer,
+# flags varchar(12), (basic type:/setlist/sheet) where list is 1 row of named columns, set is 1 column of data
+# name varchar(40),
+# style_ref varchar(300),
+# title varchar(80),
+# description text,
+# orientation varchar(2) default 'RC',
+# row_count integer,
+# cell_count integer,
+# trashed varchar(1) default '0',
+# popularity integer,
+# last_calculated timestamptz,
+# last_modified timestamptz,
+# last_modified_by integer,
+# status varchar(8)
+# );
+# CREATE TABLE qss_cells (
+# id integer not null primary key,
+# sheet_id integer not null,
+# cell_row integer not null,
+# cell_column integer not null,
+# cell_name varchar(40),
+# cell_value varchar(1025),
+# cell_type varchar(8),
+# cell_format varchar(80),
+# cell_proc varchar(1025),
+# cell_calc_depth integer not null default '0',
+# cell_title varchar(80),
+# last_calculated timestamptz,
+# last_modified timestamptz,
+# last_modified_by integer
+# );
+
namespace eval spreadsheet {}
-ad_proc -public spreadsheet::new_id {
+# compare with simple-table-procs.tcl:qss_tid_from_name
+ad_proc -public spreadsheet::id_from_name {
+ sheet_name
+ {instance_id ""}
+ {user_id ""}
} {
- gets new spreadsheet id
+ Returns the sheet_id (sid) of the most recent sheet_id of sheet name. If the sheet name contains a search glob, returns the newest id of the name matching the glob.
} {
- set spreadsheet_id [db_nextval qss_id_seq]
- return $spreadsheet_id
-}
+ if { $instance_id eq "" } {
+ # set instance_id package_id
+ set instance_id [ad_conn package_id]
+ }
+ if { $user_id eq "" } {
+ set user_id [ad_conn user_id]
+ set untrusted_user_id [ad_conn untrusted_user_id]
+ }
+ # check permissions
+ set read_p [permission::permission_p -party_id $user_id -object_id $instance_id -privilege read]
+ set return_id ""
-ad_proc -private spreadsheet::status_q {
- sheet_id
-} {
- gets spreadsheet status
-} {
- db_0or1row get_spreadsheet_status "select sheet_status from qss_sheets where id = :sheet_id"
- if { ![info exists sheet_status] } {
- set sheet_status ""
+ if { $read_p } {
+ if { [regexp -- {[\?\*]} $sheet_name ] } {
+ regsub -nocase -all -- {[^a-z0-9_\?\*]} $sheet_name {_} sheet_name
+
+ set return_list_of_lists [db_list_of_lists spreadsheet_stats_sby_lm_1 { select id, name, last_modified from qss_sheets where ( trashed is null or trashed = '0' ) and instance_id = :instance_id order by last_modified} ]
+ # create a list of names
+ #ns_log Notice "spreadsheet::id_from_name.33: sheet_name '$sheet_name' return_list_of_lists $return_list_of_lists"
+ set names_list [list ]
+ foreach lol $return_list_of_lists {
+ lappend names_list [lindex $lol 1]
+ }
+ # find most recent matching name
+ set id_idx [lsearch -nocase $return_list $sheet_name]
+ #ns_log Notice "spreadsheet::id_from_name.40: id_idx $id_idx"
+ if { [llength $id_idx_list ] > 0 } {
+ # set idx to first matching.
+ set return_id [lindex [lindex $return_list_of_lists $id_idx] 0]
+ }
+ } else {
+ # no glob in sheet_name
+ set return_id [db_string spreadsheet_stats_id_read { select id, last_modified from qss_sheets where name =:sheet_name and ( trashed is null or trashed = '0' ) and instance_id = :instance_id order by last_modified desc limit 1 } -default "" ]
+ #ns_log Notice "spreadsheet::id_from_name.48: sheet_name '$sheet_name' return_id '$return_id'"
+ }
}
- return $sheet_status
+ return $return_id
}
-ad_proc -private spreadsheet::cell_id_from_other {
- sheet_id
- instance_id
- {orientation "RC"}
- {cell_row ""}
- {cell_column ""}
- {cell_name ""}
- {cell_title ""}
+
+# qss_tid_scalars_to_array
+# qss_tid_columns_to_array_of_lists
+# spreadsheet::read_as_lists <-- equivalent to qss_table_read
+# spreadsheet::read <--> qss_tids_columns_to_array_of_lists
+
+
+# also xref id key {array_name "xref_larr"} row_nbr
+ad_proc -public spreadsheet::xref_1row {
+ id
+ {array_name ""}
+ {row_nbr "1"}
+ {scalars_unfiltered ""}
+ {scalars_required ""}
+ {instance_id ""}
+ {user_id ""}
} {
- gets cell_id from indirect references
+ Similar to spreadsheet::read except that since there's only 1 row, values are not wrapped in a list.
+
+ Saves scalars in a 2 row table to an array array_name,
+ where array indexes are the scalars in the row 0 'name' column, and
+ the value for each scalar is row 1 in column.
+ id is a reference to a qss_sheets table.
+ Also, returns the name/value pairs in a list.
+ If any scalars_required are not included,
+ includes these indexes and sets values to empty string.
} {
- if { [spreadsheet::exists_for_rwd_q $sheet_id $instance_id] } {
- if { $orientation eq "RC" } {
- db_0or1row get_cell_id_from_rc_ref "select cell_id from qss_cells where sheet_id = :sheet_id and (
- (cell_name = :cell_name ) or
- (cell_row = :cell_row and cell_column=:cell_column) or
- (cell_row = :cell_row and cell_column in
- ( select cell_column from qss_cells where sheet_id = :sheet_id and cell_row = '0' and cell_name = :cell_name unique) )"
- }
+ if { $array_name eq "" } {
+ set array_name xref_arr
}
- if { ![info exists cell_id] } {
- set cell_id ""
- }
- return $cell_id
+ upvar $array_name id_arr
+
+ #### call spreadsheet::read
}
-ad_proc -private spreadsheet::id_from_cell_id {
- sheet_id
+# qss_table_create
+
+
+ad_proc -public spreadsheet::create {
+ name
+ title
+ {array_name ""}
+ {style_ref ""}
+ {orientation "RC"}
+ {description ""}
+ {template_id ""}
+ {flags ""}
+ {instance_id ""}
+ {user_id ""}
} {
- gets spreadsheet_id from cell_id
+ Creates spreadsheet. returns id, or 0 if error. instance_id is usually package_id
} {
- db_0or1row get_spreadsheet_id_from_cell_id "select sheet_id from qss_cells where id = :id"
- if { ![info exists sheet_id] } {
- set sheet_id ""
+ if { $array_name eq "" } {
+ set array_name "xref_arr"
}
- return $sheet_id
-}
+ upvar 1 $array_name p_larr
+ if { $instance_id eq "" } {
+ # set instance_id package_id
+ set instance_id [ad_conn package_id]
+ }
+ if { $user_id eq "" } {
+ set user_id [ad_conn user_id]
+ set untrusted_user_id [ad_conn untrusted_user_id]
+ }
+ set create_p [permission::permission_p -party_id $user_id -object_id $instance_id -privilege create]
+ ns_log Notice "spreadsheet::create: create_p $create_p with raw rows cells_list_of_lists [llength $cells_list_of_lists]"
+ if { $create_p } {
+ set id [db_nextval qss_id_seq]
+ ns_log Notice "spreadsheet::create: new id $id"
+ set sheet_exists_p [db_0or1row sheet_get_id {select name from qss_sheets where id = :id } ]
+ if { !$sheet_exists_p } {
+ if { $template_id eq "" } {
+ set template_id $id
+ }
+ set nowts [dt_systime -gmt 1]
+ db_transaction {
+ db_dml sheet_create { insert into qss_sheets
+ (id,template_id,name,title,comments,instance_id,user_id,flags,last_modified,created)
+ values (:id,:template_id,:name,:title,:comments,:instance_id,:user_id,:flags,:nowts,:nowts) }
+
+#### following needs to identify column first, then step through rows, extracting data from array_name
+#### How to identify cell attributes in an array_name? by appending standard suffixes to array_name..
+ #### ${array_name}_larr for cell values, ${array_name}_nam_larr for cell_name etc etc.
+ set column_names_list [array names p_larr]
+ set row 0
+ set cells 0
+ foreach row_list $column_names_list {
+ incr row
+ set column 0
+ foreach cell_value $row_list {
+ incr column
+ incr cells
+ # set cell_rc "r[string range "0000" 0 [expr { 3 - [string length $row] } ] ]${row}c[string range "0000" 0 [expr { 3 - [string length $column] } ] ]${column}"
+ # if cell_value has length of zero, then don't insert
+ if { $cell_value ne "" || $cell_proc ne "" } {
+ #ns_log Notice "spreadsheet::create: cell_rc $cell_rc cell_value $cell_value"
+ db_dml qss_cells_create { insert into qss_cells
+ (id,sheet_id,cell_row,cell_column,cell_name,cell_value,cell_proc,cell_type,cell_format,calc_depth,cell_title,last_calc,last_mod,last_mod_by)
+ values (:id,:cell_rc,:cell_value)
+ }
+ }
+ }
+ }
+### end cell insertion loops
-ad_proc -private spreadsheet::exists_for_rwd_q {
- sheet_id
- instance_id
-} {
- returns 1 if sheet_id exists. This is handy for reads, writes, and deletes. Use status_q instead if you want to check for the existence of the id only.
-} {
- db_0or1row spreadsheet_exists_q "select sheet_status from qss_sheets where id = :sheet_id and instance_id = :instance_id"
- if { ![info exists sheet_status] } {
- set exists_p 0
+ ns_log Notice "spreadsheet::create: total $row rows, $cells cells"
+ db_dml sheet_update_rc { update qss_sheets
+ set row_count =:row,cell_count =:cells, last_modified=:nowts
+ where id = :id }
+
+ } on_error {
+ set id 0
+ ns_log Error "spreadsheet::create: general psql error during db_dml"
+ }
} else {
- set exists_p 1
+ set id 0
+ ns_log Warning "spreadsheet::create: sheet already exists for id $id"
}
- return $exists_p
}
+return $id
+}
-ad_proc -public spreadsheet::create {
+# qss_table_stats
+
+ad_proc -public spreadsheet::stats {
id
- name_abbrev
- sheet_title
- style_ref
- sheet_description
- {orientation "RC"}
+ {instance_id ""}
+ {user_id ""}
} {
- creates spreadsheet
- Orientation RC means fixed columns, variable number of rows.
- Orientation CR means fixed rows, variable number of columns.
+ Returns table stats as a list: name, title, comments, cell_count, row_count, template_id, flags, trashed, popularity, time last_modified, time created, user_id, style_ref, last_mod_user_id, status (ie. process state: ready, working, recalc)
+ Columns not listed, as those might vary.
} {
- # if id exists, assume it's a double click or bad info, ignore
- set success 0
- if { [spreadsheet::status_q $id] eq "" } {
- set package_id [ad_conn package_id]
+ if { $instance_id eq "" } {
+ # set instance_id package_id
+ set instance_id [ad_conn package_id]
+ }
+ if { $user_id eq "" } {
set user_id [ad_conn user_id]
- set create_p [permission::permission_p -party_id $user_id -object_id $package_id -privilege create]
- if { $create_p } {
- db_dml create_new_sheet {insert into qss_sheets
- (id, instance_id, name_abbrev, style_ref, sheet_description, orientation,row_count,column_count,last_calclated,last_modified, last_modified_by)
- values (:id, :package_id, :name_abbrev, :style_ref, :sheet_description, :orientation, '0', '0', now(), now(), :user_id ) }
+ set untrusted_user_id [ad_conn untrusted_user_id]
+ }
+ # check permissions
+ set read_p [permission::permission_p -party_id $user_id -object_id $instance_id -privilege read]
+
+ if { $read_p } {
+ set return_list_of_lists [db_list_of_lists qss_sheet_stats_read { select name, title, comments, cell_count, row_count, template_id, flags, trashed, popularity, last_modified, created, user_id, style_ref, last_modified_by, status from qss_sheets where id = :table_id and instance_id = :instance_id } ]
+ # convert return_lists_of_lists to return_list
+ set return_list [lindex $return_list_of_lists 0]
+ if { [lindex $return_list 7 ] eq "" } {
+ set return_list [lreplace $return_list 7 7 "0"]
}
- set success $create_p
- }
- return $success
+ } else {
+ set return_list [list ]
+ }
+ return $return_list
}
-ad_proc -public spreadsheet::list {
- package_id
- {user_id "0"}
+
+# qss_tables
+
+ad_proc -public spreadsheet::ids {
+ {instance_id ""}
+ {user_id ""}
+ {template_id ""}
} {
- returns list of lists of existing sheets: {id name_abbrev sheet_title last_modified by_user}
- If user_id is passed, results are sheets that the user has created or modified within package_id.
+ Returns a list of table_ids available. If table_id is included, the results are scoped to tables with same template. If user_id is included, the results are scoped to the user.
} {
- if { $user_id eq 0 } {
- set table [db_list_of_lists get_list_of_spreadsheets {select id, name_abbrev, sheet_title, last_modified, by_user from qss_sheets where instance_id = :package_id order by sheet_title } ]
+ if { $instance_id eq "" } {
+ # set instance_id package_id
+ set instance_id [ad_conn package_id]
+ }
+ if { $user_id eq "" } {
+ set party_id [ad_conn user_id]
+ set untrusted_user_id [ad_conn untrusted_user_id]
} else {
- set table [db_list_of_lists get_list_of_spreadsheets_for_user_id {select id, name_abbrev, sheet_title, last_modified, by_user
- from qss_sheets where ( instance_id = :package_id and user_id = :user_id ) or instance_id in
- ( select instance_id from qss_cells where sheet_id in ( select id from qss_sheets where instance_id = :package_id unique ) and last_modified_by = :user_id ) order by sheet_title } ]
- }
-}
+ set party_id $user_id
+ }
+ set read_p [permission::permission_p -party_id $party_id -object_id $instance_id -privilege read]
-ad_proc -public spreadsheet::attributes {
- sheet_id
-} {
- returns attributes of a sheet in list format: {id name_abbrev sheet_title last_modified by_user orientation row_count column_count last_calculated last_modified sheet_status}
-} {
- set package_id [ad_conn package_id]
- set user_id [ad_conn user_id]
- set read_p [permission::permission_p -party_id $user_id -object_id $package_id -privilege read]
- if { $read_p && [spreadsheet::exists_for_rwd_q $sheet_id $package_id] } {
- set sheet_list [db_list get_spreadsheet_attributes {select id, name_abbrev, sheet_title, last_modified, by_user, orientation, row_count, column_count, last_calculated, last_modified, sheet_status from qss_sheets where instance_id = :package_id and id = :sheet_id } ]
+ if { $read_p } {
+ if { $template_id eq "" } {
+ if { $user_id ne "" } {
+ set return_list [db_list spreadsheets_user_list { select id from qss_sheets where instance_id = :instance_id and user_id = :user_id } ]
+ } else {
+ set return_list [db_list spreadsheets_list { select id from qss_sheets where instance_id = :instance_id } ]
+ }
+ } else {
+ set has_template [db_0or1row spreadsheet_template "select template_id as db_template_id from qss_sheets where template_id= :template_id"]
+ if { $has_template && [info exists db_template_id] && $template_id > 0 } {
+ if { $user_id ne "" } {
+ set return_list [db_list spreadsheets_t_u_list { select id from qss_sheets where instance_id = :instance_id and user_id = :user_id and template_id = :template_id } ]
+ } else {
+ set return_list [db_list spreadsheets_list { select id from qss_sheets where instance_id = :instance_id and template_id = :template_id } ]
+ }
+ } else {
+ set return_list [list ]
+ }
+ }
} else {
- set sheet_list [list ]
+ set return_list [list ]
}
-}
+ return $return_list
+}
-ad_proc -public spreadsheet::cells_read {
- sheet_id
- {start ""}
- {count ""}
+# qss_table_read
+
+ad_proc -public spreadsheet::read {
+ id
+ array_name
+ {instance_id ""}
+ {user_id ""}
+ {start_row ""}
+ {row_count ""}
+ {column_names_list ""}
} {
- reads spreadsheet, returns list_of_lists, each cell is an element in the list
- If orientation is RC, cells are sorted first by row.
- If orientation is CR, cells are sorted first by column.
- first element contains header references
+ Reads spreadsheet with id. Returns sheet as an array of column indexes, where each index is a list representing a column.
+ Can read just part of a sheet, can also read a selection of named columns.
} {
- if { [ad_var_type_check_number_p $start] && $start > 0 && [ad_var_type_check_number_p $count] && $count > 0 } {
- set page_start $start
- set page_size $count
+ # in short, array_name refers to an array_larr()
+ upvar 1 $array_name p_larr
+
+ if { $instance_id eq "" } {
+ # set instance_id package_id
+ set instance_id [ad_conn package_id]
}
- set package_id [ad_conn package_id]
- set user_id [ad_conn user_id]
- set read_p [permission::permission_p -party_id $user_id -object_id $package_id -privilege read]
- # if orientation is RC, start is start_row, count is num_of_rows
- # if orientation is CR, start is start_col, count is num_of_columns
- if { $read_p && [spreadsheet::exists_for_rwd_q $sheet_id $package_id] } {
- if { [info exists $page_start] } {
- set table [db_list_of_lists get_all_cells_of_sheet {select id, cell_row, cell_column, cell_value, cell_value_sq, cell_format, cell_proc, cell_calc_depth, cell_name, cell_title from qss_cells where sheet_id = :sheet_id} limit :page_size offest :page_start ]
- } else {
- set table [db_list_of_lists get_all_cells_of_sheet {select id, cell_row, cell_column, cell_value, cell_value_sq, cell_format, cell_proc, cell_calc_depth, cell_name, cell_title from qss_cells where sheet_id = :sheet_id} ]
+ if { $user_id eq "" } {
+ set user_id [ad_conn user_id]
+ set untrusted_user_id [ad_conn untrusted_user_id]
+ }
+ set read_p [permission::permission_p -party_id $user_id -object_id $instance_id -privilege read]
+ set cells_list_of_lists [list ]
+ if { $read_p } {
+
+#### rework this to insert into array_name and offsets
+ set cells_data_lists [db_list_of_lists qss_sheet_read_cells { select cell_rc, cell_value from qss_cells
+ where table_id =:table_id order by cell_rc } ]
+ set cells2_data_lists [list ]
+ set col_ref_list [list ]
+ # filter row, column references
+ foreach cell_list $cells_data_lists {
+ set cell_rc [lindex $cell_list 0]
+ set cell_value [lindex $cell_list 1]
+
+ # following based on "0000" format used in create/write cell_rc r0001c0001
+ set row [string range $cell_rc 1 4]
+ regsub {^[0]+} $row {} row
+ set column [string range $cell_rc 6 9]
+ regsub {^[0]+} $column {} column
+ set row_list [list $row $column $cell_value]
+ lappend cells2_data_lists $row_list
+ lappend col_ref_list $column
}
- } else {
- set table [list ]
- }
- set table [linsert $table 0 [list id cell_row cell_column cell_value cell_value_sq cell_format cell_proc cell_calc_depth cell_name cell_title]
- return $table
+ # determine max referenced column
+ set column_max [f::lmax $col_ref_list]
+
+ set prev_row 1
+ set row_list [list ]
+ foreach cell_list $cells2_data_lists {
+ set row [lindex $cell_list 0]
+ set column [lindex $cell_list 1]
+ set cell_value [lindex $cell_list 2]
+# ns_log Notice "spreadsheet::read: cell ${cell_rc} ($row,$column) value ${cell_value}"
+
+ # build row list
+ if { $row eq $prev_row } {
+ # add cell to same row. column_next is column to fill as represented by cell column number 1...n
+ set column_next [expr { [llength $row_list ] + 1 } ]
+ set cols_to_add [expr { $column - $column_next } ]
+
+ # add blank cells, if needed
+ for {set i 0} {$i < $cols_to_add} {incr i } {
+ lappend row_list ""
+ }
+ lappend row_list $cell_value
+ } else {
+ # check for any blank orphan cells to add
+ set column_next [expr { [llength $row_list ] + 1 } ]
+ set cols_to_add [expr { $column_max - $column_next + 1 } ]
+
+ # add blank cells, if needed
+ for {set i 0} {$i < $cols_to_add} {incr i } {
+ lappend row_list ""
+ }
+
+ # row finished, add row_list to cells_list_of_lists
+ lappend cells_list_of_lists $row_list
+
+ # start new row
+ set row_list [list ]
+ set column_next [expr { [llength $row_list ] + 1 } ]
+ set cols_to_add [expr { $column - $column_next } ]
+
+ # add blank cells, if needed
+ for {set i 0} {$i < $cols_to_add} {incr i } {
+ lappend row_list ""
+ }
+ lappend row_list $cell_value
+ }
+ set prev_row $row
+ }
+
+ # check for any blank orphan cells at end of row that need adding
+ set column_next [expr { [llength $row_list ] + 1 } ]
+ set cols_to_add [expr { $column_max - $column_next + 1 } ]
+ # add blank cells, if needed
+ for {set i 0} {$i < $cols_to_add} {incr i } {
+ lappend row_list ""
+ }
+ lappend cells_list_of_lists $row_list
+ }
+ return $cells_list_of_lists
}
+
+# qss_table_write
+
ad_proc -public spreadsheet::cells_write {
sheet_id
list_of_lists
@@ -193,6 +432,8 @@
id (positive integer) replaces existing id if it exists.
other attrributes: cell_format cell_proc cell_name cell_title
} {
+ #### if spreadsheet::status_q is not idle, create a new revision.
+ #### do that anyway? yes, except add a param to control revisioning. May not want it for large sheets.
set success 0
set package_id [ad_conn package_id]
set user_id [ad_conn user_id]
@@ -267,6 +508,8 @@
return $success
}
+# qss_table_delete
+
ad_proc -public spreadsheet::delete {
spreadsheet_id
} {
@@ -294,11 +537,63 @@
return $success
}
-ad_proc -public spreadsheet::list {
+# qss_table_trash
+
+ad_proc -public spreadsheet::trash {
+ {trash_p "1"}
+ {id ""}
+ {instance_id ""}
+ {user_id ""}
} {
- returns list_of_lists of available spreadsheets
- each list item contains:
- id, name_abbrev, sheet_title,row_count,column_count,last_calculated,last_modified,status
+ id can be a list of id's. Trashes/untrashes id (subject to permission check).
+ set trash_p to 1 (default) to trash table. Set trash_p to '0' to untrash.
+ Returns 1 if successful, otherwise returns 0
} {
+ if { $instance_id eq "" } {
+ # set instance_id package_id
+ set instance_id [ad_conn package_id]
+ }
+ if { $user_id eq "" } {
+ set user_id [ad_conn user_id]
+ set untrusted_user_id [ad_conn untrusted_user_id]
+ }
+ set write_p [permission::permission_p -party_id $user_id -object_id $instance_id -privilege write]
+ set allowed_p $write_p
+ if { $write_p } {
+ if { $trash_p } {
+ db_dml simple_table_trash_togc { update qss_sheets set trashed = '1'
+ where id=:table_id and instance_id =:instance_id }
+ } else {
+ db_dml simple_table_trash_togc { update qss_sheets set trashed = '0'
+ where id=:table_id and instance_id =:instance_id }
+ }
+ } else {
+ set create_p [permission::permission_p -party_id $user_id -object_id $instance_id -privilege create]
+ set allowed_p $create_p
+ if { $create_p } {
+ if { $trash_p } {
+ db_dml simple_table_trash_togw { update qss_sheets set trashed = '1'
+ where id=:table_id and instance_id =:instance_id and user_id=:user_id }
+ } else {
+ db_dml simple_table_trash_togw { update qss_sheets set trashed = '0'
+ where id=:table_id and instance_id =:instance_id and user_id=:user_id }
+ }
+ }
+ }
+ return $allowed_p
}
+
+
+
+ad_proc -private spreadsheet::status_q {
+ sheet_id
+} {
+ gets spreadsheet status
+} {
+ db_0or1row get_spreadsheet_status "select sheet_status from qss_sheets where id = :sheet_id"
+ if { ![info exists sheet_status] } {
+ set sheet_status ""
+ }
+ return $sheet_status
+}
Index: openacs-4/packages/spreadsheet/www/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/spreadsheet/www/index.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/spreadsheet/www/index.adp 14 Nov 2014 18:36:34 -0000 1.1
@@ -0,0 +1,8 @@
+
+@title;noquote@
+@context;noquote@
+
+Demo Apps
+
Index: openacs-4/packages/spreadsheet/www/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/spreadsheet/www/index.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/spreadsheet/www/index.tcl 14 Nov 2014 18:36:34 -0000 1.1
@@ -0,0 +1,10 @@
+ad_page_contract {
+ spreadsheet home page
+ @creation-date 2014-09-28
+} {
+}
+
+set title "Spreadsheet"
+set context [list $title]
+
+
Index: openacs-4/packages/spreadsheet/www/table-sort-demo1.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/spreadsheet/www/table-sort-demo1.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/spreadsheet/www/table-sort-demo1.adp 14 Nov 2014 18:36:34 -0000 1.1
@@ -0,0 +1,11 @@
+
+
+reset sort
+
+@table2_html;noquote@
+
Index: openacs-4/packages/spreadsheet/www/table-sort-demo1.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/spreadsheet/www/table-sort-demo1.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/spreadsheet/www/table-sort-demo1.tcl 14 Nov 2014 18:36:34 -0000 1.1
@@ -0,0 +1,295 @@
+# this is rough in code that sorts a table of info by column, and adds more functions to each row.
+# This code will be used to generate more useful page sort UI for tables using qss_* functions
+
+set table_lists [list [list a b c d e f] [list b c a d e f a] [list a b c a b c a] [list a b c a c d b ] [list a b c f e d g]]
+
+# ================================================
+# Sort Table Columns
+# arguments
+# s sort_order_list (via form)
+# p primary_sort_col_new (via form)
+# table_lists (table represented as a list of lists
+# ================================================
+set table_cols_count [llength [lindex $table_lists 0]]
+set table_index_last [expr { $table_cols_count - 1 } ]
+set table_titles_list [list "Item ID" "Title" "Status" "Description" "Due Date" "Creation Date"]
+ns_log Notice "table-sort-demo1.tcl(12): table_cols_count $table_cols_count table_index_last $table_index_last "
+
+# defaults and inputs
+set sort_type_list [list "-integer" "-ascii" "-ascii" "-ascii" "-ascii" "-ascii" "-ascii"]
+set sort_stack_list [lrange [list 0 1 2 3 4 5 6 7 8 9 10] 0 $table_index_last ]
+set sort_order_list [list ]
+set sort_rev_order_list [list ]
+set table_sorted_lists $table_lists
+set form_posted [qf_get_inputs_as_array input_array]
+ns_log Notice "table-sort-demo1.tcl(26): form_posted $form_posted"
+
+# Sort table?
+if { [info exists input_array(s)] } {
+ # Sort table
+ ns_log Notice "table-sort-demo1.tcl(29): input_array(s) $input_array(s)"
+ # A sort order has been requested
+ # Validate sort order, because it is user input via web
+ regsub -all -- {[^\-0-9a]} $input_array(s) {} sort_order_scalar
+ ns_log Notice "table-sort-demo1.tcl(30): sort_order_scalar $sort_order_scalar"
+ set sort_order_list [split $sort_order_scalar a]
+ set sort_order_list [lrange $sort_order_list 0 $table_index_last]
+ # Has a sort order change been requested?
+ if { [info exists input_array(p)] } {
+ ns_log Notice "table-sort-demo1.tcl(32): sort_order_list '$sort_order_list' input_array(p) $input_array(p)"
+ # new primary sort requested
+ # validate user input, fail silently
+ regsub -all -- {[^\-0-9]+} $input_array(p) {} primary_sort_col_new
+ set primary_sort_col_pos [expr { abs( $primary_sort_col_new ) } ]
+ ns_log Notice "table-sort-demo1.tcl(35): primary_sort_col_new $primary_sort_col_new"
+ if { $primary_sort_col_new ne "" && $primary_sort_col_pos < $table_cols_count } {
+ ns_log Notice "table-sort-demo1.tcl(44): primary_sort_col_new $primary_sort_col_new primary_sort_col_pos $primary_sort_col_pos"
+ # modify sort_order_list
+ set sort_order_new_list [list $primary_sort_col_new]
+ foreach ii $sort_order_list {
+ if { [expr { abs($ii) } ] ne $primary_sort_col_pos } {
+ lappend sort_order_new_list $ii
+ ns_log Notice "table-sort-demo1.tcl(46): ii '$ii' sort_order_new_list '$sort_order_new_list'"
+ }
+ }
+ set sort_order_list $sort_order_new_list
+ ns_log Notice "table-sort-demo1.tcl(48): end if primary_sort_col_new.. "
+ }
+ ns_log Notice "table-sort-demo1.tcl(49): end if input_array(p).. "
+ }
+
+ ns_log Notice "table-sort-demo1.tcl(52): sort_order_scalar '$sort_order_scalar' sort_order_list '$sort_order_list'"
+ # Create a reverse index list for index countdown
+ set sort_rev_order_list [lsort -integer -decreasing [lrange $sort_stack_list 0 [expr { [llength $sort_order_list] - 1 } ] ] ]
+ ns_log Notice "table-sort-demo1.tcl(53): sort_rev_order_list '$sort_rev_order_list' "
+ foreach ii $sort_rev_order_list {
+ set col2sort [lindex $sort_order_list $ii]
+ ns_log Notice "table-sort-demo1.tcl(54): ii $ii col2sort '$col2sort' llength col2sort [llength $col2sort] sort_rev_order_list '$sort_rev_order_list' sort_order_list '$sort_order_list'"
+ if { [string range $col2sort 0 0] eq "-" } {
+ set col2sort_wo_sign [string range $col2sort 1 end]
+ set sort_order "-decreasing"
+ } else {
+ set col2sort_wo_sign $col2sort
+ set sort_order "-increasing"
+ }
+ set sort_type [lindex $sort_type_list $col2sort_wo_sign]
+ # Putting following lsort in a catch statement so that if the sort errors, default to -ascii sort.
+ # Sort table_lists by column number $col2sort_wo_sign, where 0 is left most column
+ if {[catch { set table_sorted_lists [lsort $sort_type $sort_order -index $col2sort_wo_sign $table_sorted_lists] } result]} {
+ # lsort errored, probably due to bad sort_type. Fall back to -ascii sort_type, or fail..
+ set table_sorted_lists [lsort -ascii $sort_order -index $col2sort_wo_sign $table_sorted_lists]
+ ns_log Notice "table-sort-demo1(83): lsort fell back to sort_type -ascii due to error: $result"
+ }
+ ns_log Notice "table-sort-demo1.tcl(66): lsort $sort_type $sort_order -index $col2sort_wo_sign table_sorted_lists"
+
+ }
+}
+
+# UI for Table Sort
+
+# Add the sort links to the titles.
+set url [ad_conn url]
+# urlcode sort_order_list
+set s_urlcoded ""
+foreach sort_i $sort_order_list {
+ append s_urlcoded $sort_i
+ append s_urlcoded a
+}
+set s_urlcoded [string range $s_urlcoded 0 end-1]
+set text_asc "^"
+set text_desc "v"
+set title_asc "ascending"
+set title_desc "descending"
+set table_titles_w_links_list [list ]
+set column_count 0
+set primary_sort_col [lindex $sort_order_list 0]
+foreach title $table_titles_list {
+ # For now, just inactivate the left most sort link that was most recently pressed (if it has been)
+ set title_new $title
+ if { $primary_sort_col eq "" || ( $primary_sort_col ne "" && $column_count ne [expr { abs($primary_sort_col) } ] ) } {
+ ns_log Notice "table-sort-demo1.tcl(104): column_count $column_count s_urlcoded '$s_urlcoded'"
+ append title_new " (${text_asc}:${text_desc})"
+ } else {
+ if { [string range $s_urlcoded 0 0] eq "-" } {
+ ns_log Notice "table-sort-demo1.tcl(105): column_count $column_count title $title s_urlcoded '$s_urlcoded'"
+ # decreasing primary sort chosen last, no need to make the link active
+ append title_new " (${text_asc}:${text_desc})"
+ } else {
+ ns_log Notice "table-sort-demo1.tcl(106): column_count $column_count title $title s_urlcoded '$s_urlcoded'"
+ # increasing primary sort chosen last, no need to make the link active
+ append title_new " (${text_asc}:${text_desc})"
+ }
+ }
+ lappend table_titles_w_links_list $title_new
+ incr column_count
+}
+set table_titles_list $table_titles_w_links_list
+
+# Add Row of Titles to Table
+set table_sorted_lists [linsert $table_sorted_lists 0 [lrange $table_titles_list 0 $table_index_last]]
+
+# Result: table_sorted_lists
+# Number of sorted columns:
+set sort_cols_count [llength $sort_order_list]
+
+
+
+# ================================================
+# Change the order of columns
+# so that the primary sort col is left, secondary is 2nd from left etc.
+# parameters: table_sorted_lists
+set table_col_sorted_lists [list ]
+# Rebuild the table, one row at a time, adding the primary, secondary etc. columns in order
+foreach table_row_list $table_sorted_lists {
+ set table_row_new [list ]
+ # Track the rows that aren't sorted
+ set unsorted_list $sort_stack_list
+ foreach ii $sort_order_list {
+ set ii_pos [expr { abs( $ii ) } ]
+ lappend table_row_new [lindex $table_row_list $ii_pos]
+ # Blank the reference instead of removing it, or the $ii reference won't work. lsearch is slower
+ set unsorted_list [lreplace $unsorted_list $ii_pos $ii_pos ""]
+ }
+ # Now that the sorted columns are added to the row, add the remaining columns
+ foreach ui $unsorted_list {
+ if { $ui ne "" } {
+ # Add unsorted column to row
+ lappend table_row_new [lindex $table_row_list $ui]
+ }
+ }
+ # Confirm that all columns have been accounted for.
+ set table_row_new_cols [llength $table_row_new]
+ if { $table_row_new_cols != $table_cols_count } {
+ ns_log Notice "table-sort-demo1.tcl(71): table_row_new has ${table_row_new_cols} instead of ${table_cols_count} columns."
+ }
+ # Append new row to new table
+ lappend table_col_sorted_lists $table_row_new
+}
+
+# ================================================
+# Add UI Options column to table
+
+set table2_lists [list ]
+set row_count 0
+foreach row_list $table_col_sorted_lists {
+ set new_row_list $row_list
+ if { $row_count > 0 } {
+ set new_row_list $row_list
+ set item_id [string trim [lindex $row_list 0]]
+ set view "view"
+ set edit "edit"
+ set delete "delete"
+ set options_col "$view $edit $delete"
+ } else {
+ # First row is a title row. Add title
+ set options_col "Options"
+ }
+ lappend new_row_list $options_col
+
+ # Add the revised row to the new table
+ lappend table2_lists $new_row_list
+ incr row_count
+}
+
+
+# ================================================
+# Formatting code
+# Add attributes to the TABLE tag
+set table2_atts_list [list border 1 cellspacing 0 cellpadding 2]
+
+# Add cell formatting to TD tags
+set cell_formating_list [list ]
+# Let's try to get fancy, have the rows alternate color after the first row,
+# and have the sorted columns slightly lighter in color to highlight them
+# base alternating row colors:
+set color_even_row "#cccccc"
+set color_odd_row "#ccffcc"
+# sorted column colors
+set color_even_scol "#dddddd"
+set color_odd_scol "#ddffdd"
+
+# Set the default title row TD formats before columns sorted:
+# Title row TD formats
+set title_td_attrs_list [list [list valign top align right bgcolor #ffffff]\
+ [list valign top bgcolor #ffffff]\
+ [list valign top bgcolor #ffffff]\
+ [list valign top bgcolor #ffffff]\
+ [list valign top bgcolor #ffffff]\
+ [list valign top bgcolor #ffffff]\
+ [list valign top bgcolor #ffffff]]
+# The first column is an index number, so right justify the values
+set even_row_list [list [list valign top align right] [list valign top] [list valign top] [list valign top] [list valign top] [list valign top] [list valign top]]
+set odd_row_list [list [list valign top align right] [list valign top] [list valign top] [list valign top] [list valign top] [list valign top] [list valign top]]
+set cell_table_lists [list $title_td_attrs_list $odd_row_list $even_row_list]
+
+# Rebuild the even/odd rows adding the colors
+# If the column order changes, then formatting of the TD tags may change, too.
+# So, re-order the formatting columns, inserting the appropriate color at each cell.
+# Use the same looping logic from when the table columns changed order to avoid inconsistencies
+
+# Rebuild the cell format table, one row at a time, adding the primary, secondary etc. columns in order
+set row_count 0
+set cell_table_sorted_lists [list ]
+foreach td_row_list $cell_table_lists {
+ set td_row_new [list ]
+ # Track the rows that aren't sorted
+ set unsorted_list $sort_stack_list
+ foreach ii $sort_order_list {
+ set ii_pos [expr { abs( $ii ) } ]
+ set cell_format_list [lindex $td_row_list $ii_pos]
+ if { $row_count > 0 } {
+ # add the appropriate background color
+ if { [f::even_p $row_count] } {
+ lappend cell_format_list bgcolor $color_even_scol
+ } else {
+ lappend cell_format_list bgcolor $color_odd_scol
+ }
+ }
+ lappend td_row_new $cell_format_list
+ # Blank the reference instead of removing it, or the $ii reference won't work. lsearch is slower
+ set unsorted_list [lreplace $unsorted_list $ii_pos $ii_pos ""]
+ }
+ # Now that the sorted columns are added to the row, add the remaining columns
+ foreach ui $unsorted_list {
+ if { $ui ne "" } {
+ set cell_format_list [lindex $td_row_list $ui]
+ if { $row_count > 0 } {
+ # add the appropriate background color
+ if { [f::even_p $row_count] } {
+ lappend cell_format_list bgcolor $color_even_row
+ } else {
+ lappend cell_format_list bgcolor $color_odd_row
+ }
+ }
+ # Add unsorted column to row
+ lappend td_row_new $cell_format_list
+ }
+ }
+ # Append new row to new table
+ lappend cell_table_sorted_lists $td_row_new
+ incr row_count
+}
+
+set table_row_count [llength $table2_lists]
+set row_odd_format [lindex $cell_table_sorted_lists 1]
+set row_even_format [lindex $cell_table_sorted_lists 2]
+if { $table_row_count > 3 } {
+ # Repeat the odd/even rows for the length of the table (table2_lists)
+ for {set row_i 3} {$row_i < $table_row_count} { incr row_i } {
+ if { [f::even_p $row_i ] } {
+ lappend cell_table_sorted_lists $row_even_format
+ } else {
+ lappend cell_table_sorted_lists $row_odd_format
+ }
+ }
+
+}
+# ================================================
+
+
+# this builds the html table and assigns it to table2_html
+set table2_html [qss_list_of_lists_to_html_table $table2_lists $table2_atts_list $cell_table_sorted_lists]
+
+
+#set tc_code_get_string [tc_code_get ]
+
Index: openacs-4/packages/spreadsheet/www/doc/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/spreadsheet/www/doc/index.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/spreadsheet/www/doc/index.adp 14 Nov 2014 18:36:34 -0000 1.1
@@ -0,0 +1,64 @@
+
+@title;noquote@
+@context;noquote@
+
+Spreadsheet Package @title@
+
+The lastest release version of the code is available at:
+ http://github.com/dcpm/spreadsheet
+
+
+introduction
+
+
+Spreadsheet provides procedures for building and using tables and
+spreadsheets in OpenACS. This package allows convenient
+building and interpreting of web-based table data via tcl in a web page.
+
+This package provides two different API implementations:
+
+-
+Simple Table - stores and retrieves static tables as delimited text.
+Most any delimiter is automatically handled on input. Delimiters can
+be forced if necessary. Sheets have built-in revisioning and permissions.
+
-
+Standard spreadsheets - stores and retrieves sheets with formula
+and calculation values stored for each cell. (Not yet implemented)
+
+
+license
+
+Copyright (c) 2014 Benjamin Brink
+po box 20, Marylhurst, OR 97036-0020 usa
+email: tekbasse@yahoo.com
+
+Finance Package is open source and published under the GNU General Public License,
+consistent with the OpenACS system license: http://www.gnu.org/licenses/gpl.html
+A local copy is available at accounts-finance/www/doc/LICENSE.html
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see .
+
+
+Package features
+-
+Integrates well with Q-Forms or any web-based form processing.
+
-
+Tables can be represented as text, where each line is a row, and
+each cell is separated by a common or specified delimiter.
+
-
+Can manipulate Tcl list of lists for easy generation of reports.
+
-
+There are procedures for importing, rotating, and exporting tables
+ in various formats for easy use in tcl.
+
Index: openacs-4/packages/spreadsheet/www/doc/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/spreadsheet/www/doc/index.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/spreadsheet/www/doc/index.tcl 14 Nov 2014 18:36:34 -0000 1.1
@@ -0,0 +1,3 @@
+set title "Documentation"
+set context [list $title]
+