scripts/datasource_sql.itcl

   1 # vim: ft=tcl foldmarker=<<<,>>>
   2
   3 # some examples of how to use the settings on the datasource_sql:
   4 # variable lookup_query <<<
   5 #               variable        lookup_query    "select
   6 #                                                                               schemaname,
   7 #                                                                               tablename,
   8 #                                                                               tableowner,
   9 #                                                                               hasindexes,
  10 #                                                                               hasrules,
  11 #                                                                               hastriggers
  12 #                                                                       from
  13 #                                                                               pg_tables
  14 #                                                                       where
  15 #                                                                               tablename='%table%';"
  16 # >>>
  17 # variable insert_query <<<
  18 #               variable        insert_query    "insert into foo (
  19 #                                                                               schemaname,
  20 #                                                                               tablename,
  21 #                                                                               tableowner,
  22 #                                                                               hasindexes,
  23 #                                                                               hasrules,
  24 #                                                                               hastriggers
  25 #                                                                       ) values (
  26 #                                                                               '%schema%',
  27 #                                                                               '%table%',
  28 #                                                                               '%owner',
  29 #                                                                               '%indexed%',
  30 #                                                                               '%ruled%',
  31 #                                                                               '%hastriggers%'
  32 #                                                                       );"
  33 # >>>
  34 # variable update_query <<<
  35 #               variable        update_query    "update foo set
  36 #                                                                               schema          = '%schema%',
  37 #                                                                               tableowner      = '%owner%',
  38 #                                                                               hasindexes      = '%indexed%',
  39 #                                                                               hasrules        = '%ruled%',
  40 #                                                                               hastriggers     = '%hastriggers%'
  41 #                                                                       where \
  42 #                                                                               tablename       = '%%table%%';"
  43 # >>>
  44 # variable delete_query <<<
  45 #               variable        delete_query    "delete from foo
  46 #                                                                       where
  47 #                                                                       tablename               = '%tablename%'"
  48 # >>>
  49 # variable full_row_query <<<
  50 #               variable        full_row_query  "select *
  51 #                                                                       from
  52 #                                                                               pg_tables
  53 #                                                                       where tablename=%id%"
  54 # >>>
  55
  56 class tlc::Datasource_sql {
  57         inherit tlc::Datasource
  58
  59         constructor {args} {} {}
  60
  61         public {
  62                 # overridden inherited Datasource class interface
  63                 variable        quote                   1
  64                 variable        sql_obj
  65
  66                 variable        lookup_query    ""              {check_and_allow "lookup"}
  67                 variable        insert_query    ""              {check_and_allow "insert"}
  68                 variable        update_query    ""              {check_and_allow "update"}
  69                 variable        delete_query    ""              {check_and_allow "delete"}
  70                 variable        full_row_query  ""
  71
  72                 method          get_list {{new_criteria_values ""} {headersvar {}}}
  73                 method          add_item {row {col_list ""}}
  74                 method          update_item {oldrow newrow {old_col_list ""}
  75                                                                 {new_col_list ""}}
  76                 method          remove_item {row {rowmap ""}}
  77                 method          get_headers {}
  78                 method          get_full_row {id}
  79
  80                 # specific Datasource_sql interface
  81
  82         }
  83
  84         private {
  85                 variable        sql
  86
  87                 method          check_and_allow {action}
  88         }
  89 }
  90
  91 body tlc::Datasource_sql::constructor {args} { #<<<1
  92         package require Pg_sql
  93
  94         set valid_queries       {lookup insert update delete}
  95
  96         eval configure $args
  97
  98         if {![info exists sql_obj]} {
  99                 error "Must give -sql_obj"
 100         }
 101
 102         set sql         $sql_obj
 103
 104 }
 105
 106 body tlc::Datasource_sql::get_list {{new_criteria_values ""} {headersvar {}}} { #<<<1
 107 #       inputs: optional new_criteria_values to replace the existing criteria list
 108 #                       the penalty of just getting the headers and caching them for later use is only 100 microseconds, on
 109 #                       a time loop -- so we might as well, for convenience sake, just cache the headers
 110
 111         if {$new_criteria_values != ""} {
 112                 set criteria_values $new_criteria_values
 113                 array set acriteria_values $new_criteria_values
 114         }
 115         if {$quote} {
 116                 foreach {idx val} [array get criteria_values] {
 117                         set criteria_values($idx) [$sql quote $val]
 118                 }
 119         }
 120         set sql_string [replace_criteria $lookup_query $criteria_values]
 121         if {$headersvar=={}} {
 122                 set ret [$sql getlist_headers $sql_string last_headers]
 123         } else {
 124                 upvar $headersvar lheaders
 125                 set ret [$sql getlist_headers $sql_string lheaders]
 126                 set last_headers $lheaders
 127         }
 128         return $ret
 129 }
 130
 131 body tlc::Datasource_sql::add_item {row {col_list ""}} { #<<<1
 132 # inputs: an array-style list of columns to update -- should be the full set specified in the insert_query token list
 133 #                       optionally, the row data may be specified as a list, with the columns specified afterward
 134 # returns:      1 on success, 0 on fail
 135         if {$col_list!=""} {
 136                 set row [resolve_row $row $col_list]
 137         }
 138         set sql_string [replace_criteria $insert_query $row]
 139         return [$sql getlist $sql_string]
 140 }
 141
 142 body tlc::Datasource_sql::update_item {oldrow newrow {old_col_list ""} {new_col_list ""}} { #<<<1
 143 # inputs: two array-style lists: 1) the old row and 2) the new version. Both lists should contain all
 144 #                       tokens and values that would need to be used in update_sql
 145         if {$old_col_list!=""} {
 146                 set oldrow [resolve_row $oldrow $old_col_list]
 147         }
 148         if {$new_col_list!=""} {
 149                 set newrow [resolve_row $newrow $new_col_list]
 150         }
 151
 152         set loldrow             {}
 153         foreach {idx val} $oldrow {
 154                 lappend loldrow "!${idx}!" "$val"
 155         }
 156         set sql_string [replace_criteria $update_query [concat $loldrow $newrow]]
 157         return [$sql getlist $sql_string]
 158 }
 159
 160 body tlc::Datasource_sql::remove_item {row {col_list ""}} { #<<<1
 161 # inputs: array-style list that defines the row to be removed adequately to make the delete_query complete
 162         if {$col_list!=""} {
 163                 set row [resolve_row $row $col_list]
 164         }
 165         set sql_string [replace_criteria $delete_query $row]
 166         return [$sql getlist $sql_string]
 167 }
 168
 169 body tlc::Datasource_sql::get_headers {} { #<<<1
 170         return $last_headers
 171 }
 172
 173 body tlc::Datasource_sql::get_full_row {id} { #<<<1
 174         set query [replace_criteria $full_row_query [list "id" "$id"]]
 175         set lheaders {}
 176         set row [lindex [$sql getlist_headers $query lheaders] 0]
 177         set ret {}
 178         foreach col $lheaders field $row {
 179                 lappend ret $col $field
 180         }
 181         return $ret
 182 }
 183
 184 body tlc::Datasource_sql::check_and_allow {action} { #<<<1
 185         can_do $action [info exists ${action}_query]
 186         if {[string trim ${action}_query] == ""} {
 187                 invoke_handlers debug "WARNING: $action query is empty."
 188         }
 189 }
 190
 191