# ------------------------------------------------------------ # Copyright (c) 2005-2021 # Q.W.Page Associates Inc. # www.qwpage.com # All rights reserved. # ------------------------------------------------------------ /* { gatgun collections /OBJECT/NEWVIEWS/PAYROLL.paychecks /OBJECT/NEWVIEWS/PAYROLL.timecards /OBJECT/NEWVIEWS/SYSTEM/TRANSACTION/PAYROLL/PAYCHECK.timecards /OBJECT/NEWVIEWS/SYSTEM/EMPLOYEE.paychecks /OBJECT/NEWVIEWS/SYSTEM/EMPLOYEE.timecards /OBJECT/NEWVIEWS/SYSTEM/PAYRUN.paychecks /OBJECT/NEWVIEWS/SYSTEM/PAYRUN.timecards /OBJECT/NEWVIEWS/ACCOUNT/AR/QWPAGE.contracts /OBJECT/NEWVIEWS/ACCOUNT/AR/QWPAGE.creditcards /OBJECT/NEWVIEWS/ACCOUNT/AR/QWPAGE.serialnumbers Importing demobooks from nv1_nv2 history file order set to 128 2.14 19m 7 s 2.15 24m 32 s Since we are eliminating many total accounts, can't understand why it should take longer than 2.14. Note that under 2.14, because it is an import, there is some summarization going on, but it turns out to be a very small portion. todo - bug create transaction fill up the fields now we commit it but we catch an exception if qw call odb_destroy then histories are broken (.destroy_before_skip or not) if we call odb abort then we are ok (no odb_destroy called) The history amounts are updated during the commit - we may have a bug - a history file just disappeared - it was a bank account 72========================================================= .system { .base_object_id 1114888344_17 .class_object_id 1114888344_17 .class_path /OBJECT/NEWVIEWS/ACCOUNT/BANK .object_id 1114888344_486 .path /OBJECT/NEWVIEWS/ACCOUNT/BANK/1114888344_486 .id /1114888344_486 } .data { .odb_base /1114888344_17.odb_deriveds .name 1060 .description {Bank - First National} .folder file .nplclass BANK .line_type account .report /1167840188_3843.accounts .setup_column 1 .total { .parent0 /1114888344_17.total.kids .parent1 /1114888344_555.total.kids .parent2 /1114888344_949.total.kids } .postings_collection_is_enabled 1 } - bug - ping still doesn't work multiuser - jrp - record nvreorganize in audit trail - shutdown - notes view - jrp says change to notes recorded when shutting down except when hit x button on workstation - nvreorg - houlihan - wrong numbers - was it the account history pass? - odometers - there was something regarding odometers that I did not clean up - collection_enable operation window - should not pop up on server - should act similar to red progress - only the administrator can enter locksmith error appears below the prompt - we did odb_befores_set, odb_commit and odb_destroy. but what about the edit quit/abort case? - garbage collection - or else check on every update and delete when all references counts are zero - nv reorganize - do we rebuild the account history file? - why not just copy it during reorg and have it build explicitly, perhaps one account sub-tree at a time. ----------------------------------------------------------------------------- done - retest enable for journal transactions and account postings - why didn't window clear when diabling postings? - check ping - check transaction edit date and duplicate refs in - create duplicate transactions script - create post-dated transactions script - managing the .postings_collection_is_enabled field. - add help to the error messages - check odb_initialize - set field to true on root account and any new non-total, non-class account - check that trial balance still works - jrp - print ledger allows for printing of total account ledgers - what about disabled total accounts? - auto-generate indexes when they are disabled - non-history topic find mask QW::STRUCT QW::ODB::DATABASE::login(STRUCT s_args) add help for invalid login date - test postings_retotal - test transactions_retotal - nvcheck - blue progress for new acount history test - nvreorganize -> blue progress for history_build - nvreorg - can't reorg workstation - error expected application basically - odb_retotal - has to respect the collection enabled field - the payroll transactions collections should also be able to be enabled/disabled - we should move .enabled field into the collection itself - will account_history.qw_tcl get installed in a cpp build? - answer was no but changed extension to .tcl ----------------------------------------------------------------------------- to be checked on - make sure we do not allow user to delete the payroll journals (where we added transactions to a class) - convert does not currently disable any journals - should we, we disable some when creating a set of books and adding journals - journal dependencies_downward (account already done) - crm added a running balance on the postings - hook into odb database iff newviews application local or server - create in database constructor - commit in database commit - disable in database bug diasble (is_broken hooks) - commit/destroy in database destructor # -------------------------------------------------------- # 2.16 todo # -------------------------------------------------------- - should we go instance-based everywhere? # -------------------------------------------------------- # retotaling with postings indexes disabled # -------------------------------------------------------- When we had all indexes enabled we could use the odb_retotal mechanism. We had all of the postings records in each index and we simply deleted/inserted them in the intersect3 upward closure. When indexes are disabled we could have a problem. We need the intersect3 of enabled accounts in the closures. We could check the enabled flag as delete insert, or we could eliminate the disabled accounts up from. The real problem is gathering up the postings if the account being retotaled is disabled. # -------------------------------------------------------- # .postings_collection_is_enabled # -------------------------------------------------------- 0->1 We have to gather up all downward closure of the accounts and merge them for all indexes. semiloops 0 We can stop when we hit any account with the collection enabled. So we can now merge. Could probably benefit from some merge techniques. semiloops 1 Easiest is to go all the way to the leaves and maintain a set of leaf accounts. Actually can use the posting closre index for this purpose. 1-> Simply delete all indexes. Perhaps we could also defrag the free blocks. If we retotal and we also change the enabled field, then downward dependencies will be processed. If we have incorporated the collection is enabled field into the is_hit then this should work. # -------------------------------------------------------- # new index definition # -------------------------------------------------------- Putting this stuff here because they go hand in hand with account histories. We have a cross-product of indexes. In one way the selection comes first and then the sort. But the sort seems to come first in the current field hierarchy. .key {string Tag date Date} .amounts { .open_debit { .reference_count xxx .amount xxx .quantity xxx } .open_credit { .reference_count xxx .amount xxx .quantity xxx } .closed_debit { .reference_count xxx .amount xxx .quantity xxx } .closed_credit { .reference_count xxx .amount xxx .quantity xxx } } */ } /* { This was never used but left it here as useful documentation. ::proc ::qw::newviews::is_gatgun_file {args} { ::set Path [::sargs::get $s_args .path]; ::switch -glob -- $Path { /odb/index/OBJECT/NEWVIEWS/ACCOUNT*.postings* { ::return 1; } /odb/index/OBJECT/NEWVIEWS/JOURNAL*.transactions* { ::return 1; } /OBJECT/NEWVIEWS/PAYROLL*.paychecks* { ::return 1; } /OBJECT/NEWVIEWS/PAYROLL*.timecards* { ::return 1; } /OBJECT/NEWVIEWS/SYSTEM/TRANSACTION/PAYROLL/PAYCHECK*.timecards* { ::return 1; } /OBJECT/NEWVIEWS/SYSTEM/EMPLOYEE*.paychecks* { ::return 1; } /OBJECT/NEWVIEWS/SYSTEM/EMPLOYEE*.timecards* { ::return 1; } /OBJECT/NEWVIEWS/SYSTEM/PAYRUN*.paychecks* { ::return 1; } /OBJECT/NEWVIEWS/SYSTEM/PAYRUN*.timecards* { ::return 1; } /OBJECT/NEWVIEWS/ACCOUNT/AR/QWPAGE*.contracts* { ::return 1; } /OBJECT/NEWVIEWS/ACCOUNT/AR/QWPAGE*.creditcards* { ::return 1; } /OBJECT/NEWVIEWS/ACCOUNT/AR/QWPAGE*.serialnumbers* { ::return 1; } } ::return 0; } */ } ::namespace eval ::qw::newviews::account_history {}; ::set ::qw::newviews::posting_amounts [::list .amount .quantity]; ::set ::qw::newviews::account_history::account_history_build_date_list [::list]; #2.25.0 ::if {$::qw::control(crm_include)} { # 2.18.1 implemented the .contact_duration in the account_histories ::lappend ::qw::newviews::posting_amounts .contact_duration; } ::proc ::qw::newviews::account_history::account_history_file {sargs} { /* { Each account history file path is of form /newviews/account_history/xxx_yyy when xxx_yyy is the object id of the account for which we are keeping the history. Given .account.object_id or .account.address as an argument, this method returns the full path to the account's history file. */ } ::set File $::qw::control(account_history_folder); ::set ObjectId ""; ::set Address [::sargs::get $sargs .account.address]; ::if {$Address ne ""} { ::set ObjectId [::qw::odb::object_id_extract .address $Address]; } else { ::set ObjectId [::sargs::get $sargs .account.object_id]; } ::if {$ObjectId eq ""} { ::qw::bug 314120090525081126 "Account not specified."; } ::return $::qw::control(account_history_folder)/$ObjectId; } ::proc ::qw::newviews::account_history::account_history_build_date_list {sargs} { /* { 2.25.0 This is called after every transaction commit and destroy. It almost always does nothing. The logic is here instead of in the odb_commit and odb_destroy methods in order to keep all account history logic in one file. We should have a date list per database. */ } ::if {!$::qw::control(ifs_dynamic_integrity_fix)} { ::return; } ::if {[::lempty $::qw::newviews::account_history::account_history_build_date_list]} { ::return; } ::set Database [::sargs::get $sargs .database]; ::if {$Database eq ""} { ::qw::bug 314120121120152344 "[::qw::procname] - no database."; } ::set HistoryManager [::qw::newviews::account_history::manager ::#auto .database $Database]; ::qw::finally [::list ::itcl::delete object $HistoryManager]; ::foreach Date $::qw::newviews::account_history::account_history_build_date_list { /* { Notice that the date is always specified. If the date is empty it is because the original transaction that had the problem had an empty date. */ } $HistoryManager account_history_build_date_range .date.begin $Date .date.end $Date .notify_skip 1 .destroy_skip 0; # 2.35.0 move to after the loop ::set ::qw::newviews::account_history::account_history_build_date_list [::list]; } ::set ::qw::newviews::account_history::account_history_build_date_list [::list]; # 2.35.0 moved here, out of loop } ::proc ::qw::newviews::account_history::account_history_build_date_list_append {sargs} { /* { 2.25.0 This is called whenever we have a problem deleting/writing a record. Generally the amounts were wrong. If the file is not an account ledger date index we do nothing. */ } ::set IndexPath [::sargs::get $sargs .file_info.path]; ::if {$IndexPath eq ""} { ::qw::bug 314120121120143736 "[::qw::procname] - no index path."; } ::if {![::string match */OBJECT/NEWVIEWS/ACCOUNT*.postings.index/date* $IndexPath]} { /* { If this doesn't involve an account postings date index than it can't involve account histories. Fixing the index record itself should be enough. */ } ::return; } /* { We fixed a low-level account postings date index. This means ledgers will now be out of synch with the account history records. One strategy would be to rebuild the entire account histories, but instead we will leave a breadcrumb list of dates to be fixed individually. key has form [::list string ObjectId tag Tag date Date string Reference] */ } ::set Record [::sargs::get $sargs .record]; ::set Key [::sargs::get $sargs .record.key]; ::set Date [::lindex $Key 5]; ::set Date [::string range $Date 0 7]; ::if {[::lsearch $::qw::newviews::account_history::account_history_build_date_list $Date]<0} { ::lappend ::qw::newviews::account_history::account_history_build_date_list $Date; } ::return; /* { # pre-2.25.4 ::foreach Field [::list before after current] { ::if {[::sargs::exists $sargs .ifs.record.$Field.key]} { ::set Key [::sargs::get $sargs .ifs.record.$Field.key]; ::set Date [::lindex $Key 5]; ::set Date [::string range $Date 0 7]; ::if {[::lsearch $::qw::newviews::account_history::account_history_build_date_list $Date]<0} { ::lappend ::qw::newviews::account_history::account_history_build_date_list $Date; } } } */ } } ::proc ::qw::newviews::account_history::account_history_amount_lookup {sargs} { /* { rwb_master_nv3 2.21.0 - Added to make amount lookup simpler in totalto orphan search. .database .account.address .tag .amount i.e. .amount/.quantity/.contact_duration/.reference_count/.count .begin_date .end_date .flow debit/credit/open/closed/all */ } ::set Database [::sargs::get $sargs .database]; ::if {$Database eq ""} { ::qw::bug 314120110330101807 "[::qw::procname] - empty .database argument."; } ::set Tag [::sargs::get $sargs .tag]; ::if {$Tag eq ""} { ::set Tag financial; } ::set RangeBegin [::list tag $Tag]; ::if {[::sargs::get $sargs .begin_date] ne ""} { ::lappend RangeBegin date [::sargs::get $sargs .begin_date]; } ::set RangeEnd [::list tag $Tag]; ::if {[::sargs::get $sargs .end_date] ne ""} { ::lappend RangeEnd date [::sargs::get $sargs .end_date]; } # 2.27.3 was not setting .amount in sargs so what was the point? ::if {[::sargs::get $sargs .amount] eq ""} { ::sargs::var::set sargs .amount .amount; } ::set Amount [::sargs::get $sargs .amount]; ::switch -- $Amount { .amount {} .quantity {} .count {} .contact_duration {} .reference_count {} default { ::qw::bug 314120110330102531 "[::qw::procname] - invalid .amount \"$Amount\"."; } } ::set Totals [$Database cpp_file_totals \ .path [account_history_file $sargs] \ .range.begin $RangeBegin \ .range.end $RangeEnd \ ]; ::set Result [flow_from_account_history_totals $sargs .amounts $Totals]; ::return $Result; } ::proc ::qw::newviews::account_history::account_history_record_add {sargs} { ::set rwb1_debug 0; ::if {$rwb1_debug} { ::puts "rwb1_debug,account_history::account_history_record_add,sargs==\n[::sargs::format $sargs]"; } ::set Database [::sargs::get $sargs .database]; ::if {$Database eq ""} { ::qw::bug 314120090602083737 "Database not specified."; } ::set File [::qw::newviews::account_history::account_history_file $sargs]; $Database cpp_file_record_add $sargs .path $File; } ::proc ::qw::newviews::account_history::account_history_record_subtract {sargs} { ::set rwb1_debug 0; ::if {$rwb1_debug} { ::puts "rwb1_debug,account_history::account_history_record_subtract,sargs==\n[::sargs::format $sargs]"; } ::set Database [::sargs::get $sargs .database]; ::if {$Database eq ""} { ::qw::bug 314120090602083738 "Database not specified."; } ::set File [::qw::newviews::account_history::account_history_file $sargs]; $Database cpp_file_record_subtract $sargs .path $File; } ::proc ::qw::newviews::account_history::key_compare {Key1 Key2} { /* { These should be a dictionary compare with numbers treated identical to the ifs record keys. */ } ::set Tag1 [::lindex $Key1 1]; ::set Tag2 [::lindex $Key2 1]; ::set Compare [::string compare $Tag1 $Tag2]; ::if {$Compare} { ::return $Compare; } ::set Date1 [::lindex $Key1 3]; ::set Date2 [::lindex $Key2 3]; ::set Compare [::qw::newviews::account_history::date_compare $Date1 $Date2] ::if {!$Compare} { ::qw::bug 314120090114112457 "Expected keys \"$Key1\" and \"$Key2\" to differ." } ::return $Compare; } ::proc ::qw::newviews::account_history::date_compare {Date1 Date2} { ::if {$Date1 eq ""} { ::if {$Date2 eq ""} { ::return 0; } ::return 1; } ::if {$Date2 eq ""} { ::return -1; } ::if {[::string length $Date1]!=8} { ::qw::bug 314120090112144958 "Encountered invalid date \"$Date1\"."; } ::if {[::string length $Date2]!=8} { ::qw::bug 314120090112144959 "Encountered invalid date \"$Date2\"."; } ::return [::string compare $Date1 $Date2]; } ::proc ::qw::newviews::account_history::account_history_date_from_transaction_date {sargs} { /* { We are using daily resolution now so this method just chops to the day. (During development we used to use different resolutions so this method had more work to do). */ } ::if {![::sargs::exists $sargs .date]} { ::qw::bug 314120090310111836 "Expected a \".date\" argument."; } ::set Date [::sargs::get $sargs .date]; ::if {$Date eq ""} { ::return $Date; } ::set Date [::string range $Date 0 7]; # ::set Date [::string range $Date 0 7]000000; ::return $Date; } ::proc ::qw::newviews::account_history::account_history_file_create {sargs} { /* { Creates the account history file if it doesn't already exist. */ } ::set Database [::sargs::get $sargs .database]; ::if {$Database eq ""} { ::qw::bug 314120090414082433 "Expected a \".database\" argument."; } ::set File [::qw::newviews::account_history::account_history_file $sargs]; ::if {[$Database cpp_file_exists .path $File]} { ::return; } ::set SchemaAmounts [::list \ .count \ .open_debit.reference_count \ .open_debit.amount \ .open_debit.quantity \ .open_credit.reference_count \ .open_credit.amount \ .open_credit.quantity \ .closed_debit.reference_count \ .closed_debit.amount \ .closed_debit.quantity \ .closed_credit.reference_count \ .closed_credit.amount \ .closed_credit.quantity \ .open_debit_boomerang.reference_count \ .open_debit_boomerang.amount \ .open_debit_boomerang.quantity \ .open_credit_boomerang.reference_count \ .open_credit_boomerang.amount \ .open_credit_boomerang.quantity \ .closed_debit_boomerang.reference_count \ .closed_debit_boomerang.amount \ .closed_debit_boomerang.quantity \ .closed_credit_boomerang.reference_count \ .closed_credit_boomerang.amount \ .closed_credit_boomerang.quantity \ ]; ::if {$::qw::control(crm_include)} { ::set SchemaAmounts [::concat $SchemaAmounts [::list \ .open_debit.contact_duration \ .open_credit.contact_duration \ .closed_debit.contact_duration \ .closed_credit.contact_duration \ .open_debit_boomerang.contact_duration \ .open_credit_boomerang.contact_duration \ .closed_debit_boomerang.contact_duration \ .closed_credit_boomerang.contact_duration \ ]]; } $Database cpp_file_create \ .path $File \ .schema.key [::list tag date] \ .schema.amounts $SchemaAmounts \ ; } ::proc ::qw::newviews::account_history::account_history_file_delete {sargs} { /* { Deletes the account history file if it exists. */ } ::set Database [::sargs::get $sargs .database]; ::if {$Database eq ""} { ::qw::bug 314120090414082433 "Expected a \".database\" argument."; } ::set File [::qw::newviews::account_history::account_history_file $sargs]; ::if {[$Database cpp_file_exists .path $File]} { $Database cpp_file_delete .path $File; } } ::proc ::qw::newviews::account_history::flow_from_account_history_totals {sargs} { /* { Given the raw (linearly independent) amounts we build the normal flows. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,account_history::flow_from_account_history_totals,1000.0,sargs==\n[::sargs::format .structure $sargs]";} #2.27.3 - instead of checking existence, we now check if empty. ::if {![::sargs::exists $sargs .amounts]} { ::qw::bug 314120090414114656 "[::qw::procname] - no .amounts argument."; } ::set Amounts [::sargs::get $sargs .amounts]; ::if {$rwb1_debug} {::puts "rwb1_debug,account_history::flow_from_account_history_totals,1000.1,Amounts==$Amounts";} ::set Field [::sargs::get $sargs .amount]; ::set Flow [::sargs::get $sargs .flow]; ::if {$Field eq ""} { ::qw::bug 314120140702185203 "[::qw::procname] - invalid .amount \"$Field\"."; } ::if {$Flow eq ""} { ::qw::bug 314120140702185205 "[::qw::procname] - invalid .flow \"$Flow\"."; } ::if {$rwb1_debug} {::puts "rwb1_debug,account_history::flow_from_account_history_totals,1000.2";} ::switch -glob -- $Flow { *debit* { ::if {$rwb1_debug} {::puts "rwb1_debug,account_history::flow_from_account_history_totals,1000.3";} ::return [::qw::number::sum \ [::sargs::real_get $Amounts .open_debit$Field] \ [::sargs::real_get $Amounts .closed_debit$Field] \ ]; } *credit* { ::if {$rwb1_debug} {::puts "rwb1_debug,account_history::flow_from_account_history_totals,1000.4";} ::return [::qw::number::sum \ [::sargs::real_get $Amounts .open_credit$Field] \ [::sargs::real_get $Amounts .closed_credit$Field] \ ]; } *open* { ::if {$rwb1_debug} {::puts "rwb1_debug,account_history::flow_from_account_history_totals,1000.5";} ::return [::qw::number::sum \ [::sargs::real_get $Amounts .open_debit$Field] \ [::sargs::real_get $Amounts .open_credit$Field] \ [::sargs::real_get $Amounts .open_debit_boomerang$Field] \ [::sargs::real_get $Amounts .open_credit_boomerang$Field] \ ]; } *closed* { ::if {$rwb1_debug} {::puts "rwb1_debug,account_history::flow_from_account_history_totals,1000.6";} ::return [::qw::number::sum \ [::sargs::real_get $Amounts .closed_debit$Field] \ [::sargs::real_get $Amounts .closed_credit$Field] \ [::sargs::real_get $Amounts .closed_debit_boomerang$Field] \ [::sargs::real_get $Amounts .closed_credit_boomerang$Field] \ ]; } default { ::if {$rwb1_debug} { ::puts "rwb1_debug,account_history::flow_from_account_history_totals,1000.7,field==$Field"; ::foreach Field1 { .open_debit .open_credit .closed_debit .closed_credit .open_debit_boomerang .open_credit_boomerang .closed_debit_boomerang .closed_credit_boomerang } { ::puts "rwb1_debug,account_history::flow_from_account_history_totals,1000.7.0,field==$Field1,value==[::sargs::real_get $Amounts $Field1$Field]"; ::puts "rwb1_debug,account_history::flow_from_account_history_totals,1000.7.1,field==$Field1,value==[::sargs::get $Amounts $Field1$Field]"; } ::puts "rwb1_debug,account_history::flow_from_account_history_totals,1000.7.0,value==$Field"; } ::return [::qw::number::sum \ [::sargs::real_get $Amounts .open_debit$Field] \ [::sargs::real_get $Amounts .open_credit$Field] \ [::sargs::real_get $Amounts .closed_debit$Field] \ [::sargs::real_get $Amounts .closed_credit$Field] \ [::sargs::real_get $Amounts .open_debit_boomerang$Field] \ [::sargs::real_get $Amounts .open_credit_boomerang$Field] \ [::sargs::real_get $Amounts .closed_debit_boomerang$Field] \ [::sargs::real_get $Amounts .closed_credit_boomerang$Field] \ ]; } } ::if {$rwb1_debug} {::puts "rwb1_debug,account_history::flow_from_account_history_totals,1000.99";} } ::namespace eval ::qw::newviews {} ::itcl::class ::qw::newviews::account_history::manager { /* { ::qw::newviews::account_history::manager class */ } protected variable _database ""; protected variable _database_id ""; protected variable _database_path ""; protected variable _metas; protected variable _posting_fields; protected variable _postings_indexes; protected variable _closures; protected variable _tag_list ""; protected variable _account_postings_collection_is_enabled; /* { ::array size actually iterates through the array, counting the elements. When I used it my code slowed down. So here we keep track ourselves. */ } protected variable _account_history_file_hashtable; protected variable _account_history_file_hashtable_count 0; protected variable _account_history_file_hashtable_is_enabled 0; protected variable _accounts_by_object_id; protected variable _progress_state ""; protected variable _progress_color "red"; method constructor {sargs} { ::array set _metas {}; ::array set _posting_fields {}; ::array set _postings_indexes {}; ::array set _closures {}; ::array set _accounts_by_object_id {}; ::array set _account_postings_collection_is_enabled {}; ::array set _account_history_file_hashtable {}; ::set _database [::sargs::get $sargs .database]; ::if {$_database eq ""} { ::set Window [::sargs::get $sargs .odb.object]; ::if {$Window eq ""} { ::qw::throw "The database was not specified."; } ::set _database [$Window odb_database application]; } ::if {$_database eq ""} { ::qw::throw "The database was not specified."; } ::set _database_id [$_database cpp_database_id_get]; ::set _database_path [$_database cpp_database_path]; ::set DatabaseType [$_database cpp_database_type_get]; ::switch -- $DatabaseType { application { } default { ::qw::bug 314120081223124702 "[::qw::methodname] - invalid database type \"$DatabaseType\"."; } } } method destructor {} { } method tag_list_get {sargs} { ::if {[::llength $_tag_list]!=0} { ::return $_tag_list; } ::set TagPairList [::QW::GUI::NEWVIEWS::edit_assist_tag_pair_list [::sargs .database $_database]]; ::foreach ItemList $TagPairList { ::lappend _tag_list [::lindex $ItemList 0]; } ::return $_tag_list; } method tag_list_get_save {sargs} { /* { Scans the journal hierarchy to build a list of all tags in use. */ } ::if {$_tag_list ne ""} { ::return $_tag_list; } ::set Journal [::sargs::get $sargs .address]; ::if {$Journal eq ""} { ::set OS [$_database cpp_object_structure_load .path /OBJECT/NEWVIEWS/JOURNAL]; ::set _tag_list [tag_list_get .address /[::sargs::get $OS .system.object_id]]; ::return $_tag_list; } ::set OS [$_database cpp_object_structure_load .address $Journal]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::set ClassPath [::sargs::get $OS .system.class_path]; ::set Kids [$_database cpp_file_odb_masters \ .path /odb/index$ClassPath.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::set TagList [::sargs::get $OS .data.tags]; ::foreach Kid $Kids { ::set TagList [::qw::union $TagList [tag_list_get .address $Kid]]; } ::return $TagList; } method field_get {sargs} { ::set Field [::sargs::get $sargs .field]; ::switch -- $Field { default { ::qw::bug 314120090119105201 "Encountered unknown field \"$Field\"."; } } } method field_set {sargs} { ::if {![::sargs::exists $sargs .value]} { ::qw::bug 314120090119125754 "Expected a value argument."; } ::set Field [::sargs::get $sargs .field]; ::set Value [::sargs::get $sargs .value]; ::switch -- $Field { default { ::qw::bug 314120090119105202 "Encountered unknown field \"$Field\"."; } } } method postings_indexes_eliminate {sargs} { ::set rwb1_debug 0; ::if {$rwb1_debug} { ::set ClockStart [::clock seconds]; } ::set DestroySkip [::sargs::boolean_get $sargs .destroy_skip]; ::set NotifySkip [::sargs::boolean_get $sargs .notify_skip]; ::set InodesFile [$_database cpp_file_factory]; ::qw::finally [::list $InodesFile cpp_destroy]; $InodesFile cpp_file_open .path "/"; ::set ProgressLimit 0; ::set Paths ""; ::for {::set Record [$InodesFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$InodesFile cpp_record_next $Record]} { ::set Data [::sargs::get $Record .data]; ::set Path [::sargs::get $Data .path]; ::switch -glob -- $Path { /odb/index/OBJECT/NEWVIEWS/ACCOUNT/TOTAL.postings.index* { /* { This counts all postings on all total accounts. */ } ::set ProgressLimit [::expr {$ProgressLimit+[$_database cpp_file_record_count .path $Path]}]; ::lappend Paths $Path; } /odb/index/OBJECT/NEWVIEWS/ACCOUNT*.postings.index* { ::set ProgressLimit [::expr {$ProgressLimit+[$_database cpp_file_record_count .path $Path]}]; ::lappend Paths $Path; } } } ::set Progress ""; ::set ProgressMinimum 1; ::if {$ProgressLimit>=$ProgressMinimum} { ::set Progress [::QW::PROGRESS::OPERATION [::qw::progress::auto] \ .database_id [$_database cpp_database_id_get] \ .file [$_database cpp_database_path] \ .limit $ProgressLimit \ .resolution 119 \ .destroy_skip $DestroySkip \ .operation "deleting index records" \ .status "[$_database cpp_database_path] deleting postings index records." \ ]; ::qw::finally [::list ::itcl::delete object $Progress]; } ::foreach Path $Paths { ::set RecordCount [$_database cpp_file_record_count .path $Path]; $_database cpp_file_delete_all_records .path $Path .progress $Progress; } # $_database cpp_reorganize_free_blocks; ::if {$rwb1_debug} { ::puts "postings_indexes_eliminate,seconds==[::expr {[::clock seconds]-$ClockStart}]"; } ::if {!$NotifySkip} { ::set Text "All total account posting records deleted."; ::qw::dialog::notify \ .title $Text \ .text $Text \ ; } } method summed_fields_eliminate {sargs} { /* { Takes all summed fields and sticks in their real value. Summed fields are found only in transaction posting amounts/quantities. We have to stick amounts in super fields and also go up the class hierarchy (only as far as the top instance). Never actually put this to use. */ } ::set rwb1_debug 0; ::if {!$::qw::control(summed_fields_are_gone)} { ::return; } ::set Transaction [::sargs::get $sargs .transaction]; ::if {$Transaction eq ""} { /* { No transaction specified so process the entire database. */ } ::set DestroySkip [::sargs::boolean_get $sargs .destroy_skip]; ::set NotifySkip [::sargs::boolean_get $sargs .notify_skip]; ::set ClientdataBefore [$_database cpp_clientdata_get]; ::if {[::sargs::boolean_get $ClientdataBefore .summed_fields_are_disabled]} { /* { This database has already been processed. */ } ::return; } ::if {$rwb1_debug} { ::set ClockStart [::clock seconds]; } ::set OutputFile [::open [::file join [::file dirname [$_database cpp_database_path]] summeds_eliminated.txt] w+]; ::set TransactionFile [$_database cpp_file_factory]; ::qw::finally [::list $TransactionFile cpp_destroy]; ::set ObjectStructure [$_database cpp_object_structure_load .path /OBJECT/NEWVIEWS/JOURNAL]; ::set ObjectId [::sargs::get $ObjectStructure .system.object_id]; $TransactionFile cpp_file_open \ .path /odb/index/OBJECT/NEWVIEWS/JOURNAL.transactions.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ; ::set RecordCount [$TransactionFile cpp_record_count]; ::set ProgressLimit $RecordCount; ::set ProgressResolution 1; ::set Progress ""; ::set ProgressMinimum 1; ::if {$ProgressLimit>1000} { ::set ProgressResolution 19; } ::if {$ProgressLimit>=$ProgressMinimum} { ::set Progress [::QW::PROGRESS::OPERATION [::qw::progress::auto] \ .database_id [$_database cpp_database_id_get] \ .file [$_database cpp_database_path] \ .limit $ProgressLimit \ .resolution $ProgressResolution \ .destroy_skip $DestroySkip \ .operation "processing transactions" \ .status "[$_database cpp_database_path] processing transactions." \ ]; ::qw::finally [::list ::itcl::delete object $Progress]; } ::for {::set Record [$TransactionFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$TransactionFile cpp_record_next $Record]} { ::set Reference [::lindex [::sargs::get $Record .key] end]; summed_fields_eliminate .transaction $Reference .output_file $OutputFile; ::if {$ProgressLimit>=$ProgressMinimum} { $Progress increment; } } ::close $OutputFile; ::set ClientdataAfter $ClientdataBefore; ::sargs::var::set ClientdataAfter .summed_fields_are_disabled 1; $_database cpp_clientdata_set .before $ClientdataBefore .after $ClientdataAfter; ::if {$rwb1_debug} { ::puts "summed_fields_eliminate,seconds==[::expr {[::clock seconds]-$ClockStart}]"; } ::return; } ::set ObjectStructure [$_database cpp_object_structure_load .address $Transaction]; ::set ObjectId [::sargs::get $ObjectStructure .system.object_id]; ::set ClassPath [::sargs::get $ObjectStructure .system.class_path]; ::set Kids [$_database cpp_file_odb_masters \ .path /odb/index$ClassPath.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::foreach Kid $Kids { summed_fields_eliminate $sargs .transaction $Kid; } ::set Totals ""; ::if {[::llength $Kids]!=0} { ::set Totals [$_database cpp_file_totals \ .path /odb/index$ClassPath.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; } ::foreach Path [get_posting_fields .class_path $ClassPath] { ::if {[::llength [::sargs::subs .structure [::sargs::get $_metas($ClassPath) $Path]]]!=0} { /* { Skip branches. We process bottom up, summing as we go so we only need to process leaves. */ } ::continue; } ::foreach Field $::qw::newviews::posting_amounts { ::set Amount [::sargs::get $ObjectStructure .data$Path$Field]; ::if {$Amount eq ""} { ::set Amount [::sargs::real_get $Totals $Path$Field]; ::sargs::var::real_set ObjectStructure .data$Path$Field $Amount; } ::if {$Amount!=0.0} { ::set Supers [::split $Path /]; ::while {$Supers ne ".posting"} { ::set Supers [::lrange $Supers 0 end-1]; ::set Super [::join $Supers /]; ::sargs::var::real_set ObjectStructure .data$Super$Field [::expr {[::sargs::real_get $ObjectStructure .data$Super$Field]+$Amount}]; } } } } ::puts [::sargs::get $sargs .output_file] "----------------------------------------------\n[::sargs::format.structure $ObjectStructure]"; $_database cpp_object_structure_store .structure $ObjectStructure; } method get_meta {sargs} { ::set ClassPath [::sargs::get $sargs .class_path]; ::if {$ClassPath eq ""} { ::qw::bug 314120090108170056 "Encountered empty class path."; } ::if {![::info exists _metas($ClassPath)]} { ::set _metas($ClassPath) [$_database cpp_object_meta_load .path $ClassPath]; } ::return $_metas($ClassPath); } method get_posting_fields {sargs} { /* { Returns a list of posting fields associated with a transaction class. Caches the lists for speed. */ } ::set ClassPath [::sargs::get $sargs .class_path]; ::if {$ClassPath eq ""} { ::qw::bug 314120090108170055 "Encountered empty class path."; } ::if {![::info exists _posting_fields($ClassPath)]} { /* { We get the list of posting fields for each class and store them in an array (indexed by class path) for efficiency. */ } ::set Meta [get_meta .class_path $ClassPath]; ::set Paths [::sargs::select_field .structure [::sargs::get $Meta .posting] .field .account]; ::if {$Paths eq ""} { ::qw::bug 314120081216124913 "Could not find posting fields"; } ::set _posting_fields($ClassPath) ""; ::foreach Path $Paths { /* { We reverse the order of the (top-down) list so we can use a foreach and work bottom-up. */ } ::set _posting_fields($ClassPath) [::linsert $_posting_fields($ClassPath) 0 .posting$Path]; } } ::return $_posting_fields($ClassPath); } method get_postings_indexes {sargs} { ::set ClassPath [::sargs::get $sargs .class_path]; ::if {$ClassPath eq ""} { ::qw::bug 314120090401102721 "Encountered empty class path."; } ::if {![::info exists _postings_indexes($ClassPath)]} { /* { We get the list of index fields for each class and store them in an array (indexed by class path) for efficiency. */ } ::set Meta [get_meta .class_path $ClassPath]; ::set Paths [::sargs::select_field_value .structure [::sargs::get $Meta .postings] .field .odb.type .value index]; ::if {$Paths eq ""} { ::qw::bug 314120090401102957 "Could not find index fields"; } ::foreach Path $Paths { ::lappend _postings_indexes($ClassPath) .postings$Path; } } ::return $_postings_indexes($ClassPath); } method dump_history_file {sargs} { ::set rwb1_debug 0; ::if {$rwb1_debug} { ::set ClockStart [::clock seconds]; } ::set Handle [::open [::file join [::file dirname $_database_path] account_history_file.txt] w+]; ::qw::finally [::list ::close $Handle]; ::set InodesFile [$_database cpp_file_factory]; ::qw::finally [::list $InodesFile cpp_destroy]; ::set IfsFile [$_database cpp_file_factory]; ::qw::finally [::list $IfsFile cpp_destroy]; $InodesFile cpp_file_open \ .path / \ .range.begin [::list string $::qw::control(account_history_folder)] \ .range.end [::list string $::qw::control(account_history_folder)] \ ; ::set ProgressLimit 0; ::set Paths ""; ::set Count 0; ::for {::set iRecord [$InodesFile cpp_record_first]} {[::sargs::size $iRecord]!=0} {::set iRecord [$InodesFile cpp_record_next $iRecord]} { ::incr Count; ::if {$Count>100} { ::break; } ::set Path [::sargs::get $iRecord .data.path]; ::if {$Path eq "/newviews/account_history"} { /* { Can remove this later. Only happens because /newviews/account_history has already been created in the old version where we use one file. */ } ::continue; } ::set AccountObjectId [::string map [::list $::qw::control(account_history_folder)/ {}] $Path]; ::set OS [$_database cpp_object_structure_load .object_id $AccountObjectId]; ::set AccountName [::sargs::get $OS .data.name]; ::puts $Handle "name==$AccountName,object_id==$AccountObjectId ------------------------------------"; $IfsFile cpp_file_open .path $Path; ::for {::set HistoryRecord [$IfsFile cpp_record_first .totals_load 1]} {[::sargs::size $HistoryRecord]!=0} {::set HistoryRecord [$IfsFile cpp_record_next $HistoryRecord .totals_load 1]} { ::puts $Handle "Record==$HistoryRecord"; } } ::if {$rwb1_debug} { ::puts "dump_history_file,seconds==[::expr {[::clock seconds]-$ClockStart}]"; } } method dump_history_file_with_all_flows {sargs} { ::set rwb1_debug 0; ::qw::throw "dump_history_file_with_all_flows has not been updated for multiple account history files." ::if {$rwb1_debug} { ::set ClockStart [::clock seconds]; } ::set Handle [::open [::file join [::file dirname $_database_path] histories_with_all_flows.txt] w+]; ::qw::finally [::list ::close $Handle]; ::set IfsFile $_account_history_file; ::set RecordCount [$IfsFile cpp_record_count]; ::set ProgressLimit $RecordCount; ::set ProgressResolution 1; ::set Progress ""; ::set ProgressMinimum 1; ::if {$ProgressLimit>1000} { ::set ProgressResolution 19; } ::if {$ProgressLimit>=$ProgressMinimum} { ::set Progress [::QW::PROGRESS::OPERATION [::qw::progress::auto] \ .database_id [$_database cpp_database_id_get] \ .file [$_database cpp_database_path] \ .limit $ProgressLimit \ .resolution $ProgressResolution \ .operation "writing account histories" \ .status "[$_database cpp_database_path] writing account histories to histories_with_all_flows.txt." \ ]; ::qw::finally [::list ::itcl::delete object $Progress]; } ::set AccountName ""; ::set AccountObjectId ""; ::for {::set Record [$IfsFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$IfsFile cpp_record_next $Record]} { ::if {$Progress ne ""} { $Progress increment; } ::set Key [::sargs::get $Record .key]; ::set ObjectId [::lindex $Key 1]; ::if {$ObjectId ne $AccountObjectId} { ::set AccountObjectId $ObjectId; ::set AccountOS [$_database cpp_object_structure_load .object_id $AccountObjectId]; ::set AccountName [::sargs::get $AccountOS .data.name]; ::puts $Handle "account_history,records,account_name==$AccountName,------------------------------------"; } ::set Amounts ""; ::foreach {Path Value} [::sargs::get $Record .amounts] { ::sargs::var::set Amounts $Path $Value; } ::foreach Field $::qw::newviews::posting_amounts { ::set OpenDebit [::sargs::real_get $Amounts .open_debit$Field]; ::set OpenCredit [::sargs::real_get $Amounts .open_credit$Field]; ::set ClosedDebit [::sargs::real_get $Amounts .closed_debit$Field]; ::set ClosedCredit [::sargs::real_get $Amounts .closed_credit$Field]; ::set OpenDebitBoomerang [::sargs::real_get $Amounts .open_debit_boomerang$Field]; ::set OpenCreditBoomerang [::sargs::real_get $Amounts .open_credit_boomerang$Field]; ::set ClosedDebitBoomerang [::sargs::real_get $Amounts .closed_debit_boomerang$Field]; ::set ClosedCreditBoomerang [::sargs::real_get $Amounts .closed_credit_boomerang$Field]; ::set Debit [::qw::number::sum $OpenDebit $ClosedDebit]; ::set Credit [::qw::number::sum $OpenCredit $ClosedCredit]; ::set Open [::qw::number::sum $OpenDebit $OpenCredit $OpenDebitBoomerang $OpenCreditBoomerang]; ::set Closed [::qw::number::sum $ClosedDebit $ClosedCredit $ClosedDebitBoomerang $ClosedCreditBoomerang]; ::set All [::qw::number::sum $Open $Closed]; ::set DebitCredit [::qw::number::sum $Debit $Credit]; ::if {$Field ne ".reference_count" && [::qw::number::compare $All $DebitCredit]!=0} { ::puts "Record==$Record"; ::puts "OpenDebit==$OpenDebit"; ::puts "OpenCredit==$OpenCredit"; ::puts "ClosedDebit==$ClosedDebit"; ::puts "ClosedCredit==$ClosedCredit"; ::puts "OpenDebitBoomerang==$OpenDebitBoomerang"; ::puts "OpenCreditBoomerang==$OpenCreditBoomerang"; ::puts "ClosedDebitBoomerang==$ClosedDebitBoomerang"; ::puts "ClosedCreditBoomerang==$ClosedCreditBoomerang"; ::puts "Debit==$Debit"; ::puts "Credit==$Credit"; ::puts "Open==$Open"; ::puts "Closed==$Closed"; ::puts "All==$All"; ::puts "DebitCredit==$DebitCredit"; ::puts "account object structure==\n[::sargs::format.structure $AccountOS]"; ::qw::bug 314120090127102018 "Expected debits plus credits to equal open plus closed." } ::sargs::var::real_set Amounts .debit$Field $Debit; ::sargs::var::real_set Amounts .credit$Field $Credit; ::sargs::var::real_set Amounts .open$Field $Open; ::sargs::var::real_set Amounts .closed$Field $Closed; ::sargs::var::real_set Amounts .all$Field $All; } ::puts $Handle "key==$Key,amounts==$Amounts"; } # ::close $Handle; ::if {$rwb1_debug} { ::puts "dump_history_file_with_flows,seconds==[::expr {[::clock seconds]-$ClockStart}]"; } } method proof_report_header_table {sargs} { ::set TableItems ""; ::set NameList { "Operation" "Database File" "Database Type" "Database Id" "Database Size" "Operation Date" "Program" "Program Version" "Host Name" "User Name" } ::foreach Name $NameList { ::set Value ""; ::switch -- $Name { "Operation" { ::set Value "Proof Check"; } "User Name" { ::set Value [$_database cpp_user_name]; } "Database File" { ::set Value [$_database cpp_database_path]; } "Database Type" { ::set Value [$_database cpp_database_type_get]; } "Database Id" { ::set Value [$_database cpp_database_id_get]; } "Database Size" { ::set Value [::qw::number::format [::file size $_database_path] $::qw::number::formats(integer)]; } "Operation Date" { ::set Value "[::clock format [::clock seconds] -format {%a %b %e %Y %k:%M:%S}]"; } "Program" { ::set Value [::string tolower [::file normalize [::info nameofexecutable]]]; } "Program Version" { ::set Value "$::qw_version.$::qw_patch_level.$::qw_build"; } "Host Name" { ::set Value [::string tolower [::info hostname]] } } ::if {$Value ne ""} { ::append TableItems [::subst -nocommands { [tr { [td { {$Name} }] [td { [qw_field_value {$Value}] }] }] }]; } } ::append Body [::subst -nocommands { [p { [table { {$TableItems} }] }] }]; ::return $Body; } method proof_report_generate {sargs} { /* { proof_report_generate \ .database $Database \ .exception_list $ExceptionList \ .state $State \ .command $Command \ ; */ } ::set Command "Proof check"; ::set ErrorBody [::sargs::get $sargs .body]; ::set Structure ""; ::sargs::var::set Structure .id 314120060710081232; ::sargs::var::set Structure .title "Proof Check"; ::set Body ""; ::append Body [proof_report_header_table $sargs]; ::if {$ErrorBody ne ""} { ::append Body [::subst -nocommands { [h2 "$Command discovered the following unbalanced amounts:"] [pre { $ErrorBody }] }] } ::itcl::local ::QW::OPERATION #auto .text "Generating proof check report for file \"$_database_path\" ..."; ::sargs::var::set Structure .body $Body; ::set ChmFile [::file rootname $_database_path]; ::append ChmFile "_proof_check"; ::append ChmFile "_[::clock format [::clock seconds] -format %Y%m%d%H%M%S]" ::append ChmFile ".chm"; ::qw::script::source \ .script.path [::file join $::qw_library doc qw_chtml_compile.qw_script] \ .structure $Structure \ .window_title "$ChmFile" \ .destination $ChmFile \ ; } method proof_report {sargs} { ::set OS [$_database cpp_object_structure_find $sargs]; ::if {$OS eq ""} { ::qw::bug 314120110304150007 "[::qw::methodname] - could not find an account from arguments \"$sargs\"." \ } ::set Tag [::sargs::get $sargs .tag]; ::if {$Tag eq ""} { ::qw::bug 314120110304150008 "[::qw::methodname] - invalid .tag \"$Tag\"."; } ::set ObjectId [::sargs::get $OS .system.object_id]; ::set Address [$_database cpp_get_address_from_object_id .object_id $ObjectId]; ::set AccountPath [$Address odb_path_help]; ::set AccountHistoryFile [$_database cpp_file_factory]; ::qw::finally [::list $AccountHistoryFile cpp_destroy]; ::set RangeBegin [::list tag $Tag]; ::if {[::sargs::get $sargs .begin_date] ne ""} { ::lappend RangeBegin date [::sargs::get $sargs .begin_date]; } ::set RangeEnd [::list tag $Tag]; ::if {[::sargs::get $sargs .end_date] ne ""} { ::lappend RangeEnd date [::sargs::get $sargs .end_date]; } $AccountHistoryFile cpp_file_open \ .path [::qw::newviews::account_history::account_history_file .account.address $Address] \ .range.begin $RangeBegin \ .range.end $RangeEnd \ ; ::set Body ""; ::set Count 0; ::for {::set Record [$AccountHistoryFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$AccountHistoryFile cpp_record_next $Record]} { ::set Totals [::sargs::get $Record .amounts]; ::set ProofTotal [flow_from_account_history_totals .amounts $Totals .amount .amount .flow ledger]; ::set Date [::string range [::lindex [::sargs::get $Record .key] 3] 0 7]; ::set Clock [::qw::date::to_number clock_seconds $Date]; ::set FormattedDate [::clock format $Clock -format "%b %d, %Y"]; ::if {$ProofTotal!=0.0} { ::append Body "count:$Count,account:$AccountPath,Tag:$Tag,Date:$FormattedDate,Proof:$ProofTotal\n"; ::incr Count; } } proof_report_generate $sargs .body $Body; } method account_history_check {sargs} { /* { Goes though the accounts. For each account whose postings are enabled, we go through the history records, comparing the relevant flows against the corresponding range in the postings index rbs. .root_account_only 1 In this case only the histories for the root account are checked. This is a shortcut that allows for some checking without checking everything. It is used after converting a database, for example. */ } ::set rwb1_debug 0; ::set HistoryFileRecord [::sargs::get $sargs .record]; ::if {$HistoryFileRecord eq ""} { ::if {$rwb1_debug} { ::set ClockStart [::clock seconds]; } /* { We flush the gatgun indexes in order to ensure the postings indexes are up to date. */ } $_database cpp_gatgun_hashtable_indexes_flush; ::set DestroySkip [::sargs::boolean_get $sargs .destroy_skip]; ::set NotifySkip [::sargs::boolean_get $sargs .notify_skip]; ::set OS [$_database cpp_object_structure_load .path /OBJECT/NEWVIEWS/ACCOUNT]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::lappend Accounts [::qw::odb::address_from_disk .database $_database .address /$ObjectId]; ::if {![::sargs::boolean_get $sargs .root_account_only]} { ::set Accounts [::concat $Accounts [$_database cpp_file_odb_masters \ .path /odb/index/OBJECT/NEWVIEWS/ACCOUNT.odb_deriveds.index/name_closure \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]]; } ::set Progress1Limit [::llength $Accounts]; ::set Progress1Resolution 1; ::set Progress1 ""; ::set Progress1Minimum 1; ::if {$Progress1Limit>=$Progress1Minimum} { ::set Progress1 [::QW::PROGRESS::OPERATION [::qw::progress::auto] \ .database_id [$_database cpp_database_id_get] \ .file [$_database cpp_database_path] \ .limit $Progress1Limit \ .destroy_skip $DestroySkip \ .resolution $Progress1Resolution \ .operation "checking account histories" \ .status "[$_database cpp_database_path] checking account histories against postings." \ ]; ::qw::finally [::list ::itcl::delete object $Progress1]; } ::set ErrorList ""; ::set IfsFile [$_database cpp_file_factory]; ::qw::finally [::list $IfsFile cpp_destroy]; ::foreach Account $Accounts { ::set OS [$_database cpp_object_structure_load .address $Account]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::set ClassPath [::sargs::get $OS .system.class_path]; ::if {![account_postings_collection_is_enabled .object_id $ObjectId]} { ::if {$Progress1 ne ""} { $Progress1 increment; } ::continue; } ::set File [::qw::newviews::account_history::account_history_file .account.address $Account]; $IfsFile cpp_file_open \ .path $File \ ; ::set RecordCount [$IfsFile cpp_record_count]; ::set Progress2Limit $RecordCount; ::set Progress2Resolution 1; ::set Progress2 ""; ::set Progress2Minimum 100; ::set Progress2Resolution 7; ::if {$Progress2Limit>=$Progress2Minimum} { ::set Progress2 [::QW::PROGRESS::OPERATION [::qw::progress::auto] \ .database_id [$_database cpp_database_id_get] \ .file [$_database cpp_database_path] \ .limit $Progress2Limit \ .destroy_skip 0 \ .resolution $Progress2Resolution \ .operation "checking account histories" \ .status "[$_database cpp_database_path] checking account histories against available postings." \ ]; ::qw::finally [::list ::itcl::delete object $Progress2]; } ::for {::set Record [$IfsFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$IfsFile cpp_record_next $Record]} { ::if {$Progress2 ne ""} { $Progress2 increment; } ::set Errors [account_history_check .account.object_id $ObjectId .record $Record .file_path $File]; ::set ErrorList [::concat $ErrorList $Errors]; } ::if {$Progress2 ne ""} { $Progress2 destroy; } ::if {$Progress1 ne ""} { $Progress1 increment; } } ::set Handle [::open [::file rootname $_database_path]_account_history_check.txt w+]; ::qw::finally [::list ::close $Handle]; ::if {[::llength $ErrorList]==0} { ::puts $Handle "No account history check errors detected for database $_database_path."; } else { ::set Count 0; ::puts $Handle "Account history check detected [::llength $ErrorList] errors for database $_database_path."; ::foreach Error $ErrorList { ::puts $Handle "$Count --------------------------------------------------"; ::puts $Handle [::sargs::format.structure $Error]; ::incr Count; } } #::close $Handle; ::if {$rwb1_debug} { ::puts "account_history_check,seconds==[::expr {[::clock seconds]-$ClockStart}],root_account_only==[::sargs::boolean_get $sargs .root_account_only]"; } ::if {[::llength $ErrorList]!=0||!$NotifySkip} { ::set Text "History check detected [::llength $ErrorList] errors."; ::qw::dialog::notify \ .title $Text \ .text $Text \ ; } ::return $ErrorList; } ::set ErrorList ""; ::set ObjectId [::sargs::get $sargs .account.object_id]; ::if {$ObjectId eq ""} { ::qw::bug 314120090528141954 "Encountered empty account object id."; } ::set HistoryFileRecord [::sargs::get $sargs .record]; ::if {$HistoryFileRecord eq ""} { ::qw::bug 314120090413121302 "Encountered empty history record argument."; } ::set Key [::sargs::get $HistoryFileRecord .key]; ::if {![account_postings_collection_is_enabled .object_id $ObjectId]} { ::qw::bug 314120090514104048 "Encountered unexpected disabled account with object id \"$ObjectId\"."; } ::set Tag [::lindex $Key 1]; ::set BeginDate ""; ::set EndDate [::lindex $Key 3]; ::if {$EndDate ne ""} { ::set BeginDate "[::string range $EndDate 0 7]"; ::set EndDate "[::string range $EndDate 0 7]"; } ::set Amounts ""; ::foreach {Path Value} [::sargs::get $HistoryFileRecord .amounts] { ::sargs::var::set Amounts $Path $Value; } ::set OS [$_database cpp_object_structure_load .object_id $ObjectId]; ::set ClassPath [::sargs::get $OS .system.class_path]; ::set AccountPath [::sargs::get $OS .system.path]; ::set AccountName [::sargs::get $OS .data.name]; ::set AccountDescription [::sargs::get $OS .data.description]; ::foreach AmountName [::concat [::list .reference_count] $::qw::newviews::posting_amounts] { ::sargs::var::set Amounts .debit$AmountName [::qw::number::sum \ [::sargs::real_get $Amounts .open_debit$AmountName] \ [::sargs::real_get $Amounts .closed_debit$AmountName] \ ]; ::sargs::var::set Amounts .credit$AmountName [::qw::number::sum \ [::sargs::real_get $Amounts .open_credit$AmountName] \ [::sargs::real_get $Amounts .closed_credit$AmountName] \ ]; ::sargs::var::set Amounts .open$AmountName [::qw::number::sum \ [::sargs::real_get $Amounts .open_debit$AmountName] \ [::sargs::real_get $Amounts .open_credit$AmountName] \ [::sargs::real_get $Amounts .open_debit_boomerang$AmountName] \ [::sargs::real_get $Amounts .open_credit_boomerang$AmountName] \ ]; ::sargs::var::set Amounts .closed$AmountName [::qw::number::sum \ [::sargs::real_get $Amounts .closed_debit$AmountName] \ [::sargs::real_get $Amounts .closed_credit$AmountName] \ [::sargs::real_get $Amounts .closed_debit_boomerang$AmountName] \ [::sargs::real_get $Amounts .closed_credit_boomerang$AmountName] \ ]; ::sargs::var::set Amounts .all$AmountName [::qw::number::sum \ [::sargs::real_get $Amounts .open$AmountName] \ [::sargs::real_get $Amounts .closed$AmountName] \ ]; } ::foreach AmountName $::qw::newviews::posting_amounts { ::set DebitPlusCredit [::qw::number::sum \ [::sargs::real_get $Amounts .debit$AmountName] \ [::sargs::real_get $Amounts .credit$AmountName] \ ]; ::set OpenPlusClosed [::sargs::real_get $Amounts .all$AmountName]; ::if {$OpenPlusClosed!=$DebitPlusCredit} { ::qw::bug 314120090413121348 "Expected \"OpenPlusClosed\" to equal \"$DebitPlusCredit\" for amount \"$AmountName\"."; } } ::foreach {Index Flow} { /debit .debit /credit .credit /open .open /closed .closed "" .all } { ::if {[::sargs::real_get $Amounts $Flow.reference_count]==0.0} { /* { We can skip many of the flows. For example, an expense account will typically have debits for a given period, but no credits. Similarly, because expense accounts are never reconciled there will be no closed amounts. However, if we wanted to, we could perform the (time consuming) check anyway, just to be sure there are no amounts out there in the actual index. */ } ::continue; } ::switch -- $EndDate { "" { /* { pre-2.25.4 ::set Totals [$_database cpp_file_totals \ .path /odb/index$ClassPath.postings.index/date$Index \ .range.begin [::list string $ObjectId tag $Tag date ""] \ .range.end [::list string $ObjectId tag $Tag] \ ]; */ } # nv2.25.4 - added date "" to end range key ::set Totals [$_database cpp_file_totals \ .path /odb/index$ClassPath.postings.index/date$Index \ .range.begin [::list string $ObjectId tag $Tag date ""] \ .range.end [::list string $ObjectId tag $Tag date ""] \ ]; } default { /* { pre-2.25.4 ::set Totals [$_database cpp_file_totals \ .path /odb/index$ClassPath.postings.index/date$Index \ .range.begin [::list string $ObjectId tag $Tag date $BeginDate] \ .range.end [::list string $ObjectId tag $Tag date $EndDate] \ ]; */ } ::set Totals [$_database cpp_file_totals \ .path /odb/index$ClassPath.postings.index/date$Index \ .range.begin [::list string $ObjectId tag $Tag date $BeginDate] \ .range.end [::list string $ObjectId tag $Tag date $EndDate] \ ]; } } /* { ::if {!$::qw::control(account_history_lookup_end_empty_is_special)&&$EndDate eq ""} { ::set Totals [$_database cpp_file_totals \ .path /odb/index$ClassPath.postings.index/date$Index \ .range.begin [::list string $ObjectId tag $Tag] \ .range.end [::list string $ObjectId tag $Tag] \ ]; } else { ::set Totals [$_database cpp_file_totals \ .path /odb/index$ClassPath.postings.index/date$Index \ .range.begin [::list string $ObjectId tag $Tag date $BeginDate] \ .range.end [::list string $ObjectId tag $Tag date $EndDate] \ ]; } */ } ::foreach AmountName $::qw::newviews::posting_amounts { ::set ActualValue [::sargs::real_get $Totals $AmountName]; ::set HistoryValue [::sargs::real_get $Amounts $Flow$AmountName]; ::if {[::qw::number::compare $ActualValue $HistoryValue]!=0} { ::set Exception [::sargs \ .text "Encountered history error on account \"$AccountName\"." \ .exception_id 314120090413121406 \ .account_path $AccountPath \ .account_name $AccountName \ .account_description $AccountDescription \ .begin_date $BeginDate \ .end_date $EndDate \ .flow $Flow \ .tag $Tag \ .field $AmountName \ .history_value $HistoryValue \ .actual_value $ActualValue \ .history_less_actual [::expr {$HistoryValue-$ActualValue}] \ .history_record $HistoryFileRecord \ ]; ::lappend ErrorList $Exception; } } /* { Now we check the reference counts against the actual number of postings in the corresponding index file. */ } ::set ActualValue [::sargs::real_get $Totals .count]; ::set HistoryValue [::sargs::real_get $Amounts $Flow.reference_count]; ::if {[::qw::number::compare $ActualValue $HistoryValue]!=0} { ::set Exception [::sargs \ .text "Encountered history error on account \"$AccountName\"." \ .exception_id 314120090413121427 \ .account_path $AccountPath \ .account_name $AccountName \ .account_description $AccountDescription \ .begin_date $BeginDate \ .end_date $EndDate \ .flow $Flow \ .tag $Tag \ .field .reference_count \ .history_value $HistoryValue \ .actual_value $ActualValue \ .history_less_actual [::expr {$HistoryValue-$ActualValue}] \ .history_record $HistoryFileRecord \ ]; ::lappend ErrorList $Exception; } } account_history_record_garbage_collect $sargs; ::return $ErrorList; } method account_postings_collection_is_enabled {sargs} { ::set ObjectId [::sargs::get $sargs .object_id]; ::if {![::info exists _account_postings_collection_is_enabled($ObjectId)]} { ::set OS [$_database cpp_object_structure_load .object_id $ObjectId]; ::set IsEnabled [::sargs::boolean_get $OS .data.postings_collection_is_enabled]; ::set _account_postings_collection_is_enabled($ObjectId) $IsEnabled; } ::return $_account_postings_collection_is_enabled($ObjectId); } method account_history_record_garbage_collect {sargs} { /* { Whenever we examine a history record we have the option of deleting it if all references counts within the record are zero. This method returns 1/0 if the history record was/wasn't be deleted. */ } ::set Record [::sargs::get $sargs .record]; ::if {$Record eq ""} { ::qw::bug 314120090716093822 "Encountered empty history record argument."; } ::set Amounts [::sargs::get $Record .amounts]; ::foreach {Path Value} $Amounts { ::switch -glob -- $Path { .count { ::if {$Value!=1.0} { ::qw::bug 314120090317103822 "Encountered invalid count \"$Value\"."; } } *.reference_count { ::switch -- [::qw::number::compare $Value 0.0] { -1 { ::qw::bug 314120090317103821 "Encountered invalid reference count \"$Value\"."; } 0 { } 1 { ::return 0; } } } *.amount { } *.quantity { } *.contact_duration { } default { ::qw::bug 314120090317103820 "Encountered invalid amount path \"$Path\"."; } } } /* { The reference counts are all zero and we will delete the account history record. However, we first perform sanity check that all of the amounts and quantities are zero. */ } ::set FilePath [::sargs::get $sargs .file_path]; ::if {$FilePath eq ""} { ::qw::bug 314120090716094300 "Encountered empty file path."; } ::foreach {Path Value} $Amounts { ::switch -glob -- $Path { *.reference_count { } *.amount { ::qw::bug 314120090317104558 "Encountered invalid amount \"$Value\"."; } *.quantity { ::qw::bug 314120090317104559 "Encountered invalid quantity \"$Value\"."; } *.contact_duration { ::qw::bug 314120100914134301 "Encountered invalid contact duration \"$Value\"."; } .count { } default { ::qw::bug 314120090317103823 "Encountered invalid amount path \"$Path\"."; } } } $_database cpp_file_record_delete .path $FilePath .before $Record; ::return 1; } method account_history_garbage_collect {sargs} { /* { Removes every history record that has all zero reference_counts. */ } ::set rwb1_debug 0; ::set Command [::sargs::get $sargs .garbage_collection_command]; ::switch -- $Command { "" { ::if {$rwb1_debug} { ::set ClockStart [::clock seconds]; } ::set DestroySkip [::sargs::boolean_get $sargs .destroy_skip]; ::set NotifySkip [::sargs::boolean_get $sargs .notify_skip]; ::set InodesFile [$_database cpp_file_factory]; ::qw::finally [::list $InodesFile cpp_destroy]; $InodesFile cpp_file_open \ .path / \ .range.begin [::list string $::qw::control(account_history_folder)] \ .range.end [::list string $::qw::control(account_history_folder)] \ ; ::set ProgressLimit [$InodesFile cpp_record_count]; ::set ProgressResolution 1; ::set ProgressMinimum 1; ::set Progress ""; ::if {$ProgressLimit>=$ProgressMinimum} { ::set Progress [::QW::PROGRESS::OPERATION [::qw::progress::auto] \ .database_id [$_database cpp_database_id_get] \ .file [$_database cpp_database_path] \ .limit $ProgressLimit \ .resolution $ProgressResolution \ .operation "eliminating zero histories" \ .status "[$_database cpp_database_path] garbage collecting account histories." \ ]; ::qw::finally [::list ::itcl::delete object $Progress]; } ::set DeletedCount 0; ::for {::set Record [$InodesFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$InodesFile cpp_record_next $Record]} { ::set Path [::sargs::get $Record .data.path]; ::incr DeletedCount [account_history_garbage_collect .garbage_collection_command process_file .file_path $Path]; ::if {$Progress ne ""} { $Progress increment; } } ::if {$rwb1_debug} { ::puts "account_history_garbage_collect,seconds==[::expr {[::clock seconds]-$ClockStart}]"; } ::if {!$NotifySkip} { ::set Text "Account history garbage collection deleted $DeletedCount records."; ::qw::dialog::notify \ .title $Text \ .text $Text \ ; } ::return; } "process_file" { ::set FilePath [::sargs::get $sargs .file_path]; ::set IfsFile [$_database cpp_file_factory]; ::qw::finally [::list $IfsFile cpp_destroy]; $IfsFile cpp_file_open \ .path $FilePath \ ; ::set RecordCount [$IfsFile cpp_record_count]; ::set ProgressLimit $RecordCount; ::set ProgressMinimum 1000; ::set ProgressResolution 19; ::set Progress ""; ::set DeletedCount 0; ::if {$ProgressLimit>=$ProgressMinimum} { ::set Progress [::QW::PROGRESS::OPERATION [::qw::progress::auto] \ .database_id [$_database cpp_database_id_get] \ .file [$_database cpp_database_path] \ .limit $ProgressLimit \ .resolution $ProgressResolution \ .operation "eliminating zero histories" \ .status "[$_database cpp_database_path] garbage collecting account histories." \ ]; ::qw::finally [::list ::itcl::delete object $Progress]; } ::for {::set Record [$IfsFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$IfsFile cpp_record_next $Record]} { ::if {$Progress ne ""} { $Progress increment; } ::incr DeletedCount [account_history_garbage_collect .garbage_collection_command process_record .file_path $FilePath .record $Record]; } ::return $DeletedCount; } "process_record" { ::set Record [::sargs::get $sargs .record]; ::if {$Record eq ""} { ::qw::bug 314120090317103519 "Encountered empty history record argument."; } ::set FilePath [::sargs::get $sargs .file_path]; ::if {$FilePath eq ""} { ::qw::bug 314120090527175922 "Encountered empty file path."; } ::return [account_history_record_garbage_collect $sargs]; ::if {![account_history_record_can_be_deleted $sargs]} { ::return 0; } /* { The reference counts are all zero and we will delete the account history record. However, we first perform sanity check that all of the amounts and quantities are zero. */ } ::foreach {Path Value} $Amounts { ::switch -glob -- $Path { *.reference_count { } *.amount { ::qw::bug 314120090317104558 "Encountered invalid amount \"$Value\"."; } *.quantity { ::qw::bug 314120090317104559 "Encountered invalid quantity \"$Value\"."; } *.contact_duration { ::qw::bug 314120100914134241 "Encountered invalid contact duration \"$Value\"."; } .count { } default { ::qw::bug 314120090317103823 "Encountered invalid amount path \"$Path\"."; } } } $_database cpp_file_record_delete .path $FilePath .before $Record; ::return 1; } } ::qw::bug 314120090716105701 "Encountered invalid command \"$Command\"."; } method transaction_odb_field_get {sargs} { ::set rwb1_debug 0; ::set Field [::sargs::get $sargs .field]; ::if {$Field eq ""} { ::qw::bug 314120090108171959 "Encountered an empty field argument."; } ::set ObjectId [::sargs::get $sargs .object_id]; ::if {$ObjectId ne ""} { ::set ObjectStructure [$_database cpp_object_structure_load .object_id $ObjectId]; } else { ::set Address [::sargs::get $sargs .address]; ::if {$Address ne ""} { ::set ObjectStructure [$_database cpp_object_structure_load .address $Address]; ::set ObjectId [::sargs::get $ObjectStructure .system.object_id]; } else { ::set ObjectStructure [::sargs::get $sargs .object_structure]; ::set ObjectId [::sargs::get $ObjectStructure .system.object_id]; } } ::if {$ObjectStructure eq ""} { ::qw::bug 314120090108172000 "Could not retrieve an object structure."; } ::switch -glob -- $Field { .reference - .date { ::set Value [::sargs::get $ObjectStructure .data$Field]; ::if {$Value ne ""} { ::return $Value; } ::set BaseObjectId [::sargs::get $ObjectStructure .system.base_object_id]; ::set ClassObjectId [::sargs::get $ObjectStructure .system.class_object_id]; ::if {$BaseObjectId ne $ClassObjectId} { ::set Value [transaction_odb_field_get .object_id $BaseObjectId .field $Field]; } ::return $Value; } .posting*.amount { ::if {$::qw::control(summed_fields_are_gone)} { ::return [::sargs::real_get $ObjectStructure .data$Field]; } ::if {[::sargs::exists $ObjectStructure .data$Field]} { ::return [::sargs::real_get $ObjectStructure .data$Field]; } ::set Field [::string map {.amount {}} $Field]; ::set ClassPath [::sargs::get $ObjectStructure .system.class_path]; ::set Meta [get_meta .class_path $ClassPath]; ::set Subs [::sargs::subs .structure [::sargs::get $Meta $Field]] ::if {[llength $Subs]!=0} { /* { For now we are asking for amounts only when the account reference is non-empty and we only fill in the account in posting leaves, so we should never be asking for the amount of a posting branch. */ } ::qw::bug 314120090304090234 "Encountered unexpected subs \"$Subs\"."; ::set Sum 0.0; ::foreach Sub $Subs { ::set Sum [::qw::number::sum $Sum [transaction_odb_field_get $sargs .field $Field$Sub.amount]]; } ::return $Sum; } ::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 Sum [::sargs::real_get $Totals $Field.amount]; ::return $Sum; } .posting*.quantity { ::if {$::qw::control(summed_fields_are_gone)} { ::return [::sargs::real_get $ObjectStructure .data$Field]; } ::if {[::sargs::exists $ObjectStructure .data$Field]} { ::return [::sargs::real_get $ObjectStructure .data$Field]; } ::set Field [::string map {.quantity {}} $Field]; ::set ClassPath [::sargs::get $ObjectStructure .system.class_path]; ::set Meta [get_meta .class_path $ClassPath]; ::set Subs [::sargs::subs .structure [::sargs::get $Meta $Field]] ::if {[llength $Subs]!=0} { ::set Sum 0.0; ::foreach Sub $Subs { ::set Sum [::qw::number::sum $Sum [transaction_odb_field_get $sargs .field $Field$Sub.quantity]]; } ::return $Sum; } ::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 Sum [::sargs::real_get $Totals $Field.quantity]; ::return $Sum; } .posting*.contact_duration { /* { # This is the method used to get the amounts for ledger index rbs. public method elapsed_time_seconds {} { #// #// /OBJECT/NEWVIEWS/SYSTEM/TRANSACTION #// ::if {[::qw::date::is_null [[$this ".time_start"] odb_get]]} {::return 0;} ::if {[::qw::date::is_null [[$this ".time_end"] odb_get]]} {::return 0;} ::set Duration [::qw::date::difference [[$this ".time_end"] odb_get] [[$this ".time_start"] odb_get] "second"]; ::return $Duration; } */ } /* { The contact duration was implemented as a method and not as a posting field. This makes it somewhat of a sepcial case. */ } ::set TimeStart [::sargs::get $ObjectStructure .data.time_start]; ::if {$TimeStart eq ""} { ::return 0.0; } ::set TimeEnd [::sargs::get $ObjectStructure .data.time_end]; ::if {$TimeEnd eq ""} { ::return 0.0; } ::set Duration [::qw::date::difference $TimeEnd $TimeStart second]; ::return $Duration; } .posting*.reconcile { ::set Value [::sargs::get $ObjectStructure .data$Field]; ::return $Value; } .tags { /* { 2.17 Tags were split into partition tags from the journal and allocation tags from distribution items. It looks a lot like tags are not allowed in the header .tags field. We must always have parition tags. In addition, if the distribution item has allocation tags, then we append to the existing parition tags the cross-product of partition.allocation tags. */ } ::set ClassPath [::sargs::get $ObjectStructure .system.class_path]; ::switch -glob -- $ClassPath { /OBJECT/NEWVIEWS/SYSTEM/TRANSACTION* { ::set Journal [::sargs::get $ObjectStructure .data.journal]; ::set PartitionTags ""; ::if {$Journal eq ""} { /* { There is no journal. We must be on a distribution item. The partition tags come from the header and the allocation tags from the distribution. */ } ::set PartitionTags ""; ::set BaseObjectId [::sargs::get $ObjectStructure .system.base_object_id]; ::set ClassObjectId [::sargs::get $ObjectStructure .system.class_object_id]; ::if {$BaseObjectId ne $ClassObjectId} { ::set PartitionTags [transaction_odb_field_get .object_id $BaseObjectId .field $Field]; } ::set Tags $PartitionTags; ::set AllocationTags [::sargs::get $ObjectStructure .data$Field]; ::if {$AllocationTags ne ""} { ::foreach Ptag $PartitionTags { ::foreach Atag $AllocationTags { ::set Tags [::qw::union $Tags $Ptag.$Atag]; } } } ::return $Tags; } /* { This is the header case. Note that allocation tags are (currently) not allowed in the header so the allocation list will in fact always be empty. However, if they are allowed in the future, the cross-product will be generated. */ } ::set PartitionTags [transaction_odb_field_get .address $Journal .field $Field]; ::set Tags $PartitionTags; ::set AllocationTags [::sargs::get $ObjectStructure .data$Field]; ::if {$AllocationTags ne ""} { ::foreach Ptag $PartitionTags { ::foreach Atag $AllocationTags { ::set Tags [::qw::union $Tags $Ptag.$Atag]; } } } ::return $Tags; } /OBJECT/NEWVIEWS/JOURNAL { ::return [::sargs::get $ObjectStructure .data$Field]; } /OBJECT/NEWVIEWS/JOURNAL/* { #*/; ::set Closure [::sargs::get $ObjectStructure .data$Field]; ::set BaseObjectId [::sargs::get $ObjectStructure .system.base_object_id]; ::if {$BaseObjectId ne ""} { ::set Closure [::qw::union $Closure [transaction_odb_field_get .object_id $BaseObjectId .field $Field]]; } ::return $Closure; } default { ::if {$rwb1_debug} { ::puts "object_structure==\n[::sargs::format.structure $ObjectStructure]"; } /* { - bug - This bug went of when converting x:\Skyld_Holding_20090713\original\denis.nv2 from 2.14 to 2.15. He added a journal instance to /JOURNAL/BANK and this seems to have resulted in transactions being attached directly to /SYSTEM/TRANSACTION The structures of an offending transaction and journal: .system { .base_object_id 1136604909_25 .class_object_id 1136604909_25 .class_path /OBJECT/NEWVIEWS/SYSTEM/TRANSACTION .object_id 1138328990_73104 .path /OBJECT/NEWVIEWS/SYSTEM/TRANSACTION/1138328990_73104 .id /1138328990_73104 } .data { .odb_base /1136604909_25.odb_deriveds .description {virement de BONI a SIGN} .folder file .journal /1138328990_73102.transactions .date 20060126 .reference 1 .posting { /debit { .account /1136604909_1547.postings .amount 200.0 .reconcile 1060210 } /credit { .account /1136604909_1548.postings .amount -200.0 .reconcile 1060210 } } } .system { .base_object_id 1136604909_36 .class_object_id 1136604909_36 .class_path /OBJECT/NEWVIEWS/JOURNAL/BANK .object_id 1138328990_73102 .path /OBJECT/NEWVIEWS/JOURNAL/BANK/1138328990_73102 .id /1138328990_73102 } .data { .odb_base /1136604909_36.odb_deriveds .name VIREMENTS .description {Virements bancaires} .folder folder .tags financial } This bug was caught when attempting to get .tags from a transaction before I allowed the /OBJECT/NEWVIEWS/SYSTEM/TRANSACTION case. We will have to do three things. (1) Add a check in nvcheck to detect this. (2) Find a way to fix it and add repair to nvcheck. (3) Find out why it was allowed in the first place. */ } ::qw::bug 314120090109164528 "Encountered invalid class path \"$ClassPath\"."; } } } default { ::qw::bug 314120090108172737 "Could not process field \"$Field\"."; } } } method transitive_closure {sargs} { /* { Returns closure as list of master addresses with database prefix. */ } # ::set Account [::qw::odb::address_from_disk .database $_database .address [::sargs::get $sargs .account]]; ::set Account [::sargs::get $sargs .account]; # next line ensures account has database prefix and no field. ::set Account [$_database cpp_get_master_address .address $Account]; ::if {![::info exists _closures($Account)]} { ::set Closure $Account; ::set ObjectStructure [$_database cpp_object_structure_load .address $Account]; ::foreach Field { .total.parent0 .total.parent1 .total.parent2 .total.parent3 .total.parent4 } { ::set Parent [$_database cpp_get_master_address .address [::sargs::get $ObjectStructure .data$Field]]; ::if {$Parent ne ""} { ::set Parent [::qw::odb::object_address_extract .address $Parent]; ::set Closure [::qw::union $Closure [transitive_closure .account $Parent]]; } } ::set _closures($Account) $Closure; } ::return $_closures($Account); } method is_boomerang {sargs} { ::set OS [::sargs::get $sargs .transaction_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. When boomerangs are attached to summary postings they should both be attached to the same one. But we want to ensure that this code works then the transaction has one pant leg on and one off, i.e. one side attached to summary posting but the other still attached to an account. So things get a little more complicated. We always go right through the summary posting, if any, to the account itself. Note that we also do not use summary posting methods because they should instead be able to use this method. */ } ::set DebitSideAccount [::sargs::get $OS .data.posting/debit.account]; ::if {$DebitSideAccount eq ""} { ::return 0; } ::set CreditSideAccount [::sargs::get $OS .data.posting/credit.account]; ::if {$CreditSideAccount eq ""} { ::return 0; } ::set DebitSideOS [$_database cpp_object_structure_load .address $DebitSideAccount]; ::set DebitSideAccount [::qw::odb::object_address_extract .address $DebitSideAccount]; ::set CreditSideOS [$_database cpp_object_structure_load .address $CreditSideAccount]; ::set CreditSideAccount [::qw::odb::object_address_extract .address $CreditSideAccount]; ::if {$DebitSideAccount eq ""} { ::return 0; } ::if {$CreditSideAccount eq ""} { ::return 0; } ::if {$DebitSideAccount eq $CreditSideAccount} { ::return 1; } ::return 0; } method account_history_deltas_get {sargs} { /* { Builds the deltas. The before deltas are built at the time that we schedule for commit. The after deltas are built when we commit. The transaction stored the before delta amounts, one set of amounts per posting (each posting typically has different amounts). The postings will all share the tags and date whether before or after. Note that each posting will have only one primary flow, i.e. open_debit, open_credit, closed_debit, or closed_credit (or a boomerang equivalent). However that flow will in turn have any of the amounts such as .reference_count, .amount and .quantity (and crm may have more). */ } ::if {[odb_is_remote]} { ::qw::bug 314120090306115907 "Encountered unexpected call on remote object." } ::set ResultList ""; ::set IsBoomerang [is_boomerang]; ::foreach Posting [postings] { ::set Collection [$Posting.account qw_get]; ::if {$Collection eq ""} { ::continue; } ::set Date [$this.date odb_get]; ::set Account [$Collection odb_master]; ::set Amount [$Posting.amount odb_get]; ::set Quantity [$Posting.quantity odb_get]; ::if {$::qw::control(crm_include)} { ::set ContactDuration [$Posting.contact_duration odb_get]; } ::set Reconcile [$Posting.reconcile odb_get]; ::set Flow ""; ::switch -- $IsBoomerang { 0 { ::set Suffix ""; } 1 { ::set Suffix _boomerang; } } ::switch -- $Reconcile { "" { ::switch -- [::qw::number::compare $Amount 0.0] { 1 { ::set Flow .open_debit$Suffix; } -1 { ::set Flow .open_credit$Suffix; } 0 { ::switch -glob -- $Posting { *.posting/debit* { ::set Flow .open_debit$Suffix; } *.posting/credit* { ::set Flow .open_credit$Suffix; } default { ::qw::bug 314120090306102352 "Encountered unexpected non-zero posting \"$Posting\"."; } } } } } default { ::switch -- [::qw::number::compare $Amount 0.0] { 1 { ::set Flow .closed_debit$Suffix; } -1 { ::set Flow .closed_credit$Suffix; } 0 { ::switch -glob -- $Posting { *.posting/debit* { ::set Flow .closed_debit$Suffix; } *.posting/credit* { ::set Flow .closed_credit$Suffix; } default { ::qw::bug 314120090306102353 "Encountered unexpected non-zero posting \"$Posting\"."; } } } } } } ::set DeltaAmounts [::list \ $Flow.reference_count 1.0 \ $Flow.amount $Amount \ $Flow.quantity $Quantity \ ]; ::if {$::qw::control(crm_include)} { ::lappend DeltaAmounts $Flow.contact_duration $ContactDuration; } ::lappend ResultList $Posting $DeltaAmounts; } ::return $ResultList; } method account_history_amounts_build {sargs} { /* { Builds amounts from a transaction posting. The amounts will have a single primary flow, i.e. open_debit, open_credit, closed_debit, or closed_credit (or a boomerang equivalent). Build the amounts from an transaction in an odb database manager. */ } ::set Transaction [::sargs::get $sargs .transaction]; ::if {$Transaction eq ""} { ::qw::bug 314120090306101009 "Encountered empty \".transaction\" argument." } ::set PostingField [::sargs::get $sargs .posting_field]; ::if {$PostingField eq ""} { ::qw::bug 314120090306101010 "Encountered empty \".posting_field\" argument." } ::set Collection [[$Transaction $PostingField.account] qw_get]; ::if {$Collection eq ""} { ::return; } ::set IsBoomerang [$Transaction is_boomerang]; ::set After(account) [$Collection odb_master]; ::set After(amount) [[$Transaction $PostingField.amount] odb_get]; ::set After(quantity) [[$Transaction $PostingField.quantity] odb_get]; ::if {$::qw::control(crm_include)} { ::lappend After(contact_duration) [[$Transaction $PostingField.contact_duration] odb_get]; } ::set After(reconcile) [[$Transaction $PostingField.reconcile] odb_get]; ::set After(flow) ""; ::switch -- [$Transaction is_boomerang] { 0 { ::set Suffix ""; } 1 { ::set Suffix _boomerang; } } ::switch -- $After(reconcile) { "" { ::switch -- [::qw::number::compare $After(amount) 0.0] { 1 { ::set After(flow) .open_debit$Suffix; } -1 { ::set After(flow) .open_credit$Suffix; } 0 { ::switch -glob -- $PostingField { .posting/debit* { ::set After(flow) .open_debit$Suffix; } .posting/credit* { ::set After(flow) .open_credit$Suffix; } default { ::qw::bug 314120090306102352 "Encountered unexpected non-zero posting \"$PostingField\"."; } } } } } default { ::switch -- [::qw::number::compare $After(amount) 0.0] { 1 { ::set After(flow) .closed_debit$Suffix; } -1 { ::set After(flow) .closed_credit$Suffix; } 0 { ::switch -glob -- $PostingField { .posting/debit* { ::set After(flow) .closed_debit$Suffix; } .posting/credit* { ::set After(flow) .closed_credit$Suffix; } default { ::qw::bug 314120090306102353 "Encountered unexpected non-zero posting \"$PostingField\"."; } } } } } } ::set DeltaAmounts [::list \ $After(flow).reference_count 1.0 \ $After(flow).amount $After(amount) \ $After(flow).quantity $After(quantity) \ ]; ::if {$::qw::control(crm_include)} { ::lappend DeltaAmounts $After(flow).contact_duration $After(contact_duration); } ::return $DeltaAmounts; } method get_account_object_id_list {sargs} { /* { Returns a list of account object ids for every account in the database, including text lines. We use it to create history files but I can guess that it may be needed elsewhere as well. Actually this is hard on memory and not particularly scalable. */ } ::set Address [::sargs::get $sargs .account.address]; ::if {$Address eq ""} { ::set OS [$_database cpp_object_structure_load .path /OBJECT/NEWVIEWS/ACCOUNT]; ::set Address /[::sargs::get $OS .system.object_id]; ::set Text [::sargs::get $sargs .operation.text]; ::if {$Text ne ""} { ::itcl::local ::QW::OPERATION #auto .text $Text; } ::return [get_account_object_id_list $sargs .account.address $Address]; } ::set OS [$_database cpp_object_structure_load .address $Address]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::set ClassPath [::sargs::get $OS .system.class_path]; ::set Result ""; ::lappend Result $ObjectId; ::set IfsFile [$_database cpp_file_factory]; ::qw::finally [::list $IfsFile cpp_destroy]; $IfsFile cpp_file_open \ .path /odb/index${ClassPath}.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ; ::for {::set Record [$IfsFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$IfsFile cpp_record_next $Record]} { ::set Address [::lindex [::sargs::get $Record .key] end]; ::set ObjectId [::qw::odb::object_id_extract .address $Address]; ::set KidList [get_account_object_id_list $sargs .account.address $Address]; /* { 2.15.4 The statement using concat produced an "unable to alloc" problem that was fixed using ::lappend. The exact reason was never determined. The failure occurred on database rhythm_cues_20091007 (kirk) during a convert from 2.14 to 2.15. */ } #::set Result [::concat $Result $KidList]; ::eval ::lappend Result $KidList; } ::return $Result; } method account_history_files_create {sargs} { /* { Re-wrote this method in 2.15.1 in order to control the counts better. */ } ::set rwb1_debug 0; ::set DestroySkip [::sargs::get $sargs .destroy_skip]; ::if {$rwb1_debug} { ::set ClockStart [::clock seconds]; } ::set AccountObjectIdList [get_account_object_id_list $sargs .operation.text "Preparing to create account history files."]; ::set ProgressLimit [::llength $AccountObjectIdList]; ::set ProgressResolution 1; ::set Progress ""; ::set ProgressMinimum 1; ::if {$ProgressLimit>1000} { ::set ProgressResolution 19; } ::if {$ProgressLimit>=$ProgressMinimum} { ::set Progress [::QW::PROGRESS::OPERATION [::qw::progress::auto] \ .database_id [$_database cpp_database_id_get] \ .file [$_database cpp_database_path] \ .limit $ProgressLimit \ .destroy_skip $DestroySkip \ .resolution $ProgressResolution \ .operation "creating account history files" \ .status "[$_database cpp_database_path] creating account history files." \ ]; ::qw::finally [::list ::itcl::delete object $Progress]; } ::foreach ObjectId $AccountObjectIdList { ::qw::newviews::account_history::account_history_file_create .database $_database .account.object_id $ObjectId; ::if {$Progress ne ""} { $Progress increment; } } ::if {$rwb1_debug} { ::puts "account_history_files_create,seconds==[::expr {[::clock seconds]-$ClockStart}]"; } } method account_history_files_patch_schema_amounts {sargs} { /* { Have to add the .contact_duration info when we added contact_duration to the account_histories. Normally in a reorg we delete the records but not the files themselves. So we have to patch the files. */ } ::set rwb1_debug 0; ::set DestroySkip [::sargs::boolean_get $sargs .destroy_skip]; ::set NotifySkip [::sargs::boolean_get $sargs .notify_skip]; ::if {$rwb1_debug} { ::set ClockStart [::clock seconds]; } ::set InodesFile [$_database cpp_file_factory]; ::qw::finally [::list $InodesFile cpp_destroy]; $InodesFile cpp_file_open \ .path / \ .range.begin [::list string $::qw::control(account_history_folder)] \ .range.end [::list string $::qw::control(account_history_folder)] \ ; ::set FileCount [$InodesFile cpp_record_count]; ::set ProgressLimit $FileCount; ::set ProgressResolution 1; ::set Progress ""; ::set ProgressMinimum 1; ::if {$ProgressLimit>1000} { ::set ProgressResolution 19; } ::if {$ProgressLimit>=$ProgressMinimum} { ::set Progress [::QW::PROGRESS::OPERATION [::qw::progress::auto] \ .database_id [$_database cpp_database_id_get] \ .file [$_database cpp_database_path] \ .limit $ProgressLimit \ .resolution $ProgressResolution \ .destroy_skip $DestroySkip \ .operation "patching account history schemas" \ .status "[$_database cpp_database_path] patching account history schemas." \ ]; ::qw::finally [::list ::itcl::delete object $Progress]; } ::for {::set Record [$InodesFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$InodesFile cpp_record_next $Record]} { ::set After $Record; ::set SchemaAmounts [::sargs::get $Record .data.schema.amounts]; ::if {[::string first ".contact_duration" $SchemaAmounts]>=0} { # just ensures that if already done we don't do it again ::continue; } ::set SchemaAmounts [::concat $SchemaAmounts [::list \ .open_debit.contact_duration \ .open_credit.contact_duration \ .closed_debit.contact_duration \ .closed_credit.contact_duration \ .open_debit_boomerang.contact_duration \ .open_credit_boomerang.contact_duration \ .closed_debit_boomerang.contact_duration \ .closed_credit_boomerang.contact_duration \ ]]; ::sargs::var::set After .data.schema.amounts $SchemaAmounts; $InodesFile cpp_record_write .before $Record .after $After; ::if {$Progress ne ""} { $Progress increment; } } ::if {$rwb1_debug} { ::puts "account_history_patch,seconds==[::expr {[::clock seconds]-$ClockStart}]"; } } method account_history_clear_date_range {sargs} { /* { This method could easily be incorporated into account_history_clear. Decided to keep it separate to keep progress messages separate etc. */ } ::set rwb1_debug 0; ::if {$::qw::control(crm_include)} { account_history_files_patch_schema_amounts $sargs; } ::set DestroySkip [::sargs::boolean_get $sargs .destroy_skip]; ::set NotifySkip [::sargs::boolean_get $sargs .notify_skip]; ::set BeginDate [::string range [::sargs::get $sargs .date.begin] 0 7]; ::set EndDate [::string range [::sargs::get $sargs .date.end] 0 7]; ::if {![::sargs::exists $sargs .date.begin]} { ::qw::bug 314120130301114953 "[::qw::methodname] - no begin date."; } ::if {![::sargs::exists $sargs .date.end]} { ::qw::bug 314120130301114954 "[::qw::methodname] - no end date."; } ::set BeginDateRange [::list date $BeginDate]; ::set EndDateRange [::list date $EndDate]; /* { code as at 2.23.5 ::set BeginDate ""; ::set BeginDateRange [::list]; ::set EndDate ""; ::set EndDateRange [::list]; if {$::qw::control(ifs_range_empty_versus_null_date)} { #2.25.3 ::if {[::sargs::exists $sargs .date.begin]} { ::set BeginDate [::string range [::sargs::get $sargs .date.begin] 0 7]; ::set BeginDateRange [::list date $BeginDate]; } ::if {[::sargs::exists $sargs .date.end]} { ::set EndDate [::string range [::sargs::get $sargs .date.end] 0 7]; ::set EndDateRange [::list date $EndDate]; } } else { ::set BeginDate [::string range [::sargs::get $sargs .date.begin] 0 7]; ::set EndDate [::string range [::sargs::get $sargs .date.end] 0 7]; ::if {$BeginDate eq ""} { ::qw::bug 314120121120112828 "[::qw::methodname] - no begin date."; } ::if {$EndDate eq ""} { ::qw::bug 314120121120112829 "[::qw::methodname] - no end date."; } ::set BeginDateRange [::list date $BeginDate]; ::set EndDateRange [::list date $EndDate]; } */ } ::if {$rwb1_debug} { ::set ClockStart [::clock seconds]; } ::set TagList [tag_list_get]; ::set InodesFile [$_database cpp_file_factory]; ::qw::finally [::list $InodesFile cpp_destroy]; # ------------------------------------------------------------ # Open InodesFile and set range on just the account history files. # ------------------------------------------------------------ $InodesFile cpp_file_open \ .path / \ .range.begin [::list string $::qw::control(account_history_folder)] \ .range.end [::list string $::qw::control(account_history_folder)] \ ; ::set FileCount [$InodesFile cpp_record_count]; ::set ProgressMinimum 1000; ::set ProgressLimit $FileCount; ::set Progress ""; ::if {$ProgressLimit>=$ProgressMinimum} { ::set Progress [::QW::PROGRESS::OPERATION [::qw::progress::auto] \ .database_id [$_database cpp_database_id_get] \ .file [$_database cpp_database_path] \ .user [$_database cpp_user_name] \ .limit $ProgressLimit \ .destroy_skip $DestroySkip \ .operation "account history pass 1" \ .status "[$_database cpp_database_path] preparing to rebuild account histories." \ ]; ::qw::finally [::list ::itcl::delete object $Progress]; } ::set ProgressAccumulator 0; ::for {::set Record [$InodesFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$InodesFile cpp_record_next $Record]} { ::if {[::qw::command_exists $Progress]} { ::incr ProgressAccumulator 1; ::if {$ProgressAccumulator>19} { $Progress increment $ProgressAccumulator; ::set ProgressAccumulator 0; } } ::set Path [::sargs::get $Record .data.path]; /* { The history record keys are tag xxx date xxxxxxxx. We are deleting the records for a particular date range, usually a particular day. We can't just delete the file. Also, we have to try to delete any records in the range for each tag. */ } ::foreach Tag $TagList { ::set RecordCount [$_database cpp_file_record_count \ .path $Path \ .range.begin [::concat [::list tag $Tag] $BeginDateRange] \ .range.end [::concat [::list tag $Tag] $EndDateRange] \ ]; ::if {$RecordCount!=0} { $_database cpp_file_delete_all_records \ .path $Path \ .range.begin [::concat [::list tag $Tag] $BeginDateRange] \ .range.end [::concat [::list tag $Tag] $EndDateRange] \ ; } } } ::if {[::qw::command_exists $Progress]} { ::if {$ProgressAccumulator>0} { $Progress increment $ProgressAccumulator; ::set ProgressAccumulator 0; } } } method account_history_clear {sargs} { /* { We delete all account history records but not the files themselves. */ } ::set rwb1_debug 0; ::if {$::qw::control(crm_include)} { account_history_files_patch_schema_amounts $sargs; } ::set DestroySkip [::sargs::boolean_get $sargs .destroy_skip]; ::set NotifySkip [::sargs::boolean_get $sargs .notify_skip]; ::if {$rwb1_debug} { ::set ClockStart [::clock seconds]; } ::set InodesFile [$_database cpp_file_factory]; ::qw::finally [::list $InodesFile cpp_destroy]; $InodesFile cpp_file_open \ .path / \ .range.begin [::list string $::qw::control(account_history_folder)] \ .range.end [::list string $::qw::control(account_history_folder)] \ ; ::set FileCount [$InodesFile cpp_record_count]; ::set ProgressLimit $FileCount; ::set ProgressResolution 1; ::set Progress ""; ::set ProgressMinimum 1; ::if {$ProgressLimit>1000} { ::set ProgressResolution 19; } ::if {$ProgressLimit>=$ProgressMinimum} { ::set Progress [::QW::PROGRESS::OPERATION [::qw::progress::auto] \ .database_id [$_database cpp_database_id_get] \ .file [$_database cpp_database_path] \ .user [$_database cpp_user_name] \ .limit $ProgressLimit \ .resolution $ProgressResolution \ .destroy_skip $DestroySkip \ .operation "clearing account histories" \ .status "[$_database cpp_database_path] clearing account histories." \ ]; ::qw::finally [::list ::itcl::delete object $Progress]; } ::for {::set Record [$InodesFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$InodesFile cpp_record_next $Record]} { ::if {[::qw::command_exists $Progress]} { $Progress increment; } ::set Path [::sargs::get $Record .data.path]; $_database cpp_file_delete_all_records .path $Path; } ::if {$rwb1_debug} { ::puts "account_history_clear,seconds==[::expr {[::clock seconds]-$ClockStart}]"; } } ::if {$::qw::control(fat_is_enabled)} { method account_history_build_one_transaction_paf {sargs} { /* { 2.33.0 This version can be used by the database_utilities_paf. 2.25.0 This was cut out of account_history_build when we added account_history_build_date_range. account_history_build_date_range and account_history_clear_date_range were added so we could clean up a particular date as part of fixing indexes without a full reorganize. */ } /* { We are going to update the histories for each account in the closure of each account referenced by each posting in a specified transaction. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.0";} ::set Transaction [::sargs::get $sargs .transaction]; ::if {$Transaction eq ""} { ::qw::bug 314120121120123151 "[::qw::methodname] - no transaction."; } ::set OS [$_database cpp_object_structure_load .address $Transaction]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::set ClassPath [::sargs::get $OS .system.class_path]; ::set KidList [$_database cpp_file_odb_masters \ .path /odb/index$ClassPath.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.1";} ::set ProgressLimit [::llength $KidList]; ::set ProgressMinimum 1000; ::if {$ProgressLimit>=$ProgressMinimum} { # ------------------------------------------------------------ # progress setup # ------------------------------------------------------------ ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.2,ProgressLimit==$ProgressLimit";} ::set IsInteractive 1; ::if {[::sargs::boolean_get $sargs .interactive_skip]} { ::set IsInteractive 0; } ::set CallerIsRemote [::sargs::boolean_get $sargs .caller_is_remote]; ::set MilliSeconds [::clock clicks -milliseconds]; ::set ProgressAccumulator 0; ::set RedProgress 0; ::set BlueProgress 0; ::if {$IsInteractive} { ::if {$CallerIsRemote} { ::set RedProgress 1; } else { ::set BlueProgress 1; } } ::set DatabasePath $_database_path; ::if {[::file extension $DatabasePath] eq ".tmp"} { /* { The path with extension .tmp would likely confuse the user. */ } ::set DatabasePath [::file rootname $DatabasePath.nv2]; } ::sargs::var::set sargs .limit $ProgressLimit; ::sargs::var::set sargs .file $DatabasePath; ::sargs::var::set sargs .database_id [$_database cpp_database_id_get]; ::sargs::var::set sargs .description "processing transaction details"; ::sargs::var::set sargs .operation "processing transaction details"; ::sargs::var::set sargs .user [$_database cpp_user_name]; ::sargs::var::set sargs .state "working"; ::sargs::var::set sargs .status "[$_database cpp_database_path] processing transaction details."; ::sargs::var::set sargs .count_variable [::qw::progress::count_variable_generate]; ::if {$RedProgress} { # ::sargs::var::set sargs .destroy_skip 0; # need to override because caller destroy_skip is 1. ::set RedProgressOperation [::QW::PROGRESS::OPERATION ::QW::PROGRESS::OPERATION::#auto $sargs]; # ::qw::finally [::list ::itcl::delete object $RedProgressOperation]; ::sargs::var::set sargs .red_progress_operation $RedProgressOperation; ::sargs::var::set sargs .operation_tag [$RedProgressOperation operation_tag_get]; } ::if {$BlueProgress} { ::set BlueOperationId [::qw::progress_blue::operation_create $sargs]; ::sargs::var::set sargs .operation_id $BlueOperationId; } ::qw::finally [::list ::qw::progress::operation_destroy $sargs]; ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.3";} } # ------------------------------------------------------------ ::foreach Kid $KidList { ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.4";} [::qw::methodname] $sargs .transaction $Kid; ::if {$ProgressLimit>=$ProgressMinimum} { ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.5";} ::incr ProgressAccumulator 1; ::if {($ProgressAccumulator%7)==0} { ::if {([::clock clicks -milliseconds]-$MilliSeconds)>100} { ::set MilliSeconds [::clock clicks -milliseconds]; ::set IsAborted [::qw::progress::operation_is_aborted $sargs]; ::if {$IsAborted} { ::qw::progress::operation_configure $sargs .state "aborted"; ::update; ::return [::sargs::set $sargs .state "aborted"]; } ::qw::progress::operation_increment $sargs .increment $ProgressAccumulator; ::set ProgressAccumulator 0; ::update; } } ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.6";} } } ::if {$ProgressLimit>=$ProgressMinimum} { ::if {$ProgressAccumulator!=0} { ::qw::progress::operation_increment $sargs .increment $ProgressAccumulator; ::set ProgressAccumulator 0; ::update; } ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.6";} } ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.7";} ::set After(tags) [transaction_odb_field_get .object_structure $OS .field .tags]; ::if {$After(tags) eq ""} { ::qw::bug 314120090109164330 "[::qw::methodname] - transaction with no tags."; } ::set IsBoomerang [is_boomerang .transaction_object_structure $OS]; ::set TransactionDate [transaction_odb_field_get .object_structure $OS .field .date]; ::set After(date) [::qw::newviews::account_history::account_history_date_from_transaction_date .date $TransactionDate]; ::if {$After(date) ne ""} { # ::set After(date) "[::string range $After(date) 0 7]235959"; ::set After(date) "[::string range $After(date) 0 7]"; } ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.8";} ::foreach PostingField [get_posting_fields .class_path $ClassPath] { ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.9";} ::set After(account) [::sargs::get $OS .data$PostingField.account]; ::if {$After(account) eq ""} { /* { Probably the root or a branch posting. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.10";} ::continue; } /* { The value has the .postings field at the end. Here we strip the field off. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.11";} ::set After(account) [::qw::odb::object_address_extract .address $After(account)]; /* { We could skip postings whose amounts are all zero but instead we want to increment the reference count in the history record. Even a zero will register as a debit or credit. This is analogous to posting zero amounts to the posting account. */ } ::set After(amount) [transaction_odb_field_get .object_structure $OS .field $PostingField.amount]; ::set After(quantity) [transaction_odb_field_get .object_structure $OS .field $PostingField.quantity]; ::if {$::qw::control(crm_include)} { ::set After(contact_duration) [transaction_odb_field_get .object_structure $OS .field $PostingField.contact_duration]; } ::set After(reconcile) [transaction_odb_field_get .object_structure $OS .field $PostingField.reconcile]; ::set After(closure) [transitive_closure .account $After(account)]; ::set After(flow) ""; ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.12";} ::switch -- $IsBoomerang { 0 { ::set Suffix ""; } 1 { ::set Suffix _boomerang; } } ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.13";} ::switch -- $After(reconcile) { "" { ::switch -- [::qw::number::compare $After(amount) 0.0] { 1 { ::set After(flow) .open_debit$Suffix; } -1 { ::set After(flow) .open_credit$Suffix; } 0 { ::switch -glob -- $PostingField { .posting/debit* { ::set After(flow) .open_debit$Suffix; } .posting/credit* { ::set After(flow) .open_credit$Suffix; } default { ::qw::bug 314120090218080714 "[::qw::methodname] - non-zero posting \"$PostingField\"."; } } } } } default { ::switch -- [::qw::number::compare $After(amount) 0.0] { 1 { ::set After(flow) .closed_debit$Suffix; } -1 { ::set After(flow) .closed_credit$Suffix; } 0 { ::switch -glob -- $PostingField { .posting/debit* { ::set After(flow) .closed_debit$Suffix; } .posting/credit* { ::set After(flow) .closed_credit$Suffix; } default { ::qw::bug 314120090218080715 "[::qw::methodname] - non-zero posting \"$PostingField\"."; } } } } } } # ::set DeltaAmounts [::list .count 1.0]; ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.14";} ::set DeltaAmounts ""; ::lappend DeltaAmounts $After(flow).reference_count 1.0; ::lappend DeltaAmounts $After(flow).amount $After(amount); ::lappend DeltaAmounts $After(flow).quantity $After(quantity); ::if {$::qw::control(crm_include)} { ::lappend DeltaAmounts $After(flow).contact_duration $After(contact_duration); } ::set Key [::list tag YYY date $After(date)]; ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.15";} ::foreach Account $After(closure) { ::foreach Tag $After(tags) { ::lset Key 1 $Tag; ::set DeltaRecord [::sargs \ .key $Key \ .amounts $DeltaAmounts \ ]; ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.16";} ::qw::newviews::account_history::account_history_record_add .database $_database .account.address $Account .delta $DeltaRecord; ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.17";} } } ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.18";} } ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_one_transaction_paf,1000.19";} } } method account_history_build_one_transaction {sargs} { /* { 2.25.0 This was cut out of account_history_build when we added account_history_build_date_range. account_history_build_date_range and account_history_clear_date_range were added so we could clean up a particular date as part of fixing indexes without a full reorganize. */ } /* { We are going to update the histories for each account in the closure of each account referenced by each posting in a specified transaction. */ } ::set Transaction [::sargs::get $sargs .transaction]; ::if {$Transaction eq ""} { ::qw::bug 314120121120123151 "[::qw::methodname] - no transaction."; } ::set OS [$_database cpp_object_structure_load .address $Transaction]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::set ClassPath [::sargs::get $OS .system.class_path]; ::set KidList [$_database cpp_file_odb_masters \ .path /odb/index$ClassPath.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::set Progress ""; ::set ProgressLimit [::llength $KidList]; ::set ProgressMinimum 1000; ::if {$ProgressLimit>=$ProgressMinimum} { ::set ProgressResolution 7; ::set Progress [::QW::PROGRESS::OPERATION [::qw::progress::auto] \ .database_id [$_database cpp_database_id_get] \ .file [$_database cpp_database_path] \ .limit $ProgressLimit \ .resolution $ProgressResolution \ .operation "processing transaction details" \ .status "[$_database cpp_database_path] processing transaction details." \ ]; ::qw::finally [::list ::itcl::delete object $Progress]; } ::foreach Kid $KidList { [::qw::methodname] $sargs .transaction $Kid; ::if {[::qw::command_exists $Progress]} { $Progress increment; } } ::set After(tags) [transaction_odb_field_get .object_structure $OS .field .tags]; ::if {$After(tags) eq ""} { ::qw::bug 314120090109164330 "[::qw::methodname] - transaction with no tags."; } ::set IsBoomerang [is_boomerang .transaction_object_structure $OS]; ::set TransactionDate [transaction_odb_field_get .object_structure $OS .field .date]; ::set After(date) [::qw::newviews::account_history::account_history_date_from_transaction_date .date $TransactionDate]; ::if {$After(date) ne ""} { # ::set After(date) "[::string range $After(date) 0 7]235959"; ::set After(date) "[::string range $After(date) 0 7]"; } ::foreach PostingField [get_posting_fields .class_path $ClassPath] { ::set After(account) [::sargs::get $OS .data$PostingField.account]; ::if {$After(account) eq ""} { /* { Probably the root or a branch posting. */ } ::continue; } /* { The value has the .postings field at the end. Here we strip the field off. */ } ::set After(account) [::qw::odb::object_address_extract .address $After(account)]; /* { We could skip postings whose amounts are all zero but instead we want to increment the reference count in the history record. Even a zero will register as a debit or credit. This is analogous to posting zero amounts to the posting account. */ } ::set After(amount) [transaction_odb_field_get .object_structure $OS .field $PostingField.amount]; ::set After(quantity) [transaction_odb_field_get .object_structure $OS .field $PostingField.quantity]; ::if {$::qw::control(crm_include)} { ::set After(contact_duration) [transaction_odb_field_get .object_structure $OS .field $PostingField.contact_duration]; } ::set After(reconcile) [transaction_odb_field_get .object_structure $OS .field $PostingField.reconcile]; ::set After(closure) [transitive_closure .account $After(account)]; ::set After(flow) ""; ::switch -- $IsBoomerang { 0 { ::set Suffix ""; } 1 { ::set Suffix _boomerang; } } ::switch -- $After(reconcile) { "" { ::switch -- [::qw::number::compare $After(amount) 0.0] { 1 { ::set After(flow) .open_debit$Suffix; } -1 { ::set After(flow) .open_credit$Suffix; } 0 { ::switch -glob -- $PostingField { .posting/debit* { ::set After(flow) .open_debit$Suffix; } .posting/credit* { ::set After(flow) .open_credit$Suffix; } default { ::qw::bug 314120090218080714 "[::qw::methodname] - non-zero posting \"$PostingField\"."; } } } } } default { ::switch -- [::qw::number::compare $After(amount) 0.0] { 1 { ::set After(flow) .closed_debit$Suffix; } -1 { ::set After(flow) .closed_credit$Suffix; } 0 { ::switch -glob -- $PostingField { .posting/debit* { ::set After(flow) .closed_debit$Suffix; } .posting/credit* { ::set After(flow) .closed_credit$Suffix; } default { ::qw::bug 314120090218080715 "[::qw::methodname] - non-zero posting \"$PostingField\"."; } } } } } } # ::set DeltaAmounts [::list .count 1.0]; ::set DeltaAmounts ""; ::lappend DeltaAmounts $After(flow).reference_count 1.0; ::lappend DeltaAmounts $After(flow).amount $After(amount); ::lappend DeltaAmounts $After(flow).quantity $After(quantity); ::if {$::qw::control(crm_include)} { ::lappend DeltaAmounts $After(flow).contact_duration $After(contact_duration); } ::set Key [::list tag YYY date $After(date)]; ::foreach Account $After(closure) { ::foreach Tag $After(tags) { ::lset Key 1 $Tag; ::set DeltaRecord [::sargs \ .key $Key \ .amounts $DeltaAmounts \ ]; ::qw::newviews::account_history::account_history_record_add .database $_database .account.address $Account .delta $DeltaRecord; } } } } method account_history_build_date_range {sargs} { /* { We are building the history in order to repair damage. We only use a red progress bar here. We are given a date range and we use the root journal to gather up the transactions. Everything else is exactly the same as account_history_build. */ } ::set Transaction [::sargs::get $sargs .transaction]; #::set ProgressWindow [::sargs::get $sargs .progress_window]; /* { 2.25.4 We must always receive a date range. We never use this method to clear all history. That's a separate methos for a separate purpose (i.e. complete history reorgranize). Here we interpret an empty date as exactly that, for transactions with an empty date, not the whole range. nv 2.25.3 Was throwing bug on empty ranges. We will separate this into the following; If there is no begin or end date we will process the entire range. If both begin and end dates are specified we will process just the transactions with an empty date. The callers are: Transaction reorganize can call with no range to process all transactions. account_history_build_date_list can call because a transaction with an empty date had a problem. */ } ::if {$Transaction eq ""} { ::if {!$::qw::control(ifs_cache_memory_bytes)} { ::set SaveLimits [[::qw::system] cpp_limits_get]; [::qw::system] cpp_limits_set .page_cache_record_limit 1024; ::qw::finally [::list [::qw::system] cpp_limits_set $SaveLimits]; } /* { We could fix change this later to allow build of entire date range but for now we will limit build functionality to the single empty date. */ } $_database cpp_gatgun_hashtable_indexes_flush; ::set BeginDate [::string range [::sargs::get $sargs .date.begin] 0 7]; ::set EndDate [::string range [::sargs::get $sargs .date.end] 0 7]; ::if {![::sargs::exists $sargs .date.begin]} { ::qw::bug 314120121120112830 "[::qw::methodname] - no begin date."; } ::if {![::sargs::exists $sargs .date.end]} { ::qw::bug 314120121120112831 "[::qw::methodname] - no end date."; } ::set BeginDateRange [::list date $BeginDate]; ::set EndDateRange [::list date $EndDate]; /* { code as at 2.25.3 ::set BeginDate ""; ::set BeginDateRange [::list]; ::set EndDate ""; ::set EndDateRange [::list]; if {$::qw::control(ifs_range_empty_versus_null_date)} { #2.25.3 ::if {[::sargs::exists $sargs .date.begin]} { ::set BeginDate [::string range [::sargs::get $sargs .date.begin] 0 7]; ::set BeginDateRange [::list date $BeginDate]; } ::if {[::sargs::exists $sargs .date.end]} { ::set EndDate [::string range [::sargs::get $sargs .date.end] 0 7]; ::set EndDateRange [::list date $EndDate]; } } else { ::set BeginDate [::string range [::sargs::get $sargs .date.begin] 0 7]; ::set EndDate [::string range [::sargs::get $sargs .date.end] 0 7]; ::if {$BeginDate eq ""} { ::qw::bug 314120121120112830 "[::qw::methodname] - no begin date."; } ::if {$EndDate eq ""} { ::qw::bug 314120121120112831 "[::qw::methodname] - no end date."; } ::set BeginDateRange [::list date $BeginDate]; ::set EndDateRange [::list date $EndDate]; } */ } ::set DestroySkip [::sargs::boolean_get $sargs .destroy_skip]; ::set NotifySkip [::sargs::boolean_get $sargs .notify_skip]; account_history_clear_date_range $sargs; ::set JournalClassPath /OBJECT/NEWVIEWS/JOURNAL; ::set OS [$_database cpp_object_structure_load .path $JournalClassPath]; ::set JournalObjectId [::sargs::get $OS .system.object_id]; ::set TagList [tag_list_get]; ::set RecordCount 0; ::foreach Tag $TagList { ::incr RecordCount [$_database cpp_file_record_count \ .path /odb/index$JournalClassPath.transactions.index/date \ .range.begin [::concat [::list string $JournalObjectId tag $Tag] $BeginDateRange] \ .range.end [::concat [::list string $JournalObjectId tag $Tag] $EndDateRange] \ ]; } /* { We traverse the .transactions date index on the root journal. However, any transaction with more than one tag would be processed more than once. Therefore we keep track of the transactions processed. */ } ::set ProgressLimit $RecordCount; ::set ProgressResolution 1; ::if {$ProgressLimit>1000} { # ::set ProgressResolution 19; } ::set Progress ""; ::if {$ProgressLimit>500} { ::set Progress [::QW::PROGRESS::OPERATION [::qw::progress::auto] \ .database_id [$_database cpp_database_id_get] \ .file [$_database cpp_database_path] \ .limit $ProgressLimit \ .resolution $ProgressResolution \ .destroy_skip $DestroySkip \ .operation "account history pass 2" \ .status "[$_database cpp_database_path] rebuilding account histories." \ ]; ::qw::finally [::list ::itcl::delete object $Progress]; } ::set TransactionFile [$_database cpp_file_factory]; ::qw::finally [::list $TransactionFile cpp_destroy]; ::array set TransactionsProcessed {}; ::foreach Tag $TagList { $TransactionFile cpp_file_open \ .path /odb/index$JournalClassPath.transactions.index/date \ .range.begin [::concat [::list string $JournalObjectId tag $Tag] $BeginDateRange] \ .range.end [::concat [::list string $JournalObjectId tag $Tag] $EndDateRange] \ ; ::for {::set Record [$TransactionFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$TransactionFile cpp_record_next $Record]} { /* { We want to visit each transaction once. The problem is that the same transaction will appear under multiple tags. We could use the odb_masters command but we decided to interate through the index and keep an array of transactions already processed. */ } ::if {[::qw::command_exists $Progress]} { $Progress increment; } ::set Reference [::lindex [::sargs::get $Record .key] end]; ::set ObjectId [::qw::odb::object_id_extract .address $Reference]; ::if {![::info exists TransactionsProcessed($ObjectId)]} { [::qw::methodname] $sargs .transaction $Reference; ::set TransactionsProcessed($ObjectId) 1; } } } account_history_file_hashtable_flush; ::return; } account_history_build_one_transaction $sargs; } ::if {$::qw::control(fat_is_enabled)} { method account_history_build_remote {sargs} { /* { This is very much like account_history_build but it uses a blue progress box and can be aborted, unlike account_history_file. We build the account histories from scratch, i.e. directly from the transactions. If there is a non-empty history file, we delete all records in it first. We use the root journal transactions primary to traverse all transactions. .destroy_skip 1 Don't delete progress bar line. .notify_skip 1 Don't bring up a notify box at the end. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_remote,1000.0";} ::set Transaction [::sargs::get $sargs .transaction]; # ::set ProgressWindow [::sargs::get $sargs .progress_window]; ::if {$Transaction eq ""} { /* { This is the root case. It iterates over all transactions in the root journal by calling itself on each transaction. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_remote,1000.1";} ::if {!$::qw::control(ifs_cache_memory_bytes)} { ::set SaveLimits [[::qw::system] cpp_limits_get]; [::qw::system] cpp_limits_set .page_cache_record_limit 1024; } # ::set DestroySkip [::sargs::boolean_get $sargs .destroy_skip]; # ::set NotifySkip [::sargs::boolean_get $sargs .notify_skip]; # ::set _progress_color red; # ::if {[::sargs::get $sargs .progress_color] ne ""} { # ::set _progress_color [::sargs::get $sargs .progress_color]; # } # ::set _progress_state "working"; ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_remote,1000.2";} ::if {[::sargs::boolean_get $sargs .progress_color] eq "red"} { /* { this needs a comment but doesn't have eone */ } account_history_clear $sargs; } ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_remote,1000.3";} ::set TransactionFile [$_database cpp_file_factory]; ::qw::finally [::list $TransactionFile cpp_destroy]; ::set JournalClassPath /OBJECT/NEWVIEWS/JOURNAL; ::set OS [$_database cpp_object_structure_load .path $JournalClassPath]; ::set JournalObjectId [::sargs::get $OS .system.object_id]; $TransactionFile cpp_file_open \ .path /odb/index$JournalClassPath.transactions.index/id \ .range.begin [::list string $JournalObjectId] \ .range.end [::list string $JournalObjectId] \ ; /* { We traverse the .transactions id index on the root journal. However, any transaction with more than one tag would be processed more than once. Therefore we keep track of the transactions processed. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_remote,1000.4";} ::set ProgressLimit [$TransactionFile cpp_record_count]; ::sargs::var::set sargs .description "reorganize_account_history"; ::set sargs [::qw::database_utilities_paf::progress_setup $sargs .progress_limit $ProgressLimit .status "Reorganize account history."]; ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_remote,1000.5";} # ------------------------------------------------------------ ::array set TransactionsProcessed {}; ::for {::set Record [$TransactionFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$TransactionFile cpp_record_next $Record]} { /* { We want to visit each transaction once. The problem is that the same transaction will appear under multiple tags. We could use the odb_masters command but we decided to interate through the index and keep an array of transactions already processed. */ } ::set sargs [::qw::database_utilities_paf::progress_increment $sargs .increment 1]; ::set Reference [::lindex [::sargs::get $Record .key] end]; ::set ObjectId [::qw::odb::object_id_extract .address $Reference]; ::if {![::info exists TransactionsProcessed($ObjectId)]} { [::qw::methodname] $sargs .transaction $Reference; ::set TransactionsProcessed($ObjectId) 1; } } ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_remote,1000.6";} ::set sargs [::qw::database_utilities_paf::progress_increment $sargs .increment 1]; ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_remote,1000.9";} ::if {!$::qw::control(ifs_cache_memory_bytes)} { [::qw::system] cpp_limits_set $SaveLimits; } ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_remote,1000.10";} account_history_file_hashtable_flush; ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_remote,1000.11";} ::set sargs [::qw::database_utilities_paf::progress_finalize $sargs]; ::if {$rwb1_debug} {::puts "rwb1_debug,account_history_build_remote,1000.12";} ::return $sargs; } account_history_build_one_transaction_paf $sargs; } } method account_history_build {sargs} { /* { This is very much like account_history_build but it uses a blue progress box and can be aborted, unlike account_history_file. We build the account histories from scratch, i.e. directly from the transactions. If there is a non-empty history file, we delete all records in it first. We use the root journal transactions primary to traverse all transactions. .destroy_skip 1 Don't delete progress bar line. .notify_skip 1 Don't bring up a notify box at the end. */ } ::set Transaction [::sargs::get $sargs .transaction]; # ::set ProgressWindow [::sargs::get $sargs .progress_window]; ::if {$Transaction eq ""} { ::set ::qw::progress_blue_count_variable 0; ::if {!$::qw::control(ifs_cache_memory_bytes)} { ::set SaveLimits [[::qw::system] cpp_limits_get]; [::qw::system] cpp_limits_set .page_cache_record_limit 1024; } ::set DestroySkip [::sargs::boolean_get $sargs .destroy_skip]; ::set NotifySkip [::sargs::boolean_get $sargs .notify_skip]; ::set _progress_color red; ::if {[::sargs::get $sargs .progress_color] ne ""} { ::set _progress_color [::sargs::get $sargs .progress_color]; } ::set _progress_state "working"; ::if {[::sargs::boolean_get $sargs .progress_color] eq "red"} { account_history_clear $sargs; } ::set TransactionFile [$_database cpp_file_factory]; ::qw::finally [::list $TransactionFile cpp_destroy]; ::set JournalClassPath /OBJECT/NEWVIEWS/JOURNAL; ::set OS [$_database cpp_object_structure_load .path $JournalClassPath]; ::set JournalObjectId [::sargs::get $OS .system.object_id]; # ::set ClassPath [::sargs::get $OS .system.class_path]; $TransactionFile cpp_file_open \ .path /odb/index$JournalClassPath.transactions.index/id \ .range.begin [::list string $JournalObjectId] \ .range.end [::list string $JournalObjectId] \ ; /* { We traverse the .transactions id index on the root journal. However, any transaction with more than one tag would be processed more than once. Therefore we keep track of the transactions processed. */ } ::set RecordCount [$TransactionFile cpp_record_count]; ::set ProgressLimit $RecordCount; ::set ProgressResolution 1; ::if {$ProgressLimit>1000} { # ::set ProgressResolution 19; } # 2.34.7 - got rid of extension .nv2reorganize when reorganizing ::set ProgressDatabasePath [$_database cpp_database_path]; ::set ProgressDatabasePath [::file rootname $ProgressDatabasePath].nv2; ::if {[::sargs::get $sargs .source_database_path] ne ""} { ::set ProgressDatabasePath [::sargs::get $sargs .source_database_path]; } ::switch -- $_progress_color { blue { ::set OperationId [::qw::progress_blue::operation_create $sargs \ .description "reorganize_account_history" \ .limit $ProgressLimit \ .resolution $ProgressResolution \ .database_path $ProgressDatabasePath \ .database_id [$_database cpp_database_id_get] \ .count_variable "::qw::progress_blue_count_variable" \ .state "working" \ .status "Reorganize rebuilding account history." \ ]; } red { ::set Progress [::QW::PROGRESS::OPERATION [::qw::progress::auto] \ .database_id [$_database cpp_database_id_get] \ .database_path $ProgressDatabasePath \ .limit $ProgressLimit \ .resolution $ProgressResolution \ .destroy_skip $DestroySkip \ .operation "reorganize_account_history" \ .status "Reorganize rebuilding account history." \ ]; ::qw::finally [::list ::itcl::delete object $Progress]; } } ::array set TransactionsProcessed {}; ::for {::set Record [$TransactionFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$TransactionFile cpp_record_next $Record]} { /* { We want to visit each transaction once. The problem is that the same transaction will appear under multiple tags. We could use the odb_masters command but we decided to interate through the index and keep an array of transactions already processed. */ } ::switch -- $_progress_color { blue { ::if {[::qw::progress_blue::operation_is_aborted .operation_id $OperationId]} { ::qw::progress_blue::operation_configure .operation_id $OperationId .state aborted; ::return [::sargs .state aborted]; } } red { } } ::set Reference [::lindex [::sargs::get $Record .key] end]; ::set ObjectId [::qw::odb::object_id_extract .address $Reference]; ::if {![::info exists TransactionsProcessed($ObjectId)]} { ::switch -- $_progress_color { blue { [::qw::methodname] $sargs .operation_id $OperationId .transaction $Reference; } red { [::qw::methodname] $sargs .transaction $Reference; } } ::set TransactionsProcessed($ObjectId) 1; } ::switch -- $_progress_color { blue { ::qw::progress_blue::operation_increment $sargs .operation_id $OperationId; } red { ::if {$Progress ne ""} { $Progress increment; } } } } ::if {!$::qw::control(ifs_cache_memory_bytes)} { [::qw::system] cpp_limits_set $SaveLimits; } account_history_file_hashtable_flush; ::switch -- $_progress_color { blue { ::qw::progress_blue::operation_configure \ .operation_id $OperationId \ .state "succeeded" \ .status "Reorganize account history succeeded." \ ; } red { } } ::return [::sargs .state succeeded]; } account_history_build_one_transaction $sargs; } method account_object_structure_get {sargs} { ::set Address [::sargs::get $sargs .address]; ::if {![::info exists _accounts_by_object_id($Address)]} { ::set _accounts_by_object_id($Address) [$_database cpp_object_structure_load .address $Address]; } ::return $_accounts_by_object_id($Address); } method postings_indexes_build {sargs} { /* { We need to build postings in a convert_214_215 when the database has summary postings. We use the root journal transactions primary to traverse all transactions. */ } ::set rwb1_debug 0; ::set Transaction [::sargs::get $sargs .transaction]; ::set DestroySkip [::sargs::boolean_get $sargs .destroy_skip]; ::set NotifySkip [::sargs::boolean_get $sargs .notify_skip]; ::if {$Transaction eq ""} { ::if {!$::qw::control(ifs_cache_memory_bytes)} { ::set SaveLimits [[::qw::system] cpp_limits_get]; [::qw::system] cpp_limits_set .page_cache_record_limit 1024; } summed_fields_eliminate; #postings_indexes_eliminate $sargs; ::if {$rwb1_debug} { ::set ClockStart [::clock seconds]; } ::set LastSummaryPostingDate [::sargs::get $sargs .last_summary_posting_date]; ::if {$LastSummaryPostingDate eq ""} { ::qw::bug 314120090415100223 "Expected last summary posting date."; } ::set OS [$_database cpp_object_structure_load .path /OBJECT/NEWVIEWS/JOURNAL]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::set Tags [tag_list_get]; ::set RecordCount 0; ::foreach Tag $Tags { ::if {$::qw::control(gatgun_no_nodes)} { ::incr RecordCount [$_database cpp_file_record_count \ .path /odb/index/OBJECT/NEWVIEWS/JOURNAL.transactions.index/date \ .range.begin [::list tag $Tag] \ .range.end [::list tag $Tag date $LastSummaryPostingDate] \ ]; } else { ::incr RecordCount [$_database cpp_file_record_count \ .path /odb/index/OBJECT/NEWVIEWS/JOURNAL.transactions.index/date \ .range.begin [::list string $ObjectId tag $Tag] \ .range.end [::list string $ObjectId tag $Tag date $LastSummaryPostingDate] \ ]; } } ::set ProgressLimit $RecordCount; ::set ProgressResolution 1; ::set Progress ""; ::set ProgressMinimum 1; ::if {$ProgressLimit>=$ProgressMinimum} { ::set Progress [::QW::PROGRESS::OPERATION [::qw::progress::auto] \ .database_id [$_database cpp_database_id_get] \ .file [$_database cpp_database_path] \ .limit $ProgressLimit \ .destroy_skip $DestroySkip \ .resolution $ProgressResolution \ .operation "rebuilding posting indexes" \ .status "[$_database cpp_database_path] re-building posting indexes." \ ]; ::qw::finally [::list ::itcl::delete object $Progress]; } ::set TransactionFile [$_database cpp_file_factory]; ::qw::finally [::list $TransactionFile cpp_destroy]; ::foreach Tag $Tags { ::if {$::qw::control(gatgun_no_nodes)} { $TransactionFile cpp_file_open \ .path /odb/index/OBJECT/NEWVIEWS/JOURNAL.transactions.index/date \ .range.begin [::list tag $Tag] \ .range.end [::list tag $Tag date $LastSummaryPostingDate] \ ; } else { $TransactionFile cpp_file_open \ .path /odb/index/OBJECT/NEWVIEWS/JOURNAL.transactions.index/date \ .range.begin [::list string $ObjectId tag $Tag] \ .range.end [::list string $ObjectId tag $Tag date $LastSummaryPostingDate] \ ; } ::for {::set Record [$TransactionFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$TransactionFile cpp_record_next $Record]} { ::set Reference [::lindex [::sargs::get $Record .key] end]; ::set OS [$_database cpp_object_structure_load .address $Reference] postings_indexes_build .transaction $Reference; ::if {$Progress ne ""} { $Progress increment; } } } ::if {!$::qw::control(ifs_cache_memory_bytes)} { [::qw::system] cpp_limits_set $SaveLimits; } ::if {$rwb1_debug} { ::puts "postings_indexes_build,seconds==[::expr {[::clock seconds]-$ClockStart}]"; } ::return; } /* { We have a transaction and our job is to insert (no writes or deletes here) into each postings index for the posting account and its closure, according to the trimmed index factor. */ } ::set OS [$_database cpp_object_structure_load .address $Transaction]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::set ClassPath [::sargs::get $OS .system.class_path]; ::set KidList [$_database cpp_file_odb_masters \ .path /odb/index$ClassPath.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::foreach Kid $KidList { postings_indexes_build $sargs .transaction $Kid; } ::set After(tags) [transaction_odb_field_get .object_structure $OS .field .tags]; ::if {$After(tags) eq ""} { ::qw::bug 314120090109164330 "Encountered a transaction with no tags."; } ::set IsBoomerang [is_boomerang .transaction_object_structure $OS]; ::set After(date) [transaction_odb_field_get .object_structure $OS .field .date]; ::set After(reference) [transaction_odb_field_get .object_structure $OS .field .reference]; ::set After(description) [::sargs::get $OS .data.description]; ::set After(object_id) [::sargs::get $OS .system.object_id]; ::set After(id) [::sargs::get $OS .system.id]; ::foreach PostingField [get_posting_fields .class_path $ClassPath] { ::set After(account) [::sargs::get $OS .data$PostingField.account]; ::if {$After(account) eq ""} { ::continue; } # ::set After(account) [::qw::odb::address_from_disk .address $After(account) .database $_database]; ::set After(amount) [transaction_odb_field_get .object_structure $OS .field $PostingField.amount]; ::set After(quantity) [transaction_odb_field_get .object_structure $OS .field $PostingField.quantity]; ::if {$::qw::control(crm_include)} { ::set After(contact_duration) [transaction_odb_field_get .object_structure $OS .field $PostingField.contact_duration]; } ::set After(account_reference_field) /$After(object_id)$PostingField.account; ::set After(reconcile) [transaction_odb_field_get .object_structure $OS .field $PostingField.reconcile]; ::set After(closure) ""; ::foreach Address [transitive_closure .account $After(account)] { ::lappend After(closure) [::qw::odb::address_to_disk .address $Address]; } ::set IsOpen 0; ::set IsClosed 0; ::if {$After(reconcile) eq ""} { ::set IsOpen 1; } else { ::set IsClosed 1; } ::set IsDebit 0; ::set IsCredit 0; ::if {!$IsBoomerang} { ::switch -- [::qw::number::compare $After(amount) 0.0] { 1 { ::set IsDebit 1; } -1 { ::set IsCredit 1; } 0 { ::switch -glob -- $PostingField { .posting/debit* { ::set IsDebit 1; } .posting/credit* { ::set IsCredit 1; } default { ::qw::bug 314120090324133757 "Encountered unexpected non-zero posting \"$PostingField\"."; } } } } } ::set IndexRecord ""; ::set Amounts [::list .count 1.0 .amount $After(amount) .quantity $After(quantity)]; ::if {$::qw::control(crm_include)} { ::lappend Amounts .contact_duration $After(contact_duration); } ::sargs::var::set IndexRecord .amounts $Amounts; ::foreach Index { .postings.index/id .postings.index/date .postings.index/date/debit .postings.index/date/credit .postings.index/date/closed .postings.index/date/open .postings.index/reconcile .postings.index/reconcile/debit .postings.index/reconcile/credit .postings.index/reconcile/closed .postings.index/reconcile/open .postings.index/reference .postings.index/reference/debit .postings.index/reference/credit .postings.index/reference/closed .postings.index/reference/open .postings.index/description } { ::switch -glob -- $Index { .postings.index/id { ::set Key [::list string xxx tag xxx string $After(id) string $After(account_reference_field)]; ::foreach Address $After(closure) { ::set AccountOS [account_object_structure_get .address $Address]; ::set AccountObjectId [::sargs::get $AccountOS .system.object_id]; ::set AccountPath [::sargs::get $AccountOS .system.path]; ::set AccountClassPath [::sargs::get $AccountOS .system.class_path]; ::if {$After(account) ne $Address} { ::if {$AccountPath ne "/OBJECT/NEWVIEWS/ACCOUNT"} { ::continue; } ::if {$AccountPath ne "/OBJECT/NEWVIEWS/ACCOUNT"} { ::continue; } } ::lset Key 1 $AccountObjectId; ::foreach Tag $After(tags) { ::lset Key 3 $Tag; ::sargs::var::set IndexRecord .key $Key; $_database cpp_file_record_insert \ .path /odb/index$AccountClassPath$Index \ .after $IndexRecord \ ; } } } .postings.index/date* { ::set Key [::list string xxx tag xxx date $After(date) string $After(account_reference_field)]; ::foreach Address $After(closure) { ::set AccountOS [account_object_structure_get .address $Address]; ::set AccountObjectId [::sargs::get $AccountOS .system.object_id]; ::set AccountPath [::sargs::get $AccountOS .system.path]; ::set AccountClassPath [::sargs::get $AccountOS .system.class_path]; ::if {$After(account) ne $Address} { ::if {$AccountPath ne "/OBJECT/NEWVIEWS/ACCOUNT"} { ::continue; } } ::switch -glob -- $Index { */debit { ::if {!$IsDebit} { ::continue; } } */credit* { ::if {!$IsCredit} { ::continue; } } */open { ::if {!$IsOpen} { ::continue; } } */closed { ::if {!$IsClosed} { ::continue; } } } ::lset Key 1 $AccountObjectId; ::foreach Tag $After(tags) { ::lset Key 3 $Tag; ::sargs::var::set IndexRecord .key $Key; ::qw::try { $_database cpp_file_record_insert \ .path /odb/index$AccountClassPath$Index \ .after $IndexRecord \ ; } catch Exception { ::qw::throw $Exception; } } } } .postings.index/reference* { ::set Key [::list string xxx tag xxx string $After(reference) string $After(account_reference_field)]; ::foreach Address $After(closure) { ::set AccountOS [account_object_structure_get .address $Address]; ::set AccountObjectId [::sargs::get $AccountOS .system.object_id]; ::set AccountPath [::sargs::get $AccountOS .system.path]; ::set AccountClassPath [::sargs::get $AccountOS .system.class_path]; ::if {$After(account) ne $Address} { ::if {$Index ne ".postings.index/reference"} { ::continue; } ::if {$AccountPath ne "/OBJECT/NEWVIEWS/ACCOUNT"} { ::continue; } } ::switch -glob -- $Index { */debit { ::if {!$IsDebit} { ::continue; } } */credit* { ::if {!$IsCredit} { ::continue; } } */open { ::if {!$IsOpen} { ::continue; } } */closed { ::if {!$IsClosed} { ::continue; } } } ::lset Key 1 $AccountObjectId; ::foreach Tag $After(tags) { ::lset Key 3 $Tag; ::sargs::var::set IndexRecord .key $Key; $_database cpp_file_record_insert \ .path /odb/index$AccountClassPath$Index \ .after $IndexRecord \ ; } } } .postings.index/reconcile* { ::set Key [::list string xxx tag xxx string $After(reconcile) date $After(date) string $After(account_reference_field)]; ::foreach Address $After(closure) { ::set AccountOS [account_object_structure_get .address $Address]; ::set AccountObjectId [::sargs::get $AccountOS .system.object_id]; ::set AccountPath [::sargs::get $AccountOS .system.path]; ::set AccountClassPath [::sargs::get $AccountOS .system.class_path]; ::if {$After(account) ne $Address} { ::if {$Index ne ".postings.index/reconcile"} { ::continue; } ::if {$AccountPath ne "/OBJECT/NEWVIEWS/ACCOUNT"} { ::continue; } } ::switch -glob -- $Index { */debit { ::if {!$IsDebit} { ::continue; } } */credit* { ::if {!$IsCredit} { ::continue; } } */open { ::if {!$IsOpen} { ::continue; } } */closed { ::if {!$IsClosed} { ::continue; } } } ::lset Key 1 $AccountObjectId; ::foreach Tag $After(tags) { ::lset Key 3 $Tag; ::sargs::var::set IndexRecord .key $Key; $_database cpp_file_record_insert \ .path /odb/index$AccountClassPath$Index \ .after $IndexRecord \ ; } } } .postings.index/description* { ::set Key [::list string xxx tag xxx string $After(description) string $After(account_reference_field)]; ::foreach Address $After(closure) { ::set AccountOS [account_object_structure_get .address $Address]; ::set AccountObjectId [::sargs::get $AccountOS .system.object_id]; ::set AccountPath [::sargs::get $AccountOS .system.path]; ::set AccountClassPath [::sargs::get $AccountOS .system.class_path]; ::if {$After(account) ne $Address} { ::if {$AccountPath ne "/OBJECT/NEWVIEWS/ACCOUNT"} { ::continue; } } ::lset Key 1 $AccountObjectId; ::foreach Tag $After(tags) { ::lset Key 3 $Tag; ::sargs::var::set IndexRecord .key $Key; $_database cpp_file_record_insert \ .path /odb/index$AccountClassPath$Index \ .after $IndexRecord \ ; } } } } } } } method account_history_file_hashtable_flush {sargs} { ::set Handle [::array startsearch _account_history_file_hashtable]; ::set Progress ""; ::set ProgressMinimum 500; ::set ProgressLimit $_account_history_file_hashtable_count; ::set ProgressResolution 19; ::if {$ProgressLimit>=$ProgressMinimum} { ::set Progress [::QW::PROGRESS::OPERATION [::qw::progress::auto] \ .database_id [$_database cpp_database_id_get] \ .file [$_database cpp_database_path] \ .user [$_database cpp_user_name] \ .limit $ProgressLimit \ .resolution $ProgressResolution \ .operation "Flushing history file" \ .status "[$_database cpp_database_path] flushing $ProgressLimit records to account history file." \ ]; ::qw::finally [::list ::itcl::delete object $Progress]; } ::while {[::set Key [::array nextelement _account_history_file_hashtable $Handle]] ne ""} { $_account_history_file cpp_record_add .delta [::list .key $Key .amounts $_account_history_file_hashtable($Key)]; ::if {$Progress ne ""} { $Progress increment; } } ::array donesearch _account_history_file_hashtable $Handle; ::array unset _account_history_file_hashtable *; ::set _account_history_file_hashtable_count 0; } method account_history_file_hashtable_normalize {} { ::return; } }