gustafn
committed
on 26 Aug 20
whitespace cleanup
openacs-4/.../xotcl-core/tcl/05-db-procs.tcl (+4 -4)
1299 1299       return $::xo::db::fnargs($key)
1300 1300     }
1301 1301
1302 1302     ns_log notice "obtain fnargs for $key from PostgreSQL via parsing function definition"
1303 1303
1304 1304     #
1305 1305     # Get function_args for a single sql-function from PostgreSQL
1306 1306     # system catalogs by retrieving the function source code and
1307 1307     # passing it. We retrieve always the function with the longest
1308 1308     # argument list for our definition, since we use an interface with
1309 1309     # non positional arguments, where in most situations, many
1310 1310     # arguments are optional.  In cases, where more function with the
1311 1311     # same number of arguments are available, we sort by the type as
1312 1312     # well to obtain a predictable ordering and to give string
1313 1313     # interfaces (text, varchar) a higher priority than integer or
1314 1314     # boolean arguments (e.g. int4, int8m bool).
1315 1315     #
1316 1316     # Note: based on the ordering, char has lower priority over int*
1317 1317     # which is probably a bug, but is not a problem in OpenACS.
1318 1318     #
1319       # Note, that we can as well get the type in future versions.
  1319     # Note that we can as well get the type in future versions.
1320 1320     #
1321 1321     ::xo::dc foreach get_function_params {
1322 1322       select proname, pronargs, proargtypes, prosrc
1323 1323       from pg_proc
1324 1324       where proname = lower(:package_name) || '__' || lower(:object_name)
1325 1325       order by pronargs desc, proargtypes desc
1326 1326     } {
1327 1327       set n 1
1328 1328       set function_args [list]
1329 1329       foreach line [split $prosrc \n] {
1330 1330         if {[regexp -nocase "alias +for +\\\$$n" $line]} {
1331 1331           if {![regexp {^[^a-zA-Z]+([a-zA-Z0-9_]+)\s} $line _ fq_name]} {
1332 1332             #ns_log notice "proname $proname line <$line> fq_name <$fq_name>"
1333 1333             ns_log notice "--***** Could not retrieve argument name for $proname\
1334 1334                 argument $n from line '$line' i    n $prosrc'"
1335 1335               set fq_name arg$n
1336 1336           }
1337 1337           set name $fq_name
1338 1338           set default ""
1339 1339           if {![regexp {^.+__(.+)$} $fq_name _ name]} {
 
1655 1655   ::xo::db::Class instproc unknown {m args} {
1656 1656     error "Error: unknown database method '$m' for [self]"
1657 1657   }
1658 1658
1659 1659   ::xo::db::Class proc create_all_functions {} {
1660 1660
1661 1661     foreach item [::xo::dc get_all_package_functions] {
1662 1662       lassign $item package_name object_name
1663 1663
1664 1664       if {[string match "*TRG" [string toupper $object_name]]} {
1665 1665         # no need to provide interface to trigger functions
1666 1666         continue
1667 1667       }
1668 1668
1669 1669       set class_name ::xo::db::sql::[string tolower $package_name]
1670 1670       if {![:isobject $class_name]} {
1671 1671         ::xo::db::Class create $class_name
1672 1672       } elseif {![$class_name istype ::xo::db::Class]} {
1673 1673         #
1674 1674         # The methods of ::xo::db::sql::util like "table_exists" fall
1675           # into this category. Make sure, that we do not create new
  1675         # into this category. Make sure that we do not create new
1676 1676         # objects via the next command.
1677 1677         #
1678 1678         continue
1679 1679       }
1680 1680       $class_name dbproc_nonposargs [string tolower $object_name]
1681 1681     }
1682 1682   }
1683 1683
1684 1684   ::xo::db::Class proc class_to_object_type {name} {
1685 1685     if {[:isclass $name]} {
1686 1686       if {[$name exists object_type]} {
1687 1687         # The specified class has an object_type defined; return it
1688 1688         return [$name object_type]
1689 1689       }
1690 1690       if {![$name istype ::xo::db::Object]} {
1691 1691         # The specified class is not subclass of ::xo::db::Object.
1692 1692         # return acs_object in your desperation.
1693 1693         return acs_object
1694 1694       }
1695 1695     }
 
2447 2447
2448 2448     set sql [::xo::dc select \
2449 2449                  -vars   [join $select_attributes ,] \
2450 2450                  -from  "[join $tables ,] $from_clause" \
2451 2451                  -where  [string trim "[join $join_expressions { and }] $where_clause"] \
2452 2452                  -orderby $orderby \
2453 2453                  -limit $limit -offset $offset]
2454 2454     return $sql
2455 2455   }
2456 2456
2457 2457   ::xo::db::Class ad_instproc get_instances_from_db {
2458 2458     {-select_attributes ""}
2459 2459     {-from_clause ""}
2460 2460     {-where_clause ""}
2461 2461     {-orderby ""}
2462 2462     {-page_size 20}
2463 2463     {-page_number ""}
2464 2464     {-initialize true}
2465 2465   } {
2466 2466     Returns a set (ordered composite) of the answer tuples of
2467       an 'instance_select_query' with the same attributes. Note, that
  2467     an 'instance_select_query' with the same attributes. Note that
2468 2468     the returned objects might by partially instantiated.
2469 2469
2470 2470     @return ordered composite
2471 2471   } {
2472 2472     set s [:instantiate_objects \
2473 2473                -object_class [self] \
2474 2474                -sql [:instance_select_query \
2475 2475                          -select_attributes $select_attributes \
2476 2476                          -from_clause $from_clause \
2477 2477                          -where_clause $where_clause \
2478 2478                          -orderby $orderby \
2479 2479                          -page_size $page_size \
2480 2480                          -page_number $page_number \
2481 2481                         ] \
2482 2482                -initialize $initialize]
2483 2483     return $s
2484 2484   }
2485 2485   ##############
2486 2486
2487 2487   ::xo::db::Class create ::xo::db::Object \