# ------------------------------------------------------------ # Copyright (c) 2005-2024 # Q.W.Page Associates Inc. # www.qwpage.com # All rights reserved. # ------------------------------------------------------------ ::namespace eval ::qw::odb {} ::proc ::qw::odb::odb_path_help {sargs} { /* { Low-level method needed by low-level code such as ::qw::active_index::key_build. Usage: ::qw::odb::odb_path_help .database $Database .object_structure $OS; Usage: ::qw::odb::odb_path_help .database $Database [any cpp_object_structure_load arguments]. */ } ::set Path [::qw::odb::odb_path_readable $sargs]; ::set OS [::sargs::get $sargs .object_structure]; ::set ClassPath [::sargs::get $OS .system.class_path]; ::set Database [::sargs::get $sargs .database]; ::if {$Database eq ""} { ::qw::bug 314120231222121630 "[::qw::procname] - no .database argument."; } ::switch -glob -- $ClassPath { "/OBJECT/NEWVIEWS/ATTACHMENT*" { ::return [::string map [::list "/OBJECT/NEWVIEWS" ""] $Path]; } "/OBJECT/NEWVIEWS/ADDRESS*" { ::return [::string map [::list "/OBJECT/NEWVIEWS" ""] $Path]; } "/OBJECT/NEWVIEWS/ACCOUNT*" { ::return [::string map [::list "/OBJECT/NEWVIEWS" ""] $Path]; } "/OBJECT/NEWVIEWS/JOURNAL*" { ::return [::string map [::list "/OBJECT/NEWVIEWS" ""] $Path]; } "/OBJECT/NEWVIEWS/REPORT*" { ::return [::string map [::list "/OBJECT/NEWVIEWS" ""] $Path]; } "/OBJECT/NEWVIEWS/PAYROLL*" { ::return [::string map [::list "/OBJECT/NEWVIEWS" ""] $Path]; } "/OBJECT/NEWVIEWS/SYSTEM/EMPLOYEE*" { ::return [::string map [::list "/OBJECT/NEWVIEWS/SYSTEM" ""] $Path]; } "/OBJECT/NEWVIEWS/SYSTEM/PAYRUN*" { ::return [::string map [::list "/OBJECT/NEWVIEWS/SYSTEM" ""] $Path]; } "/OBJECT/NEWVIEWS/SYSTEM/ROE*" { ::return [::string map [::list "/OBJECT/NEWVIEWS/SYSTEM" ""] $Path]; } "/OBJECT/NEWVIEWS/TRANSACTION*" { ::set Collection [::sargs::get $OS .data.journal]; ::if {$Collection ne ""} { ::set OS [$Database cpp_object_structure_load .address $Collection]; ::set Result "[::qw::odb::odb_path_help $sargs .object_structure $OS][::qw::odb::odb_path_readable $sargs]"; ::return $Result; } ::set Collection [::sargs::get $OS .data.odb_base] ::if {$Collection eq ""} { ::return "/OBJECT"; } ::set OS [$Database cpp_object_structure_load .address $Collection]; ::set Result "[::qw::odb::odb_path_help $sargs .object_structure $OS][::qw::odb::odb_path_readable $sargs]"; ::return $Result; /* { public method odb_path_help {} { /* { ::puts "pgq,debug....../TRANSACTION odb_path_help enter [odb_path]"; ::puts "pgq,debug....../TRANSACTION odb_path_help .journal ==[::expr {[[$this .journal] qw_get] eq ""?{}:[[[$this .journal] qw_get] odb_path_help]}]"; ::puts "pgq,debug....../TRANSACTION odb_path_help odb_base ==[::expr {[odb_base] eq ""?{}:[[odb_base] odb_path_help]}]"; ::puts "pgq,debug....../TRANSACTION odb_path_help .odb_base==[::expr {[[$this .odb_base] odb_get] eq ""?{}:[[[$this .odb_base] odb_get] odb_path_help]}]"; */} ::if {[[$this ".journal"] qw_get] ne ""} { ::return "[[[[$this .journal] qw_get] odb_master] odb_path_help][odb_id_readable]"; } ::if {[odb_base] ne ""} { #nv2.27.3 (pixel cleanup) - kirk insists that including the detail item's odb_id is worse than meaningless ::return "[[odb_base] odb_path_help][odb_id_readable]"; #::return "[[odb_base] odb_path_help]"; ;#// wrong approach to pixel cleanup - attack odb_id_readable } ::return [chain]; } */ } } "/OBJECT/NEWVIEWS*" { ::return [::string map [::list "/OBJECT" ""] $Path]; } "/OBJECT/SYSTEM/WINDOW*" { ::set Result [::string map [::list "/OBJECT/SYSTEM/WINDOW" ""] [::sargs::get $sargs .object_structure .system.path]]; ::qw::bug "314120231221095053" "Haven't implemented odb_path for window yet."; ::append Result " - [window_titles_get]"; ::return $Result; } "/OBJECT/NEWVIEWS/SYSTEM/EMPLOYEE*" { ::return [::string map [::list "/OBJECT/NEWVIEWS/SYSTEM" ""] $Path]; } } ::qw::bug "314120231221095054" "::qw::odb::odb_path_help not implemented for class \"$ClassPath\"."; } ::proc ::qw::odb::odb_path_help_needed_work {sargs} { /* { Low-level method needed by low-level code usch as ::qw::active_index::key_build. Usage: ::qw::odb::odb_path_help .database $Database .object_structure $OS; Usage: ::qw::odb::odb_path_help .database $Database [any cpp_object_structure_load arguments]. */ } ::set Database [::sargs::get $sargs .database]; ::set OS [::sargs::get $sargs .object_structure]; ::if {[::sargs::size $OS]==0} { ::set OS [$Database cpp_object_structure_load $sargs]; } ::set ClassPath [::sargs::get $OS .system.class_path]; ::if {$ClassPath eq "/OBJECT"} { ::return "/OBJECT"; } ::set BaseOS [$Database cpp_object_structure_load .object_id [::sargs::get $OS .system.base_object_id]]; ::set BasePath [[::qw::procname] .database $Database .object_structure $BaseOS]; ::set Id [::qw::odb::odb_id_readable .object_structure $OS]; ::return "$BasePath$Id"; } ::proc ::qw::odb::odb_is_posting_account {sargs} { ::set Database [::sargs::get $sargs .database]; ::set OS [::sargs::get $sargs .object_structure]; ::if {[::sargs::size $OS]==0} { ::set OS [$Database cpp_object_structure_load $sargs]; } ::if {[::sargs::boolean_get $OS .system.is_class]} { ::return 0; } ::set ClassPath [::sargs::get $OS .system.class_path]; ::if {[::string first "/OBJECT/NEWVIEWS/ACCOUNT/TOTAL" $ClassPath]>=0} { ::return 0; } ::set ObjectId [::sargs::get $OS .system.object_id]; ::set RecordCount [$Database cpp_file_record_count \ .path /odb/index$ClassPath.total.kids.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::if {$RecordCount!=0} { ::return 0; } ::set RecordCount [$Database cpp_file_record_count \ .path /odb/index$ClassPath.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::if {$RecordCount!=0} { ::return 0; } ::return 1; } ::proc ::qw::odb::odb_path_backward {sargs} { ::set OS [::sargs::get $sargs .object_structure]; ::set Path [::sargs::get $OS .system.path]; ::set ReverseList [::qw::list::reverse .list [::split $Path /]]; ::set ReversePath [::join $ReverseList /]; ::return $ReversePath; } ::proc ::qw::odb::odb_path_backward_readable {sargs} { ::set Path [::qw::odb::odb_path_readable $sargs]; ::set ReversePath [::qw::odb::path_reverse $Path]; ::return $ReversePath; } ::proc ::qw::odb::odb_path_readable {sargs} { ::set Database [::sargs::get $sargs .database]; ::if {$Database eq ""} { ::qw::bug 314120231222121630 "[::qw::procname] - no .database argument."; } ::set OS [::sargs::get $sargs .object_structure]; ::set Collection [::sargs::get $OS .data.odb_base]; ::if {$Collection eq ""} { ::return /OBJECT; } ::set BaseOS [$Database cpp_object_structure_load .address $Collection]; ::set BasePath [::qw::odb::odb_path_readable $sargs .object_structure $BaseOS]; ::set ReadableId [::qw::odb::odb_id_readable $sargs]; ::set Result "$BasePath$ReadableId"; } ::proc ::qw::odb::odb_id_readable {sargs} { /* { Low-level method needed by low-level code usch as ::qw::active_index::key_build. */ } /* { QW::STR QW::ODB::OBJECT::odb_id_readable() { STR Result=call_odb_method("odb_id_readable"); if (Result==QW_EMPTY) { Result=odb_id(); } return Result; } */ } ::set OS [::sargs::get $sargs .object_structure]; ::set ClassPath [::sargs::get $OS .system.class_path]; ::switch -glob -- $ClassPath { /OBJECT/SYSTEM/AUDIT* { ::set Result [::sargs::get $OS .data.address]; ::if {$Result ne ""} { ::return $Result; } } /OBJECT/NEWVIEWS/SYSTEM/TRANSACTION* { ::set Date [::sargs::get $OS .data.date]; ::if {$Date ne ""} { ::return "/[::qw::date::format $Date {%Y%b%d}]"; } ::set Date [::sargs::get $OS .data.date1]; ::if {$Date ne ""} { ::return "/[::qw::date::format $Date {%Y%b%d}]"; } ::if {![::sargs::boolean_get $OS .system.is_class]} { ::return ""; } } /OBJECT/NEWVIEWS/SYSTEM/EMPLOYEE* { ::set Eid [::sargs::get $OS .data.employee_id]; ::if {$Eid ne ""} { ::return "/$Eid"; } } } ::set Name [::sargs::get $OS .data.name]; ::if {$Name ne ""} { return "/$Name"; } ::return [::sargs::get $OS .system.id]; } ::proc ::qw::odb::object_id_extract {sargs} { /* { Gets the object address, stripping the field path if necessary. The address argument can be memory or disk representation. */ } ::set Address [::sargs::get $sargs .address]; ::if {$Address ne ""} { ::set SlashPos [::string first "/" $Address]; ::if {$SlashPos<0} { ::qw::bug 314120090401104621 "[::qw::procname] invalid address \"$Address\"."; } ::incr SlashPos 1; ::set DotPos [::string first "." $Address $SlashPos]; ::if {$DotPos>=0} { ::return [::string range $Address $SlashPos [::expr {$DotPos-1}]]; } ::return [::string range $Address $SlashPos end]; } ::if {![::sargs::exists $sargs .address]} { ::qw::bug 314120090401105305 "[::qw::procname] - no address argument."; } ::return ""; } ::proc ::qw::odb::database_id_extract {sargs} { /* { Gets the object address, stripping the field path if necessary. The address must be in memory representation, i.e. has database id. ::qw::odb::20111123131609::/1322072169_393.focus.parent */ } ::set Address [::sargs::get $sargs .address]; ::if {$Address ne ""} { ::set Index [::string first "::qw::odb::" $Address]; ::if {$Index!=0} { ::qw::bug 314120111222161347 "[::qw::procname] - invalid address \"$Address\"."; } ::set StartIndex [::string length "::qw::odb::"]; ::set EndIndex [::expr {$StartIndex+[::string length "yyyymmddhhmmss"]-1}]; ::set DatabaseId [::string range $Address $StartIndex $EndIndex]; ::return $DatabaseId; } ::if {![::sargs::exists $sargs .address]} { ::qw::bug 314120111222161348 "Expected an address argument."; } ::return ""; } ::proc ::qw::odb::object_address_extract {sargs} { /* { Gets the object address, stripping the field path if necessary. The address argument can be memory or disk representation. */ } ::set Address [::sargs::get $sargs .address]; ::if {$Address ne ""} { ::set StartIndex [::string first "/" $Address]; ::if {$StartIndex<0} { ::qw::bug 314120090112105544 "[::qw::procname] - invalid address \"$Address\"."; } ::incr StartIndex; ::set Index [::string first "." $Address $StartIndex]; ::if {$Index>=0} { ::return [::string range $Address 0 [::expr {$Index-1}]]; } ::set Index [::string first "/" $Address $StartIndex]; ::if {$Index>=0} { ::return [::string range $Address 0 [::expr {$Index-1}]]; } ::return $Address; } ::if {![::sargs::exists $sargs .address]} { ::qw::bug 314120090109090423 "Expected an address argument."; } ::return ""; } ::proc ::qw::odb::address_from_disk {sargs} { /* { Usage: ::qw::odb::address_from_disk .address XXX .database YYY; Usage: ::qw::odb::address_from_disk .object_id XXX .database YYY; */ } ::set Database [::sargs::get $sargs .database]; ::if {$Database eq ""} { ::qw::bug 314120090109090421 "[::qw::procname] - no .database argument."; } ::if {![::qw::command_exists $Database]} { ::qw::bug 314120090109090422 "[::qw::procname] - invalid database."; } ::if {[::sargs::exists $sargs .address]} { ::set Address [::sargs::get $sargs .address]; ::if {$Address eq ""} { ::qw::bug 314120200915153735 "[::qw::procname] - empty .address argument."; } ::if {[::string first "::qw::odb::" $Address]==0} { /* { The address was already in memory format. */ } ::return $Address; } ::if {[::string index $Address 0] ne "/"} { ::qw::bug 314120090112102954 "[::qw::procname] - invalid address \"$Address\"."; } ::return [$Database cpp_address_from_disk $sargs]; } ::if {[::sargs::exists $sargs .object_id]} { ::set ObjectId [::sargs::get $sargs .object_id]; ::if {$ObjectId eq ""} { ::qw::bug 314120200915154038 "[::qw::procname] - empty .object_id argument."; } ::return [$Database cpp_address_from_disk .address /$ObjectId]; } ::qw::bug 314120090109090425 "[::qw::procname] - no .address or .object_id argument."; } ::proc ::qw::odb::address_to_disk {sargs} { ::set Address [::sargs::get $sargs .address]; ::if {$Address eq ""} { ::return $Address; } ::if {[::string first "::qw::odb::" $Address]<0} { ::if {[::string index $Address 0] ne "/"} { ::qw::bug 314120090112104311 "[::qw::procname] - invalid address \"$Address\"."; } ::return $Address; } ::set Index [::string first "/" $Address]; ::if {$Index<0} { ::qw::bug 314120090109162557 "[::qw::procname] - invalid address \"$Address\"."; } ::return [::string range $Address $Index end]; } ::proc ::qw::odb::field_extract {sargs} { /* { 2.34.11 Extracts field from address (memory or disk representation) or from address. Does not look for sub-fields, i.e. fields starting with slashes. Only superficial checks for "valid" arguments. Just searches for the first dot and returns the remainder, i.e. presumably the field. 2.38.0 Had two methods field_extract and dot_field_extract. Merged them in to one method and changed dat_field_extract calls to field extract. */ } ::set Value [::sargs::get $sargs .path]; ::if {$Value eq ""} { ::set Value [::sargs::get $sargs .address]; } ::if {$Value eq ""} { ::if {![::sargs::exists $sargs .path] && ![::sargs::exists $sargs .address]} { ::qw::bug 314120210805073907 "[::qw::procname] - no .path or .address argument."; } ::return ""; } ::switch -- [::string index $Value 0] { ":" { ::if {[::string first "::qw::odb::" $Value]!=0} { ::qw::bug 314120090129091102 "[::qw::procname] - invalid address \"$Value\"."; } } "/" { /* { */ } } "." { ::return $Value; } default { ::qw::bug 314120090129091101 "[::qw::procname] - invalid address \"$Value\"."; } } ::set Pos [::string first "." $Value]; ::if {$Pos<0} { /* { Presumably the address is a master with no field at all. */ } ::return ""; } ::set Result [::string range $Value $Pos end]; ::return $Result; } ::proc ::qw::odb::collection_from_index_extract {sargs} { /* { 2.34.11 Takes an index address or path in .address and returns it's collection address or path. */ } ::set Index [::sargs::get $sargs .address]; ::if {$Index eq ""} { ::set Index [::sargs::get $sargs .path]; } ::if {$Index eq ""} { ::qw::bug 314120210727170624 "[::qw::procname] - no index address or path specified."; ::return ""; } ::set Pos [::string first ".index" $Index]; ::if {$Pos<0} { ::qw::bug 314120210727170625 "[::qw::procname] - invalid index address or path \"$Index\"."; } ::set Collection [::string range $Index 0 [::expr {$Pos-1}]]; ::if {$Collection eq ""} { ::qw::bug 314120210727170626 "[::qw::procname] - invalid index address or path \"$Index\"."; } ::return $Collection; } ::proc ::qw::odb::master_extract {sargs} { /* { Drops the field from an address or a path. ::set MasterPath [::qw::odb::master_extract .path $FullFieldPath]; ::set MasterPath [::qw::odb::master_extract .address $FullFieldPath]; */ } ::set PathOrAddress [::sargs::get $sargs .path]; ::if {$PathOrAddress eq ""} { ::set PathOrAddress [::sargs::get $sargs .address]; ::if {$PathOrAddress eq ""} { ::qw::bug 314120220706101725 "[::qw::procname] - no .path or .address argument."; } } ::set Pos [::string first "." $PathOrAddress]; ::if {$Pos>=0} { ::set PathOrAddress [::string range $PathOrAddress 0 [::expr {$Pos-1}]]; } ::return $PathOrAddress; } ::proc ::qw::odb::assignable_fields_get {sargs} { /* { Given a meta structure we would like a list of the leaf fields. */ } ::if {![::sargs::exists $sargs .meta]} { ::qw::bug 314120090625110509 "[::qw::procname] - no \".meta\"."; } ::set Meta [::sargs::get $sargs .meta]; ::set Paths [::sargs::select_field .structure $Meta .field .odb.type]; ::set Result ""; ::foreach Path $Paths { ::set Type [::sargs::get $Meta $Path.odb.type]; ::switch -exact -- $Type { string - structure - integer - real - date - reference - pointer { ::lappend Result $Path; } master - collection - index - field { } default { ::qw::bug 314120090625102824 "[::qw::procname] - invalid type \"$Type\"."; } } } ::return $Result; } ::proc ::qw::odb::name_value_wrap {sargs} { /* { Takes a name/value list and wraps it up with begin and end tags and a protocol for name/value pairs. The idea is that it is then easy to find it using the tags and then extract the name/value pairs back into a structure. Can be used for arrays with array set. Can also be used for structures if the names are proper field names (or even paths). */ } ::set List [::sargs::get $sargs .list]; ::if {[::llength $List]==0} { ::qw::bug 314120120419093952 "[::qw::procname] - empty list."; } ::if {[::llength $List]%2!=0} { ::qw::bug 314120120419093953 "[::qw::procname] - invalid name/value list \"$List\"."; } ::set Tag [::string tolower [::sargs::get $sargs .tag]]; ::if {$Tag eq ""} { ::set Tag "wrapped_name_value"; } ::set Result "<$Tag>"; ::set Count 0; ::foreach {Name Value} $List { ::if {$Count!=0} { ::append Result "<&>"; } ::incr Count; ::append Result "$Name<=>$Value"; } ::append Result ""; #2.31.2 ::if {[::string first " " $Result]>=0} { /* { If an object name contains spaces (or whitespace of any kind actually), we need to put braces areound it's wrapped value. This occured in saskatchewanpenplan (kirk) and resulted in bugs during window setups because the entire window .data ended up being primitive. Note: we are only checking for spaces here. We are preuming (hoping) no user would put tabs, linefeeds, etc., in an object name. */ } ::set Result "{$Result}"; } ::return $Result; } ::proc ::qw::odb::name_value_unwrap {sargs} { /* { Takes a string and unwraps in into a name/value list. First it strips off the begin and end tag. Then pairs are separated by <&>. The name/value in each pair is separated by <=>. Example: .type<=>app_address<&>.object_id<=>1227030954_34<&>.field<=>.transactions => .type app_address .object_id 1227030954_34 .field .transactions */ } ::set rwb1_debug 0; if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::name_value_unwrap,1000.0,sargs==$sargs";} ::package require textutil; # needed for splitx ::set Wrapped [::sargs::get $sargs .wrapped]; if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::name_value_unwrap,1000.1,wrapped==$Wrapped";} ::if {$Wrapped eq ""} { ::qw::bug 314120120427083656 "[::qw::procname] - no wrapped list."; } ::set Tag [::string tolower [::sargs::get $sargs .tag]]; ::if {$Tag eq ""} { ::set Tag "wrapped_name_value"; } if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::name_value_unwrap,1000.2,tag==$Tag";} /* { Use string map to remove the begin and end tags. If we ever nest wrapped fields more sophisticated parsing will be necessary. We use splitx to separate the name/value pairs from each other and then the names from the values for each pair. */ } ::set Wrapped [::string map [::list "<$Tag>" "" "" ""] $Wrapped]; if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::name_value_unwrap,1000.3,wrapped==$Wrapped";} ::set NameValueList [::textutil::splitx $Wrapped "<&>"]; if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::name_value_unwrap,1000.4,NameValueList==$NameValueList";} ::set ResultList [::list]; ::foreach NameValuePair $NameValueList { if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::name_value_unwrap,1000.5,NameValuePair==$NameValuePair";} ::set ResultList [::concat $ResultList [::textutil::splitx $NameValuePair "<=>"]]; } if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::name_value_unwrap,1000.6,ResultList==$ResultList";} ::return $ResultList; } ::namespace eval ::qw::odb::database {}; ::proc ::qw::odb::database::dump_object_structures {sargs} { ::set Database [::sargs::get $sargs .database]; ::set DatabasePath [$Database cpp_database_path]; ::set OutFile [::sargs::get $sargs .out_file]; ::if {$OutFile ne ""} { ::if {[::file pathtype $OutFile] eq "relative"} { ::set Folder [::sargs::get [::qw::file::info .path $DatabasePath] .folder]; ::set OutFile [::file join $Folder $OutFile]; } } ::if {$OutFile eq ""} { ::set Folder [::sargs::get [::qw::file::info .path $DatabasePath] .folder]; ::set Name [::sargs::get [::qw::file::info .path $DatabasePath] .name]; ::set ShortVersion [::string map [::list "." ""] $::qw_version]; } ::set IfsFile [$Database cpp_file_factory]; ::qw::finally [::list $IfsFile cpp_destroy]; $IfsFile cpp_file_open .path "/odb/object"; ::set ProgressLimit [$IfsFile cpp_record_count]; ::set Progress ""; ::set ProgressMinimum 1; ::if {$ProgressLimit>=$ProgressMinimum} { ::set Progress [::itcl::local ::QW::PROGRESS::OPERATION #auto \ .database_id [$Database cpp_database_id_get] \ .file $DatabasePath \ .limit $ProgressLimit \ .resolution 109 \ .operation "dumping object structures" \ .status "$DatabasePath dumping object structures to $OutFile." \ ]; } ::set Handle [::open $OutFile w+]; ::qw::finally [::list ::close $Handle]; ::set Count 0; ::for {::set Record [$IfsFile cpp_record_first];} {$Record ne ""} {::set Record [$IfsFile cpp_record_next $Record];} { ::if {$Progress ne ""} { $Progress increment; } ::set OS [::sargs::get $Record .data]; ::incr Count; ::puts $Handle "$Count=========================================================\n[::sargs::format .structure $OS]"; } } ::proc ::qw::odb::database::build_odb_deriveds_index_id {sargs} { /* { Builds .odb_deriveds.index/id index. Traverse /odb/object and adds one record for each object, except the root object. Only the .count rb is used so subsequent "reorganize" pass will have to pad index records with the other amounts. Notes: Pre-paf reorganize copied the odb_deriveds primary directly to the new target database that was used to reorganize the old source database. Here we instead build the primary directly from objects in the /odb/object file. This generalizes the process and allows it to be used not only by reorganize, but also by database_minimized_restore and potentially other low-level ifs database tools. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,build_odb_deriveds_index_id,1000.0,sargs==$sargs";} ::set Database [::sargs::get $sargs .database]; ::if {![::qw::command_exists $Database]} { ::qw::bug 314120181025083248 "[::qw::procname] - no .database argument."; } ::set IfsFile [$Database cpp_file_factory]; ::qw::finally [::list $IfsFile cpp_destroy]; $IfsFile cpp_file_open .path "/odb/object"; ::set ProgressLimit [$IfsFile cpp_record_count]; ::sargs::var::set sargs .command "build_deriveds_primary"; ::set sargs [::qw::database_utilities_paf::progress_setup $sargs .progress_limit $ProgressLimit .status "Building deriveds primary indexes."]; ::set Count 0; ::for {::set Record [$IfsFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$IfsFile cpp_record_next $Record];} { ::incr Count; ::set sargs [::qw::database_utilities_paf::progress_increment $sargs .increment 1]; ::set OS [::sargs::get $Record .data]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::if {$ObjectId eq "1"} { # Skip the root object as it has no base. ::continue; } ::set BaseObjectId [::sargs::get $OS .system.base_object_id]; ::set BaseOS [$Database cpp_object_structure_load .object_id $BaseObjectId]; ::set BaseClassPath [::sargs::get $BaseOS .system.class_path]; ::set IndexPath /odb/index$BaseClassPath.odb_deriveds.index/id; ::set Id [::sargs::get $OS .system.id]; ::set After [::sargs \ .key [::list string $BaseObjectId string [::sargs::get $OS .system.id] string "/$ObjectId.odb_base"] \ .amounts [::list .count 1.0] \ ]; $Database cpp_file_record_insert .path $IndexPath .after $After; } ::if {$rwb1_debug} {::puts "rwb1_debug,build_odb_deriveds_index_id,1000.99,$ProgressLimit primary index records added.";} ::return [::qw::database_utilities_paf::progress_finalize $sargs]; } ::proc ::qw::odb::object_structure_arrange_fields {sargs} { /* { Puts the fields in .meta .system .data etc order. */ } ::set OS [::sargs::get $sargs .object_structure]; ::if {[::sargs::size $OS]==0} { ::qw::bug 314120120618092116 "[::qw::procname] - no object structure."; } ::set Result [::sargs]; ::set Meta [::sargs::get $OS .meta]; ::if {[::sargs::size $Meta]!=0} { ::sargs::var::set Result .meta $Meta; ::sargs::var::unset OS .meta; } ::set System [::sargs::get $OS .system]; ::if {[::sargs::size $System]!=0} { ::sargs::var::set Result .system $System; ::sargs::var::unset OS .system; } ::set Data [::sargs::get $OS .data]; ::if {[::sargs::size $Data]!=0} { ::sargs::var::set Result .data $Data; ::sargs::var::unset OS .data; } ::sargs::var::+= Result $OS; ::return $Result; } ::proc ::qw::odb::path_reverse {sargs} { ::set Path [::sargs::get $sargs .path]; ::if {$Path eq ""} { ::return $Path; } ::set List1 [::split [::string range $Path 1 end] /]; ::set i [::llength $List1]; ::incr i -1; while {$i>=0} { ::lappend List2 [::lindex $List1 $i]; ::incr i -1; } ::return [::join $List2 /]/; } ::proc ::qw::odb::is_private_window_class {sargs} { /* { Determines whether the object structure is for a private window class. It is a private class iff it is a class and it's a window class and it's id has no letters, i.e. just digits and underscores (except for special kludges described below). That's because it's id should match an application object_id. */ } ::qw::bug 314120130521133914 "[::qw::procname] - deprecated."; ::set OS [::sargs::get $sargs .os]; ::if {![::sargs::boolean_get $OS .system.is_class]} { ::return 0; } ::if {[::string first "/OBJECT/SYSTEM/WINDOW" [::sargs::get $OS .system.path]]!=0} { ::return 0; } ::set Id [::sargs::get $OS .system.id]; ::switch -- $Id { /BUDGET_BALANCE - /JOURNAL_BAL - /BUDGET - /DEFAULT { /* { Ok, what's this all about. In order to find special instances using their id path certain non-class instances were given special odb_ids. We can use these ids to find the application object. Note that these are not like the object id of the application object and therefore will require kludges when looking things up as well. Note: I scanned the install file for NewViews to find these. Hope there aren't any more. */ } ::return 1; } } ::set Length [::string length $Id]; ::for {::set i 1} {$i<$Length} {::incr i} { /* { We start at index 1 to skip leading slash. */ } ::set Char [::string index $Id $i]; ::if {[::string is digit $Char]} { ::continue; } ::if {$Char eq "_"} { ::continue; } ::return 0; } ::return 1; } ::proc ::qw::odb::seek_key_go_item_parse_components {sargs} { /* { Takes a value that user is typing into a go item and returns a list of type/value pairs. Each type will be either string or number. Example: Value==905-479-2222 Result==number 905 string - number 479 string - number 2222 226 */ } ::set Value [::sargs::get $sargs .value]; ::if {$Value eq ""} { ::qw::bug "314120051128142311" "Encountered unexpected empty value."; } ::if {[::string is digit [::string index $Value 0]]} { ::set Type "number"; } else { ::set Type "string"; } ::set First 0; ::set Current 1; ::set Result ""; ::while {1} { ::if {$Current==[::string length $Value]} { ::lappend Result $Type; ::lappend Result [::string range $Value $First [::expr {$Current-1}]]; break; } ::if {$Type eq "string"} { ::if {[::string is digit [::string index $Value $Current]]} { ::lappend Result $Type; ::lappend Result [::string range $Value $First [::expr {$Current-1}]]; ::set First $Current; ::set Type "number"; ::incr Current; ::continue; } ::incr Current; ::continue; } ::if {![::string is digit [::string index $Value $Current]]} { ::lappend Result $Type; ::lappend Result [::string range $Value $First [::expr {$Current-1}]]; ::set First $Current; ::set Type "string"; ::incr Current; ::continue; } ::incr Current; ::continue; } ::return $Result; } ::proc ::qw::odb::is_valid_address {sargs} { /* { ::qw::odb::20040410091555::/123.postings.index/date 01234567890123456789012345678 */ } ::set Address [::sargs::get $sargs .address]; ::if {[::string length $Address]<28} { /* { Shortest could be root object with /1 path. Note "" is not a valid address */ } ::return 0; } ::if {[::string range $Address 0 10] ne "::qw::odb::"} { ::return 0; } ::if {![::string is digit [::string range $Address 11 24]]} { ::return 0; } ::if {[::string range $Address 25 27] ne "::/"} { ::return 0; } ::return 1; } ::proc ::qw::odb::audit_record_prune {sargs} { /* { Two audit records have probably been merged and this method is called to prune out any nodes that have the same .before and .after values. Note also that eliminating such nodes could leave empty parent nodes that also have to be pruned. Hence the second pass. */ } # 2.27.2 - next line was corrected #::set Paths [::sargs::select_field .structure $sargs .dield .before]; ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug::qw::odb::adult_record_prune,1000.0";} ::set FieldList [::sargs::select_field .structure $sargs .field .before]; ::foreach Field $FieldList { ::if {[::sargs::get $sargs $Field.before] eq [::sargs::get $sargs $Field.after]} { ::if {[::sargs::exists $sargs $Field]} { ::sargs::var::unset sargs $Field; } } } ::set FieldList [::sargs::select_all .structure $sargs]; ::set Done 0; ::while {!$Done} { ::set Done 1; ::foreach Field $FieldList { ::if {[::string first ".before" $Field]>=0} { ::continue; } ::if {[::string first ".after" $Field]>=0} { ::continue; } ::if {[::sargs::get $sargs $Field] eq ""} { ::if {[::sargs::exists $sargs $Field]} { ::sargs::var::unset sargs $Field; ::set Done 0; } } } } ::if {$rwb1_debug} {::puts "rwb1_debug::qw::odb::adult_record_prune,1000.99";} ::return $sargs; } ::proc ::qw::odb::audit_records_merge {Changes1 Changes2} { /* { We have two audit records each with internal .before and .after values, that we want to compress into a single record representing the net change. */ } ::set rwb1_debug 0; ::if {$::qw::verbose(audit_trail)} { ::set rwb1_debug 2; } ::if {$rwb1_debug} {::puts "rwb1_debug::qw::odb::audit_records_merge,1000.0";} ::if {$rwb1_debug} {::puts "rwb1_debug::qw::odb::audit_records_merge,1000.0.0,changes1==\n[::sargs::format .structure $Changes1]";} ::if {$rwb1_debug} {::puts "rwb1_debug::qw::odb::audit_records_merge,1000.0.1,changes2==\n[::sargs::format .structure $Changes2]";} ::set Result ""; ::set Result $Changes1; ::foreach Path [::sargs::select_field .structure $Changes2 .field .before] { ::if {![::sargs::exists $Result $Path]} { ::sargs::var::set Result $Path [::sargs::get $Changes2 $Path]; ::continue; } ::set After1 [::sargs::get $Result $Path.after]; ::set Before2 [::sargs::get $Changes2 $Path.before]; ::if {![::sargs::is_equal $After1 $Before2]} { ::puts "After1==$After1" ::puts "Before2==$Before2" ::puts "Changes1==\n[::sargs::format .structure $Changes1]" ::puts "Changes2==\n[::sargs::format .structure $Changes2]" /* { This bug occurred 50 times since 2017. 2.35.0 Added the info fields to the exception. The putss's weren't doing any good. */ } ::qw::bug \ .bug_id "314120041017164444" \ .text "Expected first audit record .after value to equal second audit record .before value." \ .after1 $After1 \ .before2 $Before2 \ .changes1 $Changes1 \ .changes2 $Changes2 \ ; } ::sargs::var::set Result $Path.after [::sargs::get $Changes2 $Path.after]; } ::if {$rwb1_debug} {::puts "rwb1_debug::qw::odb::audit_records_merge,1000.98,result==\n[::sargs::format $Result]";} ::set Result [::qw::odb::audit_record_prune $Result]; ::if {$rwb1_debug} {::puts "rwb1_debug::qw::odb::audit_records_merge,1000.99,result==\n[::sargs::format $Result]";} ::return $Result; } ::proc ::qw::odb::interactive_index_line_number_get {sargs} { # 2.27.1 /* { Usage: ::qw::odb::interactive_index_line_number_get \ .database $Database \ .index /1403029461_78848.accounts.index/interactive \ .reference /1403029461_78848.report \ ; Comments: Given an interactive index and a reference, returns the line number (base 1) of the reference in that interactive index. Performs two seeks: Using the index and reference as key, seeks into the odometer file to get the odometer. Using the odometer and reference as key, seeks into the interactive index to get the line number. Example odometer file record: .key {string /1114888344_3.odb_deriveds.index/interactive string /1403029461_78848.odb_base} .data {.odometer 43.0} .amounts {.count 1.0} Example interactive file record: .key {string 1167840188_3843 bcd 18.0 string /1114888344_498.report} .amounts {.count 1.0} .totals {.count 22.0} */ } ::set Database [::sargs::get $sargs .database]; ::if {$Database eq ""} { ::qw::throw "[::qw::procname] - no .database argument."; } ::set Index [::sargs::get $sargs .index]; ::if {$Index eq ""} { ::qw::throw "[::qw::procname] - no .index argument."; } ::set Reference [::sargs::get $sargs .reference]; ::if {$Reference eq ""} { ::qw::throw "[::qw::procname] - no .reference argument."; } ::set Index [::qw::odb::address_to_disk .address $Index]; ::set Reference [::qw::odb::address_to_disk .address $Reference]; ::set OdometerRecord [$Database cpp_file_record_read \ .path /odb/odometer \ .key [::list string $Index string $Reference] \ ]; ::if {[::sargs::size $OdometerRecord]==0} { ::qw::throw "[::qw::procname] - no odometer record for index $Index reference $Reference."; } ::set Odometer [::sargs::get $OdometerRecord .data.odometer]; ::if {$Odometer eq ""} { ::qw::throw "[::qw::procname] - no odometer in record \"$OdometerRecord\"."; } ::set IndexField [::qw::odb::field_extract .address $Index]; ::set IndexOS [$Database cpp_object_structure_load .address $Index]; ::set IndexObjectId [::sargs::get $IndexOS .system.object_id]; ::set IndexClassPath [::sargs::get $IndexOS .system.class_path]; ::set InteractiveRecord [$Database cpp_file_record_read \ .path /odb/index$IndexClassPath$IndexField \ .range.begin [::list string $IndexObjectId] \ .range.end [::list string $IndexObjectId] \ .key [::list string $IndexObjectId bcd $Odometer string $Reference] \ .totals_load 1 \ ]; ::if {[::sargs::size $InteractiveRecord]==0} { ::qw::throw "[::qw::procname] - no odometer record for index==\"$Index\",reference==\"$Reference\",Odometer==\"$Odometer\"."; } ::set LineNumber [::sargs::get $InteractiveRecord .totals.count]; ::return $LineNumber; } ::proc ::qw::odb::database_header_get {sargs} { /* { Returns the database header of a file that is not currently open. At this time cannot be used to get the header of a remote database. This proc was originally created for batch_import but now is also used when opening any database to check its version (when not already open). .warning1 {**************************** WARNING ***************************} .warning2 {Uncontrolled changes to this file will render NewViews unusable.} .warning3 {**************************** WARNING ***************************} .volume { .bytes 2113536 .block_bytes 512 } .checksum 50377 .odb { .version 2.28 .build 20141204 .patch_level 0_alpha .next_index_id 7211 .next_object_id 617 .database_id 20141204115947 .database_type workstation .blocks 4096 .inodes { .id 1 .root 1337 .branch_order 64 .leaf_order 64 .path / .schema { .key string .amounts .count } } .recovery { .id 112 .blocks 0 .start_block 4096 } .free { .blocks 815 .head 3129 } .state closed } */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::database_header_get,1000.1,sargs==$sargs";} ::set DatabasePath [::sargs::get $sargs .file]; ::if {$DatabasePath eq ""} { ::set DatabasePath [::sargs::get $sargs .database_path]; } ::qw::try { ::if {$DatabasePath eq ""} { ::qw::throw "No file was specified."; } ::if {![::file exists $DatabasePath]} { ::qw::throw "Could not find file \"$DatabasePath\"."; } ::if {![::file isfile $DatabasePath]} { ::qw::throw "\"$DatabasePath\" is not a file."; } /* { #2.34.4 ::if {[::file executable $DatabasePath]} { ::qw::throw "\"$DatabasePath\" is an executable file."; } */ } ::if {![::file readable $DatabasePath]} { ::qw::throw "File \"$DatabasePath\" is not readable by the current user."; } ::switch -- $::tcl_platform(platform) { "windows" { } "unix" { /* { 2.32.3 We would like to use the Tclx ::flock command to determine if the database file is open but it doesn't seem to work. So we added a [::qw::system] cpp_flock_is_locked whose implementation calls the linux system api function directly. That seems to work, although somewhat awkward. */ } ::set IsLocked [[::qw::system] cpp_flock_is_locked .database_path $DatabasePath]; ::if {$IsLocked} { ::qw::throw \ .error_id "host_file_already_open" \ .text "Can't open \"$DatabasePath\" because it is in use and access is denied." \ ; } } } ::qw::try { ::set Handle [::open $DatabasePath r]; ::qw::finally [::list ::close $Handle]; # 2.32.3 } catch Exception { ::qw::throw "Encountered exception: $Exception"; } ::qw::try { /* { 2.32.3 - in linux the following statement (without the 16384) read the entire database into memory and caused serious memory allocation problems on huge databases. Limiting the read should work on bith linux and windows. */ } ::set Data [::read $Handle 16384]; } catch Exception { ::qw::throw "Encountered exception: $Exception"; } ::set Terminator [::binary format c 0]; ::set Index [::string first $Terminator $Data]; ::incr Index -1; ::set Header [::string range $Data 0 $Index]; ::if {[::sargs::is_primitive $Header]} { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::database_header_get,1000.xx,Header==$Header";} ::qw::throw \ .text "Invalid database header." \ .help_id ??? \ ; } ::return $Header; } catch Exception { ::qw::throw [::qw::exception::nest .sub $Exception .super "Can't open \"$DatabasePath\"."]; } } ::proc ::qw::odb::name_list_to_key {sargs} { ::set NameList [::sargs::get $sargs .name_list]; ::if {[::llength $NameList]==0} { ::qw::bug 314120120308130837 "[::qw::procname] - empty name_list."; } ::set NameList [::string tolower $NameList]; ::set Key ""; ::foreach Element $NameList { ::append Key $Element; } ::return $Key; } ::proc ::qw::odb::get_class_list {sargs} { /* { Usage: get_all_classes .database $Database ?.class_path $ClassPath? ?.return_type class_path/object_id/address?; Returns a list of classes under the class specified by the .class_path argument. If .classpath is not specified than the toor object class is the default. The result list is in the form of class paths returned by default but you can specify a .return_type of object_id or address (or class_path). The order of the objects in the returned list is undefined, but in practice it is top-down in creation order. */ } ::set Database [::sargs::get $sargs .database]; ::if {$Database eq ""} { ::qw::bug 314120170609194918 "[::qw::procname] - no .database argument."; } ::set ClassPath [::sargs::get $sargs .class_path]; ::if {$ClassPath ne ""} { /* { If .class_path is specified this is the first call; otherwise we are in a recursive call. We unset .class_path before recursing and replace it in sargs with .object_id. */ } ::set OS [$Database cpp_object_structure_load .path $ClassPath]; ::sargs::var::unset sargs .class_path; ::set ObjectId [::sargs::get $OS .system.object_id]; } else { ::set ObjectId [::sargs::get $sargs .object_id]; ::if {$ObjectId eq ""} { /* { No class_path or object id. This is an original call without a class_path so we use the root object by default. */ } ::set OS [$Database cpp_object_structure_load .path "/OBJECT"]; ::set ClassPath /OBJECT; ::set ObjectId [::sargs::get $OS .system.object_id]; } else { /* { We are recursing from above on the .class_kids object ids. */ } ::set OS [$Database cpp_object_structure_load .object_id $ObjectId]; ::set ClassPath [::sargs::get $OS .system.class_path]; } } ::if {![::sargs::boolean_get $OS .system.is_class]} { ::qw::bug 314120170609194237 "[::qw::procname] - $ClassPath is not a class."; } ::switch -- [::sargs::get $sargs .return_type] { "object_id" { ::set Result $ObjectId; } "class_path" { ::set Result $ClassPath; } "address" { ::set Result [::qw::odb::address_from_disk .database $Database .object_id $ObjectId]; } default { ::set Result $ClassPath; } } ::set KidList [::sargs::get $OS .system.class_kids]; ::foreach Kid $KidList { ::set Result [::concat $Result [[::qw::procname] $sargs .object_id $Kid]]; } ::return $Result; } ::proc ::qw::odb::database_information_get {sargs} { ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::database_information_get,1000.0,sargs==$sargs";} ::set Database [::sargs::get $sargs .database]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::database_information_get,1000.0.0";} ::set DatabasePath [$Database cpp_database_path]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::database_information_get,1000.0.1";} ::set DatabaseId [$Database cpp_database_id]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::database_information_get,1000.0.2";} ::set DatabaseHeader [$Database cpp_database_header_get]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::database_information_get,1000.0.3";} ::sargs::var::set Record .database_header $DatabaseHeader; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::database_information_get,1000.0.4";} ::sargs::var::set Record .database_path $DatabasePath; ::sargs::var::set Record .database_id $DatabaseId; ::sargs::var::set Record .database_size [$Database cpp_database_size]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::database_information_get,1000.1";} ::sargs::var::set Record .object_count [$Database cpp_file_record_count \ .path /odb/object \ ]; ::set DatabaseType [::sargs::get $DatabaseHeader .odb.database_type]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::database_information_get,1000.2,DatabaseType==$DatabaseType";} ::switch -- $DatabaseType { "application" { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::database_information_get,1000.3";} ::set ClassPath "/OBJECT/NEWVIEWS/REPORT"; ::set OS [$Database cpp_object_structure_load .path $ClassPath]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::sargs::var::set Record .report_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.odb_deriveds.index/name_closure \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::set ClassPath "/OBJECT/NEWVIEWS/ACCOUNT"; ::set OS [$Database cpp_object_structure_load .path $ClassPath]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::sargs::var::set Record .company_name [::sargs::get $OS .data.address.company]; ::sargs::var::set Record .account_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.odb_deriveds.index/name_closure \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::sargs::var::set Record .posting_account_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.odb_deriveds.index/name_closure/posting \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::set ClassPath "/OBJECT/NEWVIEWS/JOURNAL"; ::set OS [$Database cpp_object_structure_load .path $ClassPath]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::sargs::var::set Record .journal_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.odb_deriveds.index/name_closure \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::sargs::var::set Record .transaction_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.transactions.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::set ClassPath "/OBJECT/NEWVIEWS/JOURNAL/PAYROLL/PAYCHECK/CANADA"; ::set OS [$Database cpp_object_structure_load .path $ClassPath]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::sargs::var::set Record .paycheck_canada_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.transactions.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; # get the date of the last paycheck ::set LastRecord [$Database cpp_file_record_last \ .path /odb/index${ClassPath}.transactions.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::set LastDate ""; ::if {[::sargs::size $LastRecord]!=0} { ::set OS [$Database cpp_object_structure_load .address [::lindex [::sargs::get $LastRecord .key] end]]; ::set LastDate [::sargs::get $OS .data.date]; } ::sargs::var::set Record .paycheck_canada_date_last $LastDate; ::set ClassPath "/OBJECT/NEWVIEWS/JOURNAL/PAYROLL/PAYCHECK/USA"; ::set OS [$Database cpp_object_structure_load .path $ClassPath]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::sargs::var::set Record .paycheck_usa_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.transactions.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; # get the date of the last paycheck ::set LastRecord [$Database cpp_file_record_last \ .path /odb/index${ClassPath}.transactions.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::set LastDate ""; ::if {[::sargs::size $LastRecord]!=0} { ::set OS [$Database cpp_object_structure_load .address [::lindex [::sargs::get $LastRecord .key] end]]; ::set LastDate [::sargs::get $OS .data.date]; } ::sargs::var::set Record .paycheck_usa_date_last $LastDate; ::set ClassPath "/OBJECT/NEWVIEWS/SYSTEM/TRANSACTION/PAYROLL/TIMECARD"; ::set OS [$Database cpp_object_structure_load .path $ClassPath]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::sargs::var::set Record .timecard_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::set ClassPath "/OBJECT/NEWVIEWS/SYSTEM/PAYRUN/CANADA"; ::set OS [$Database cpp_object_structure_load .path $ClassPath]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::sargs::var::set Record .payrun_canada_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::set ClassPath "/OBJECT/NEWVIEWS/SYSTEM/PAYRUN/USA"; ::set OS [$Database cpp_object_structure_load .path $ClassPath]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::sargs::var::set Record .payrun_usa_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::set ClassPath "/OBJECT/NEWVIEWS/SYSTEM/EMPLOYEE/CANADA"; ::set OS [$Database cpp_object_structure_load .path $ClassPath]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::sargs::var::set Record .employee_canada_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::set ClassPath "/OBJECT/NEWVIEWS/SYSTEM/EMPLOYEE/USA"; ::set OS [$Database cpp_object_structure_load .path $ClassPath]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::sargs::var::set Record .employee_usa_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::set ClassPath "/OBJECT/NEWVIEWS/ACCOUNT"; ::set OS [$Database cpp_object_structure_load .path $ClassPath]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::sargs::var::set Record .posting_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.postings.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::set ClassPath "/OBJECT/SYSTEM/USER"; ::set OS [$Database cpp_object_structure_load .path $ClassPath]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::sargs::var::set Record .user_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::set ClassPath "/OBJECT/SYSTEM/SESSION"; ::set OS [$Database cpp_object_structure_load .path $ClassPath]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::sargs::var::set Record .session_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::set ClassPath "/OBJECT/SYSTEM/AUDIT"; ::set OS [$Database cpp_object_structure_load .path $ClassPath]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::sargs::var::set Record .audit_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::if {[$Database cpp_file_exists .path /odb/audit_record]} { ::sargs::var::set Record .hibernated_audit_count [$Database cpp_file_record_count \ .path /odb/audit_record \ ]; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::database_information_get,1000.4";} } "server" { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::database_information_get,1000.5";} ::set ClassPath "/OBJECT/SERVER/PORT"; ::set OS [$Database cpp_object_structure_load .path $ClassPath]; ::set ObjectId [::sargs::get $OS .system.object_id]; /* { The port class has .database_groups and .databases collections whose id indexes have closure. The .odb_deriveds collection does not have closure but we don't expect a hierarchy of ports. Note that several nv classes have .odb_derivdes.index/name_closure, but server classes do not. Whoops. The PORT.database_groups indexes have no closure. */ } ::sargs::var::set Record .port_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::sargs::var::set Record .offered_database_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.databases.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::set ClassPath "/OBJECT/SERVER/DATABASE_GROUP"; ::set OS [$Database cpp_object_structure_load .path $ClassPath]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::sargs::var::set Record .database_group_count [$Database cpp_file_record_count \ .path /odb/index${ClassPath}.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::database_information_get,1000.6";} } "workstation" { ::qw::bug 314120170315105541 "[::qw::procname] - don't have any reason to process workstations at this time."; } default { ::qw::bug 314120170315105542 "[::qw::procname] - invalid database type \"$DatabaseType\"."; } } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::database_information_get,1000.99,database_record==\n[::sargs::format $Record]";} ::return $Record; } ::proc ::qw::odb::address_from_object_id {sargs} { #2.34.11 ::set Database [::sargs::get $sargs .database]; ::if {![::qw::command_exists $Database]} { ::qw::bug 314120210805171401 "[::qw::procname] - invalid database \"$Database\"."; } ::if {[::sargs::get $sargs .object_id] eq ""} { ::qw::bug 314120210805171402 "[::qw::procname] - no .object_id argument."; } ::return [$Database cpp_get_address_from_object_id $sargs]; } ::proc ::qw::odb::address_from_path {sargs} { #2.34.11 /* { Usage: ::set Address [::qw::odb::address_from_path .path /OBJECT.odb_deriveds]; Result==::qw::odb::20070607175816::/1.odb_deriveds Note: the field is not stripped. */ } ::set Database [::sargs::get $sargs .database]; ::if {![::qw::command_exists $Database]} { ::qw::bug 314120210806080404 "[::qw::procname] - invalid database \"$Database\"."; } ::set Path [::sargs::get $sargs .path]; ::if {$Path eq ""} { ::qw::bug 314120210806080405 "[::qw::procname] - no .path argument."; } ::set OS [$Database cpp_object_structure_find .path $Path]; ::if {[::sargs::size $OS]==0} { ::qw::bug 314120210806080406 "[::qw::procname] - could not find object with path \"$Path\"."; } ::set Field [::qw::odb::field_extract .path $Path]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::set Address [$Database cpp_get_address_from_object_id .object_id $ObjectId]; ::return $Address$Field; } ::proc ::qw::odb::collection_field_extract {sargs} { /* { 2.36.0 ::Usage: ::set CollectionField [collection_field_from_index_field .odb_deriveds.index/name]; returns -> .odb_deriveds We have an index field and we want the collection field that the index is under. */ } ::set IndexField [::sargs::get $sargs .index_field]; ::set Pos [::string first ".index" $IndexField]; ::if {$Pos<0} { ::qw::bug 314120210909170806 "[qw::methodname] - invalid index field \"$IndexField\"."; } ::set CollectionField [::string range $IndexField 0 [::expr {$Pos-1}]]; ::return $CollectionField; } ::proc ::qw::odb::index_is_interactive {sargs} { /* { This code is also duplicated in the odb::database for extra speed when calling from cpp. This proc let's us call the method without a database or odb index object. 2.37.0 Usage: ::set IsInteractive [::qw::odb::index_is_interactive .path $IndexPath]; Usage: ::set IsInteractive [::qw::odb::index_is_interactive .address $IndexAddress]; The index class has odb_is_interactive so what is this method doing here? Answer is we need a low-level ability to check whether an index is interactive, i.e. without loading full objects, and perhaps just checking the ifs file path for example. It turns out that all interactive application index havw /interactive in the odb field name and also the ifs file path. A indow database follows that rule but adds three indexes that don't have /interactive in them. */ } ::set Value [::sargs::get $sargs .path]; ::if {$Value eq ""} { ::set Value [::sargs::get $sargs .address]; } ::if {$Value eq ""} { ::qw::bug 314120221007152728 "::qw::odb::index_is_interactive - no .address or .path argument."; } ::if {[::string first "/interactive" $Value]>=0} { ::return 1; } ::if {[::string first ".index/z" $Value]>=0} { ::return 1; } ::if {[::string first ".index/tile" $Value]>=0} { ::return 1; } ::if {[::string first ".index/tab" $Value]>=0} { ::return 1; } return 0; } ::proc ::qw::odb::employee_name_formatted {sargs} { ::set Format [::sargs::get $sargs .format]; ::if {$Format eq ""} {::set Format $::qw::name::formats(printable);} ::set OS [::sargs::get $sargs .object_structure]; # The format specifiers: # %salutation% # %firstname% # %firstinitial% # %middlename% # %middleinitial% # %middleinitialdot% middle initial followed by a period. null if no initial # %lastname% # %lastinitial% ::set Salutation [::string trim [::sargs::get $OS .data.employee_name.salutation]]; ::set First [::string trim [::sargs::get $OS .data.employee_name.first]]; ::set Middle [::string trim [::sargs::get $OS .data.employee_name.middle]]; ::set Last [::string trim [::sargs::get $OS .data.employee_name.last]]; ::if {"$Salutation$First$Middle$Last" eq ""} {::return "";} # ::set Result $Format; ::set Result [::regsub -all "%salutation%" $Result $Salutation]; ::set Result [::regsub -all "%firstname%" $Result $First]; ::set Result [::regsub -all "%firstinitial%" $Result [::string index $First 0]]; ::set Result [::regsub -all "%middlename%" $Result $Middle]; ::set Result [::regsub -all "%middleinitial%" $Result [::string index $Middle 0]]; ::if {$Middle eq ""} { ::set Result [::regsub -all " %middleinitialdot%" $Result ""]; ::set Result [::regsub -all "%middleinitialdot% " $Result ""]; ::set Result [::regsub -all "%middleinitialdot%" $Result ""]; } else { ::set Result [::regsub -all "%middleinitialdot%" $Result [::string index $Middle 0].]; } ::set Result [::regsub -all "%lastname%" $Result $Last]; ::set Result [::regsub -all "%lastinitial%" $Result [::string index $Last 0]]; # ::return [::string trim [::regsub -all " " $Result " "]]; } /* { ::proc ::qw::odb::employee_name_formatted_sortable {sargs} { /* { The employee+name method defaults the format in this case. Will see if we need it. ::if {$Format eq ""} {::set Format $::qw::name::formats(printable);} */ } ::set Format $::qw::name::formats(sortable) ::set OS [::sargs::get $sargs .object_structure]; ::set Salutation [::string trim [::sargs::get $OS .data.employee_name.salutation]]; ::set First [::string trim [::sargs::get $OS .data.employee_name.first]]; ::set Middle [::string trim [::sargs::get $OS .data.employee_name.middle]]; ::set Last [::string trim [::sargs::get $OS .data.employee_name.last]]; ::if {"$Salutation$First$Middle$Last" eq ""} { ::return ""; } ::set Result $Format; ::set Result [::regsub -all "%salutation%" $Result $Salutation]; ::set Result [::regsub -all "%firstname%" $Result $First]; ::set Result [::regsub -all "%firstinitial%" $Result [::string index $First 0]]; ::set Result [::regsub -all "%middlename%" $Result $Middle]; ::set Result [::regsub -all "%middleinitial%" $Result [::string index $Middle 0]]; ::if {$Middle eq ""} { ::set Result [::regsub -all " %middleinitialdot%" $Result ""]; ::set Result [::regsub -all "%middleinitialdot% " $Result ""]; ::set Result [::regsub -all "%middleinitialdot%" $Result ""]; } else { ::set Result [::regsub -all "%middleinitialdot%" $Result [::string index $Middle 0].]; } ::set Result [::regsub -all "%lastname%" $Result $Last]; ::set Result [::regsub -all "%lastinitial%" $Result [::string index $Last 0]]; # ::return [::string trim [::regsub -all " " $Result " "]]; } */ } /* { ::proc ::qw::odb::employee_name_formatted_printable {sargs} { /* { The employee+name method defaults the format in this case. Will see if we need it. ::if {$Format eq ""} {::set Format $::qw::name::formats(printable);} */ } ::set Format $::qw::name::formats(printable) ::set OS [::sargs::get $sargs .object_structure]; ::set Salutation [::string trim [::sargs::get $OS .data.employee_name.salutation]]; ::set First [::string trim [::sargs::get $OS .data.employee_name.first]]; ::set Middle [::string trim [::sargs::get $OS .data.employee_name.middle]]; ::set Last [::string trim [::sargs::get $OS .data.employee_name.last]]; ::if {"$Salutation$First$Middle$Last" eq ""} { ::return ""; } ::set Result $Format; ::set Result [::regsub -all "%salutation%" $Result $Salutation]; ::set Result [::regsub -all "%firstname%" $Result $First]; ::set Result [::regsub -all "%firstinitial%" $Result [::string index $First 0]]; ::set Result [::regsub -all "%middlename%" $Result $Middle]; ::set Result [::regsub -all "%middleinitial%" $Result [::string index $Middle 0]]; ::if {$Middle eq ""} { ::set Result [::regsub -all " %middleinitialdot%" $Result ""]; ::set Result [::regsub -all "%middleinitialdot% " $Result ""]; ::set Result [::regsub -all "%middleinitialdot%" $Result ""]; } else { ::set Result [::regsub -all "%middleinitialdot%" $Result [::string index $Middle 0].]; } ::set Result [::regsub -all "%lastname%" $Result $Last]; ::set Result [::regsub -all "%lastinitial%" $Result [::string index $Last 0]]; # ::return [::string trim [::regsub -all " " $Result " "]]; } */ } ::proc ::qw::odb::transaction_is_boomerang {sargs} { ::set OS [::sargs::get $sargs .object_structure]; /* { A transaction is a boomerang iff the qw_get of the .posting/debit.account and the .posting/credit.account are both non-empty and point to the same account. */ } ::set DebitAccount [::sargs::get $OS .data.posting/debit.account]; ::if {$DebitAccount eq ""} { ::return 0; } ::set CreditAccount [::sargs::get $OS .data.posting/credit.account]; ::if {$CreditAccount eq ""} { ::return 0; } ::if {$DebitAccount eq $CreditAccount} { ::return 1; } ::return 0; } ::proc ::qw::odb::posting_is_open {sargs} { ::set OS [::sargs::get $sargs .object_structure]; # the reference's object structure. ::set Reference [::sargs::get $sargs .reference]; # account reference address ::set ReferenceFieldPath [::qw::odb::field_extract .address $Reference]; ::set PostingFieldPath [::sargs::outer .field $ReferenceFieldPath]; ::set Reconcile [::sargs::get $OS .data$PostingFieldPath.reconcile]; ::if {$Reconcile ne ""} { ::return 0; } ::return 1; } ::proc ::qw::odb::posting_is_closed {sargs} { ::set OS [::sargs::get $sargs .object_structure]; # the reference's object structure. ::set Reference [::sargs::get $sargs .reference]; # account reference address ::set ReferenceFieldPath [::qw::odb::field_extract .address $Reference]; ::set PostingFieldPath [::sargs::outer .field $ReferenceFieldPath]; ::set Reconcile [::sargs::get $OS .data$PostingFieldPath.reconcile]; ::if {$Reconcile eq ""} { ::return 0; } ::return 1; } ::proc ::qw::odb::posting_is_debit {sargs} { ::if {[::qw::odb::transaction_is_boomerang $sargs]} { ::return 0; } ::set OS [::sargs::get $sargs .object_structure]; # the reference's object structure. ::set Reference [::sargs::get $sargs .reference]; # account reference address ::set ReferenceFieldPath [::qw::odb::field_extract .address $Reference]; ::set PostingFieldPath [::sargs::outer .field $ReferenceFieldPath]; # ::set Amount [::sargs::real_get $OS .data$PostingFieldPath.amount]; ::set Amount [::qw::odb::posting_amount $sargs]; ::if {$Amount>0.0} {::return 1;} ::if {$Amount<0.0} {::return 0;} ::for {::set FieldPath $PostingFieldPath;} {$FieldPath ne ""} {::set FieldPath [::sargs::super .field $FieldPath]} { ::if {[::string match "*/debit" $FieldPath]} { ::return 1; } } ::for {::set FieldPath $PostingFieldPath;} {$FieldPath ne ""} {::set FieldPath [::sargs::super .field $FieldPath]} { ::if {[::string match "*/credit" $FieldPath]} { ::return 0; } } ::qw::bug "314120231217103652" "Could not find a debit or credit posting." /* { ::set Amount [[[$Reference odb_outer] ".amount"] odb_get]; ::if {$Amount>0.0} {::return 1;} ::if {$Amount<0.0} {::return 0;} ::if {[[$Reference odb_outer] odb_super_find_by_id "/debit"] ne ""} {::return 1;} ::if {[[$Reference odb_outer] odb_super_find_by_id "/credit"] ne ""} {::return 0;} ::qw::bug "314120030922142541" "Could not find a debit or credit posting." */ } } ::proc ::qw::odb::posting_is_credit {sargs} { ::if {[::qw::odb::transaction_is_boomerang $sargs]} { ::return 0; } ::set OS [::sargs::get $sargs .object_structure]; # the reference's object structure. ::set Reference [::sargs::get $sargs .reference]; # account reference address ::set ReferenceFieldPath [::qw::odb::field_extract .address $Reference]; ::set PostingFieldPath [::sargs::outer .field $ReferenceFieldPath]; # ::set Amount [::sargs::real_get $OS .data$PostingFieldPath.amount]; ::set Amount [::qw::odb::posting_amount $sargs]; ::if {$Amount<0.0} {::return 1;} ::if {$Amount>0.0} {::return 0;} ::for {::set FieldPath $PostingFieldPath;} {$FieldPath ne ""} {::set FieldPath [::sargs::super .field $FieldPath]} { ::if {[::string match "*/credit" $FieldPath]} { ::return 1; } } ::for {::set FieldPath $PostingFieldPath;} {$FieldPath ne ""} {::set FieldPath [::sargs::super .field $FieldPath]} { ::if {[::string match "*/debit" $FieldPath]} { ::return 0; } } ::qw::bug "314120231217103653" "Could not find a debit or credit posting." /* { ::set Amount [[[$Reference odb_outer] ".amount"] odb_get]; ::if {$Amount<0.0} {::return 1;} ::if {$Amount>0.0} {::return 0;} ::if {[[$Reference odb_outer] odb_super_find_by_id "/credit"] ne ""} {::return 1;} ::if {[[$Reference odb_outer] odb_super_find_by_id "/debit"] ne ""} {::return 0;} ::qw::bug "314120030922142709" "Could not find a debit or credit posting." */ } } ::proc ::qw::odb::transaction_default_field_odb_get {sargs} { # not used and probably not necessary ::set Database [::sargs::get $sargs .database]; ::set FieldPath [::sargs::get $sargs .field_path]; ::set Data [::sargs::get $sargs .object_structure.data]; ::while {1} { ::set Value [::sargs::get $Data $FieldPath]; ::if {$Value ne ""} { ::return $Value; } ::if {[::sargs::get $Data .journal] ne ""} { /* { We reached the root transaction object because there is a journal reference. The value could still be empty. */ } ::return $Value; } ::set Base [::sargs::get $Data .odb_base]; ::set OS [$Database cpp_object_structure_load .address $Base]; ::if {[::string first "/OBJECT/NEWVIEWS/SYSTEM/TRANSACTION" [::sargs::get $OS .system.path]]<0} { ::return $Value; } ::set Data [::sargs::get $OS .data]; } } ::proc ::qw::odb::posting_amount {sargs} { /* { Copied part of this from object_structure_manager but there is a difference. The OSM is general and can return amounts for branch postings. This method returns only leaf postings. The difference is that we should not need to traverse the object structure subs and we don't need to dlesh out the meta by plus_eq base metas. We are using only amount fields here. The OSM had to deal with quantities or other amounts as well. */ } ::set OS [::sargs::get $sargs .object_structure]; # the reference's object structure. ::set Reference [::sargs::get $sargs .reference]; # account reference address ::set ReferenceFieldPath [::qw::odb::field_extract .address $Reference]; ::set PostingFieldPath [::sargs::outer .field $ReferenceFieldPath]; ::set Amount [::sargs::get $OS .data$PostingFieldPath.amount]; ::if {$Amount ne ""} { ::return $Amount; } ::set SubFieldList [::sargs::subs .structure [::sargs::get $OS .data$PostingFieldPath]]; ::if {![::lempty $SubFieldList]} { ::qw::bug 314120231218091025 "Expected $PostingFieldPath to be a branch posting but it is has subs \"$SubFieldList\"."; } ::set Database [::sargs::get $sargs .database]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::set ClassPath [::sargs::get $OS .system.class_path]; ::set Totals [$Database cpp_file_totals \ .path /odb/index$ClassPath.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::set Total [::sargs::real_get $Totals $PostingFieldPath.amount]; ::return $Total; ::foreach {Path Total} $Totals { # ::if {$Path eq "$PostingField$AmountField"} {} ::if {$Path eq ".amount"} { ::return $Total; } } ::return 0.0; } ::proc ::qw::odb::path_reverse {Path} { ::set List1 [::split [::string range $Path 1 end] /]; ::set i [::llength $List1]; ::incr i -1; while {$i>=0} { ::lappend List2 [::lindex $List1 $i]; ::incr i -1; } ::return [::join $List2 /]/; } ::proc ::qw::odb::odb_deriveds_record_count {sargs} { ::set Database [::sargs::get $sargs .database]; ::set OS [::sargs::get $sargs .object_structure]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::set ClassPath [::sargs::get $OS .system.class_path]; ::set RecordCount [$Database cpp_file_record_count \ .path /odb/index$ClassPath.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::return $RecordCount; } ::proc ::qw::odb::total_kids_record_count {sargs} { ::set Database [::sargs::get $sargs .database]; ::set OS [::sargs::get $sargs .object_structure]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::set ClassPath [::sargs::get $OS .system.class_path]; ::set RecordCount [$Database cpp_file_record_count \ .path /odb/index$ClassPath.total.kids.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::return $RecordCount; } ::proc ::qw::odb::journal_default_field_odb_get {sargs} { ::set Database [::sargs::get $sargs .database]; ::set FieldPath [::sargs::get $sargs .field_path]; ::set Data [::sargs::get $sargs .object_structure.data]; ::while {1} { ::set Value [::sargs::get $Data $FieldPath]; ::if {$Value ne ""} { ::return $Value; } ::set OS [$Database cpp_object_structure_load .address [::sargs::get $Data .odb_base]]; ::if {[::string first "/OBJECT/NEWVIEWS/JOURNAL" [::sargs::get $OS .system.path]]<0} { ::return $Value; } ::set Data [::sargs::get $OS .data]; } } ::proc ::qw::odb::account_default_field_odb_get {sargs} { ::set Database [::sargs::get $sargs .database]; ::set FieldPath [::sargs::get $sargs .field_path]; ::set Data [::sargs::get $sargs .object_structure.data]; ::while {1} { ::set Value [::sargs::get $Data $FieldPath]; ::if {$Value ne ""} { ::return $Value; } ::set OS [$Database cpp_object_structure_load .address [::sargs::get $Data .odb_base]]; ::if {[::string first "/OBJECT/NEWVIEWS/ACCOUNT" [::sargs::get $OS .system.path]]<0} { ::return $Value; } ::set Data [::sargs::get $OS .data]; } } ::proc ::qw::odb::odb_account_is_active_posting_account {sargs} { /* { #//20040703 ::if {[$Master odb_is_class]} {::return 0;} ::if {[[$Master ".line_type"] odb_get] eq "text_line"} {::return 0;} ::if {[$Master is_total]} {::return 0;} ::if {[[$Master ".total.kids"] odb_items]} {::return 0;} ::if {[[$Master ".odb_deriveds"] odb_items]} {::return 0;} ::if {[[$Master ".active"] odb_get] ne "active"} {::return 0;} ::return 1; */ } ::set Database [::sargs::get $sargs .database]; ::set OS [::sargs::get $sargs .object_structure]; ::if {[::sargs::boolean_get $OS .system.is_class]} { ::return 0; } ::if {[::sargs::get $OS .data.line_type] eq "text_line"} { ::return 0; } ::if {[::string first "/OBJECT/NEWVIEWS/ACCOUNT/TOTAL" [::sargs::get $OS .system.class_path]]>=0} { ::return 0; } ::if {[::qw::odb::total_kids_record_count $sargs]!=0} { ::return 0; } ::if {[::qw::odb::odb_deriveds_record_count $sargs]!=0} { ::return 0; } ::if {[::qw::odb::account_default_field_odb_get $sargs .field_path .active] ne "active"} { ::return 0; } ::return 1; } ::proc ::qw::odb::transaction_topic_path {sargs} { ::set OS [::sargs::get $sargs .object_structure]; ::set Path ""; ::foreach Field {.l1 .l2 .l3 .l4} { ::set Text [::sargs::get $OS .data$Field]; ::if {$Text ne ""} { ::lappend Path $Text; } } ::set Path [::join $Path "/"]; ::return $Path; } ::proc ::qw::odb::transaction_topic_path_backward {sargs} { ::set OS [::sargs::get $sargs .object_structure]; ::set Path ""; ::foreach Field {.l4 .l3 .l2 .l1} { ::set Text [::sargs::get $OS .data$Field]; ::if {$Text ne ""} { ::lappend Path $Text; } } ::set Path [::join $Path "/"]; ::return $Path; } ::proc ::qw::odb::account_address_form_freeform_odb_get {sargs} { /* { ::if {[qw_get] ne ""} {::return [qw_get];} #20060207_build_change_1 (777_master - remove extra spaces from .address.name.freeform) #::return "[[[odb_outer] .country_code] odb_get] [[[odb_outer] .area_code] odb_get] [[[odb_outer] .prefix] odb_get] [[[odb_outer] .suffix] odb_get] [[[odb_outer] .extension] odb_get]"; ::set Result ""; ::foreach Path {.country_code .area_code .prefix .suffix .extension} { ::set Value [[[odb_outer] $Path] odb_get]; ::if {$Value ne ""} {::append Result " $Value";} } ::return [::string trim $Result]; */ } ::set Data [::sargs::get $sargs .object_structure.data]; ::set Value [::sargs::get $Data .address.form.freeform]; ::if {$Value ne ""} { ::return $Value; } ::set Result ""; ::foreach Path {.country_code .area_code .prefix .suffix .extension} { ::set Value [::sargs::get $Data .address.form$Path]; ::if {$Value ne ""} { ::append Result " $Value"; } } ::return [::string trim $Result]; }