package Ernad::Indat::Issue; use strict; use warnings; use base 'Ernad::Indat'; use Carp qw(confess); use Clone 'clone'; use Data::Dumper; use List::Util qw(shuffle); use Statistics::Descriptive; use Ernad::Indat; use Ernad::Dates; use Ernad::Files; use Ernad::FileInfo; use Ernad::Store; use Krichel::Shoti; use Krichel::Shonu; our $e=$main::e; sub stats { my $i=shift; my $what=shift; my $data=$i->{'i'}->{'d'}->{'about'}->{$what} // return undef; my $stat = Statistics::Descriptive::Full->new(); foreach my $value (keys %$data) { $stat->add_data($data->{$value}); } $i->{'i'}->{'d'}->{'about'}->{'stats'}->{$what}->{'median'}=$stat->median(); } sub set_file { my $i=shift; my $e=$i->{'e'}; if(not $e) { confess "I don't see the erimp."; } my $issuedate=$i->{'issuedate'} // confess "I need an issuedate set here."; if(not &Ernad::Dates::is($issuedate)) { confess "Your issuedate $issuedate is not a date."; } my $namf_json=$i->{'dir'}->{'namf'}."/$issuedate.json"; if(not -f $namf_json) { $e->echo(__LINE__,"BAD: I have no namf json $namf_json for issuedate $issuedate."); return 0; } $i->{'json'}->{'namf'}=$namf_json; if($i->{'i'}->{'d'}->{'about'}->{'complete'}) { $i->{'json'}->{'issue'}=$i->{'dir'}->{'issues'}."/complete/$issuedate.json"; } else { $i->{'json'}->{'issue'}=$i->{'dir'}->{'issues'}."/$issuedate.json"; } return 1; } sub is_in_labor { my $i=shift; my $e=$i->{'e'}; if(not $e) { confess "I don't see the erimp."; } my $issuedate=$i->{'issuedate'} // confess "I need an issuedate set here."; if(not &Ernad::Dates::is($issuedate)) { confess "Your issuedate $issuedate is not a date."; } my $complete_json=$i->{'dir'}->{'issues'}."/complete/$issuedate.json"; my $in_labor_json=$i->{'dir'}->{'issues'}."/$issuedate.json"; if(-f $complete_json) { $e->echo(__LINE__,"I see $complete_json. Thus '$issuedate' is complete."); if(-f $in_labor_json) { $e->echo(__LINE__,"I delete $in_labor_json."); unlink $in_labor_json; $i->sborn('complete',$issuedate); $i->sborn('in_labor',$issuedate); # $i->clear(); } return 0; } if(not -f $in_labor_json) { delete $i->{'i'}->{'d'}->{'about'}->{'complete'}; $e->echo(__LINE__,"I don't neither $complete_json nor $in_labor_json. I will assume in_labor."); } return 1; } sub get_issuedates { my $i=shift; my $what=shift // confess "I need to know what issues"; if($what ne 'in_labor' and $what ne 'complete') { confess "I need 'in_labor' or 'complete' here."; } my $type=shift // 'array'; my $l; if($type eq 'array') { $l=[]; } elsif($type eq 'hash') { $l={}; } else { confess 'My argument has to be "array" (default) or "hash".'; } my $issues_dir=$i->{'dir'}->{'issues'} // confess "I need this here."; if($what eq 'complete') { $issues_dir=$issues_dir.'/complete'; } my $count=0; foreach my $file (sort glob("$issues_dir/*")) { chomp $file; if(not $file=~m|(\d{4}-\d{2}-\d{2})\.json$|) { next; } $l->[$count++]=$1; } $i->{'issues'}=clone($l); return $l; } sub get_in_labor_issues { my $i=shift; my $type=shift // 'array'; my $l; if($type eq 'array') { $l=[]; } elsif($type eq 'hash') { $l={}; } else { confess 'My argument has to be "array" (default) or "hash".'; } my $issues_dir=$i->{'dir'}->{'issues'} // confess "I need this here."; my $count=0; foreach my $file (sort glob("$issues_dir/*")) { chomp $file; if(not $file=~m|(\d{4}-\d{2}-\d{2})\.json$|) { next; } $l->[$count++]=$1; } $i->{'issues'}=clone($l); return $l; } sub do_i_have_complete_file { my $i=shift; my $issuedate=shift // confess "I need an issuedate here."; my $file=$i->{'dir'}->{'issues'}."/complete/$issuedate.json"; if(-f $file) { return $file; } return 0; } sub compile { my $i=shift; my $issuedate=shift // confess "I need an issuedate here."; my $given_repcode=shift; my $e=$i->{'e'}; $i->{'issuedate'}=$issuedate; ## if there is no namf ->set_file returns zero, we leave as well $i->set_file() or return 0; my $have_complete=$i->do_i_have_complete_file($issuedate); if(not $i->is_in_labor($issuedate) and $have_complete) { $e->echo(__LINE__,"$issuedate is not in_labor and I see $have_complete, I end ->compile."); return 0; } my $namf_json=$i->{'json'}->{'namf'} // confess "I should have this from set_file()."; $i->clear(); my $issue_json_age=0; ## load from file if it's there my $issue_json=$i->{'json'}->{'issue'}; if(-f $issue_json) { $e->echo(__LINE__,"I load the $issue_json I already have."); $i->{'i'}=clone(&Ernad::Store::load($issue_json)); $issue_json_age=-M $i->{'json'}->{'issue'}; } else { $e->echo(__LINE__,"I prepare $issue_json."); &Krichel::File::prepare($issue_json); } ## load the namf if(not $i->{'i'}->{'d'}->{'namf'} or -M $namf_json < $issue_json_age) { $e->echo(__LINE__,"I load the issue name $namf_json."); my $namf_data=clone(&Ernad::Store::load($i->{'json'}->{'namf'})); ## just take the intersting part $i->{'i'}->{'d'}->{'namf'}=$namf_data->{'d'}->{$issuedate}->{'namf'} // confess "I need this."; } $i->{'do_save'}=0; my $repcodes; if($given_repcode) { $repcodes=[$given_repcode]; } else { ## FixMe: this should be curpu #@repcodes=sort $i->{'e'}->get_cural_repcodes(); $repcodes=$i->list_active_reports($issuedate); if(not scalar @$repcodes) { confess "I see no active repcodes at $issuedate."; } } foreach my $repcode (@$repcodes) { $e->echo(__LINE__,"report $repcode is active at $issuedate."); my $vypot_json=$i->{'dir'}->{'vypot'}."/$repcode/$issuedate.json"; if(not -f $vypot_json) { $e->echo(__LINE__,"I have no file $vypot_json",10); next; } my $vypot_json_age=-M $vypot_json; ## new access point for this data if(not $i->{'i'}->{'d'}->{'report'}->{$repcode} or $vypot_json_age < $issue_json_age) { $e->echo(__LINE__,"I load vypot $vypot_json"); my $in=&Ernad::Store::load($vypot_json); $in=$i->clear_bulk_from_vypot($in,$repcode); my $in_v=$in->{'v'} // confess "I should have a version"; if(not $i->{'i'}->{'v'}) { $i->{'i'}->{'v'}=$in_v; $i->{'do_save'}=1; } elsif(&Krichel::Shoti::compare_strict($i->{'i'}->{'v'},$in_v)) { $i->{'i'}->{'v'}=$in_v; $e->echo(__LINE__,"Compare ".$i->{'i'}->{'v'}." ".$in_v); $i->{'do_save'}=1; } # $i->{'i'}->{'d'}->{$repcode}=$in; my $vypot_indat=$in->{'d'}->{$repcode}->{$issuedate} // confess "I need this."; ## check that the data has class and send. foreach my $what ('class','sent') { my @class_keys=keys %{$vypot_indat->{$what}}; if(not scalar @class_keys) { my $s=Dumper $vypot_indat; confess "I have no $what data is $vypot_indat"; } } ## source should now be gone delete $vypot_indat->{'source'}; ## $e->echo(__LINE__,"I added vypot_indat for $repcode $issuedate"); $i->{'i'}->{'d'}->{'report'}->{$repcode}=$vypot_indat; } } $i->delay('snore','class','created'); $i->delay('labor','created','sent'); $i->stats('labor'); $i->stats('snore'); $i->cover_ratio(); ## also sets file for complete my $is_complete=''; if($i->is_complete()) { $e->echo(__LINE__,"$issuedate is complete."); $i->{'do_save'}=$i->switch_to_complete($issuedate); $e->echo(__LINE__,"I have switched $issuedate to 'complete'."); } if($i->{'do_save'} or $main::do_test) { my $out_file=$i->{'json'}->{'issue'}; $e->echo(__LINE__,"I write $out_file."); &Ernad::Store::save($i->{'i'},$out_file); ## if the outfile is complete, remove the incomplete file #if($out_file=~s|/complete/|/|) { # if(-f $out_file) { # $e->echo(__LINE__,"I remove $out_file."); # unlink $out_file; # $i->sborn('in_labor',$issuedate); # } # else { # $e->echo(__LINE__,"I don't remove $out_file, because it is not there."); # } #} } else { $e->echo(__LINE__,"I keep $i->{'json'}->{'issue'} as is."); } ## $i->sborn('in_labor',$issuedate); $i->sborn('in_labor'); $i->sborn('complete',$issuedate); } sub switch_to_complete { my $i=shift; my $issuedate=shift // confess "I need this to be defined"; my $e=$i->{'e'}; my $in_labor_json=$i->{'dir'}->{'issues'}."/$issuedate.json"; my $complete_json=$i->{'dir'}->{'issues'}."/complete/$issuedate.json"; ## it was already complete before if(-f $complete_json) { $e->echo(__LINE__,"It was complete before."); $i->{'json'}->{'issue'}=$complete_json; return 0; } &Ernad::Store::save($i->{'i'},$complete_json); $i->{'do_save'}=0; if(-f $in_labor_json) { unlink $in_labor_json; $e->echo(__LINE__,"I delete $in_labor_json"); } return 1; } ## this is done to keep the sborns down sub remove_namf_papids { my $i=shift; my $to_go=$i->{'i'}->{'d'}->{'namf'}->{'papid'}; if(not $i->{'i'}->{'d'}->{'namf'}->{'d'}->{'papid'}) { $i->{'e'}->echo(__LINE__,"I see no namf papid data to remove."); } delete $i->{'i'}->{'d'}->{'namf'}->{'d'}->{'papid'}; } sub remove_report_papids { my $i=shift; foreach my $repcode (keys %{$i->{'i'}->{'d'}->{'report'}}) { foreach my $state (keys %{$i->{'i'}->{'d'}->{'report'}->{$repcode}}) { if($state ne 'sent' and $state ne 'class') { delete $i->{'i'}->{'d'}->{'report'}->{$repcode}->{$state}; next; } foreach my $shoti (keys %{$i->{'i'}->{'d'}->{'report'}->{$repcode}->{$state}}) { delete $i->{'i'}->{'d'}->{'report'}->{$repcode}->{$state}->{$shoti}->{'d'}->{'papid'}; } } ## should only happen for incomplete, but we do it everywhere if(not scalar keys %{$i->{'i'}->{'d'}->{'report'}->{$repcode}}) { delete $i->{'i'}->{'d'}->{'report'}->{$repcode}; } } } ## clears class and created papids from the issue data sub clear_bulk_from_vypot { my $i=shift; my $in=shift; my $repcode=shift; my $e=$i->{'e'}; my $issuedate=$i->first_key($in->{'d'}->{$repcode}) // confess "I don't see the issuedate"; foreach my $papid_to_go ('created','class') { my $before_time=$in->{'d'}->{$repcode}->{$issuedate}->{$papid_to_go}; foreach my $shoti (keys %{$before_time}) { my $to_delete=$before_time->{$shoti}->{'d'}; if(not $to_delete) { confess "I don't have $papid_to_go data for $repcode at $issuedate."; } delete $to_delete->{'papid'}; } } return $in; } sub first_key { my $i=shift; my $in=shift; if(not $in) { confess "I need input here."; } if(not ref $in) { confess "I need a reference here.\n"; } my @keys=keys %{$in}; return $keys[0]; } sub load { my $i=shift; my $issuedate=shift // $i->{'i'}->{'issuedate'} // confess "I need an issuedate here."; $i->{'issuedate'}=$issuedate; my $is_complete=1; my $issue_json=$i->{'dir'}->{'issues'}.'/complete/'.$issuedate.'.json'; my $in_labor_json=$i->{'dir'}->{'issues'}.'/'.$issuedate.'.json'; if(not -f $issue_json) { $is_complete=0; if(not -f $in_labor_json) { $i->{'e'}->echo(__LINE__,"I neither have $issue_json nor in_labor_jsone."); return; } $issue_json=$in_labor_json; } else { if(-f $in_labor_json) { unlink $in_labor_json; } } $i->{'file'}->{'json'}=$issue_json; ## check if we load the right json for a sborn if($i->{'what'}) { if($is_complete and $i->{'what'} eq 'in_labor') { confess "I am told to load an complete issue for an in_labor sborn."; } if(not $is_complete and $i->{'what'} eq 'comptle') { confess "I am told to load an in_labor issue for a complete sborn."; } } $i->{'e'}->echo(__LINE__,"I load $issue_json."); $i->{'i'}=&Ernad::Store::load($issue_json); } ## sets or returns the issuedate. ## is stored as i->issuadate sub date { my $i=shift; my $issuedate=shift // ''; my $old_issuedate=$i->{'issuedate'}; if(not $issuedate) { if($old_issuedate) { return $issuedate; } return 0; } if($issuedate ne $old_issuedate) { $i->{'issuedate'}=$issuedate; delete $i->{'i'}; $i->load($issuedate); } } ## gets reports that are in the indat already sub get_repcodes { my $i=shift; my $d=$i->{'i'}->{'d'}; my $count=0; my $repcodes; foreach my $repcode (keys %{$d->{'report'}}) { if($i->is_prenatal($repcode)) { delete $d->{$repcode}; ## set a need_save flag, maybe use this to make save decisions $i->{'need_save'}=1; next; } $repcodes->[$count++]=$repcode; } return $repcodes; } ## this looks at the actual contents sub is_complete { my $i=shift; my $d=$i->{'i'}->{'d'}; my $e=$i->{'e'}; ## about stores metadata if($d->{'about'}->{'complete'}) { $e->echo(__LINE__,"I found about->complete, thus the issue is complete."); return 1; } my $issuedate=$i->{'issuedate'} // confess "I must have this set here."; ## a hash of snorlabo, i.e. snore or in_labor, repcodes my $repcodes=$i->list_active_reports($issuedate); foreach my $repcode (@$repcodes) { $e->echo(__LINE__,"At $issuedate, $repcode is active."); } my $snorlabo={}; foreach my $repcode (@$repcodes) { $e->echo(__LINE__,"To find whether it is complete I look at $repcode."); my $sents=$d->{'report'}->{$repcode}->{'sent'}; if($sents) { ## take the first of the time keys my @shotis=sort keys %$sents; my $shoti=$shotis[0]; ## FixMe: there is junk data of the sort ## "bims-cytox1":{"class":{}, ## "created":{}, ## "sent":{}}, ## check if the shoti has a value if($shoti) { $e->echo(__LINE__,"At $issuedate, $repcode is sent at $shoti."); delete $snorlabo->{$repcode}; } else { $e->echo(__LINE__,"I miss $repcode at $issuedate."); $snorlabo->{$repcode}=1; } } else { $e->echo(__LINE__,"I miss $repcode at $issuedate."); $snorlabo->{$repcode}=1; } } if(not scalar(keys %$snorlabo)) { $e->echo(__LINE__,"I set about->{complete} to 1."); $d->{'about'}->{'complete'}=1; ## incorpote the complete info in the file $i->set_file(); return 1; } $d->{'about'}->{'snorlabo'}=clone($snorlabo); return 0; } ## also does the job of collecting cross-sent data sub cover_ratio { my $i=shift; my $e=$i->{'e'}; my $d=$i->{'i'}->{'d'}; my $total_papids=$d->{'namf'}->{'d'}->{'total'}; #my $total_papids=scalar keys %{$all_papids}; #if(not defined($all_papids)) { # confess "I have no namf papids, thus no cover ratio."; #} my $repcodes=$i->get_repcodes() or return 0; my @repcodes=@{$repcodes}; foreach my $repcode (@repcodes) { my $sent=$d->{'report'}->{$repcode}->{'sent'} or next; my @sents=keys %$sent; my $sent_shoti=$sents[0] or next; foreach my $papid (keys %{$sent->{$sent_shoti}->{'d'}->{'papid'}}) { ## save the repcode as well ## FixMe: old way push (@{$d->{'about'}->{'sent'}->{'papid'}->{$papid}},$repcode); ## new way $d->{'about'}->{'sent'}->{'papids'}->{$repcode}->{$papid}=1; } } my $total_sent=scalar keys %{$d->{'about'}->{'sent'}->{'papid'}}; my $cover_ratio=sprintf("%.2f", 100 * $total_sent / $total_papids); $d->{'about'}->{'cover_ratio'}=$cover_ratio; } ## set 'name' between stages 'start' and 'end', store in about. sub delay { my $i=shift; my $e=$i->{'e'}; ## name of delay my $name=shift // confess "I need a name of delay here."; my $start=shift // confess "I need a start of delay."; my $end=shift // confess "I need an end of delay."; my $do_strict=shift // ''; my $repcodes=$i->get_repcodes(); my $d=$i->{'i'}->{'d'}; my $issuedate=$i->{'issuedate'} // confess "I need this set here."; foreach my $repcode (@$repcodes) { if(defined($i->{'i'}->{'d'}->{'about'}->{$name}->{$repcode})) { $e->echo(__LINE__,"I already have $name for $repcode."); next; } if(not $i->{'active'}->{$issuedate}->{$repcode}) { $e->echo(__LINE__,"I skip the inactive $repcode at $issuedate."); next; } my $data=$d->{'report'}->{$repcode} // confess "I need this here."; ## FixMe: erronous empty hashref ->{'d'}; if(not scalar keys %{$data->{$start}->{'d'}}) { delete $data->{$start}->{'d'}; } if(not scalar keys %{$data->{$end}->{'d'}}) { delete $data->{$end}->{'d'}; } if(not scalar keys %$data) { $e->echo(__LINE__,"I skip the empty data for $repcode"); delete $d->{'report'}->{$repcode}; next; } if(not $data->{$start}) { if($main::do_test or $do_strict) { confess "I don't have data for $start at repcode $repcode."; } } if(not $data->{$end}) { if($main::do_test or $do_strict) { confess "I don't have data for $end."; } next; } my @ends=keys %{$data->{$end}}; ## happens for one early bims issue; if(not scalar @ends) { $e->echo(__LINE__,"I have no $end time for $repcode"); return undef; } my $end_shoti=$ends[0]; if(not length($end_shoti) == 6) { confess "You end_shoti $end_shoti is not a shoti"; } my @starts=keys %{$data->{$start}}; if(not scalar @starts) { $e->echo(__LINE__,"I have no $start time for $repcode"); return undef; } my $start_shoti=$starts[0]; if(not length($start_shoti) == 6) { confess "You start_shoti $start_shoti is not a shoti"; } my $delay=&Krichel::Shonu::diff($end_shoti,$start_shoti); if($delay == 0) { confess "The delay on $name can not be zero."; } if($delay < 0) { confess "The delay on $name can not be negative."; } $i->{'i'}->{'d'}->{'about'}->{$name}->{$repcode}=$delay; } return $i->{'i'}->{'d'}->{'about'}->{$name}; # print Dumper $i->{'d'}->{'about'}; } ## prepare sborn joss sub sborn_issue { my $i=shift; my $what=shift // ''; if(not ($what eq 'complete' or $what eq 'in_labor')) { confess "I don't know what to do with what '$what'."; } #$i->clear(); $i->{'what'}=$what; ## this really is only for incremental processing at complete level, ## we don't really need it for in_labor processing. my $given_issuedate=shift // confess "I need this set here."; ## why main::e here? my $e=$main::e // $i->{'e'} ;; if(not $e) { confess "I don't see the erimp."; } #my $sborn_json=$i->{'dir'}->{'indat'}."/$what.json"; my $is_complete=1; my $issue_json; my $in_labor_json=$i->{'dir'}->{'issues'}.'/'.$given_issuedate.'.json'; my $complete_json=$i->{'dir'}->{'issues'}.'/complete/'.$given_issuedate.'.json'; if(-f $complete_json) { $e->echo(__LINE__,"I see $complete_json, I set issue_json to it."); $issue_json=$complete_json; } else { $is_complete=0; $issue_json=$in_labor_json; if($i->{'what'} eq 'complete') { $e->echo(__LINE__,"$given_issuedate does not belong into $what."); return 0; } } my $issue_json_age=-M $issue_json; ## let's delete the old data if($i->{$what}->{'d'}->{$given_issuedate}) { $e->echo(__LINE__,"I remove my $what data for $given_issuedate."); delete $i->{$what}->{'d'}->{$given_issuedate}; } ## this needs to go, otherwise we can't correct bad data in the file if(not $main::do_test) { my $sborn_json=$i->{'dir'}->{'indat'}."/$what.json"; my $sborn_age=$i->{'sborn_age'} // ''; if($sborn_age and $issue_json_age > $sborn_age) { $e->echo(__LINE__,"I don't renew $sborn_json over $issue_json for $what."); return 0; } } ## delete data for an issuedate that is no longer in_labor ## the adding in complete is done by the caller if($what eq 'in_labor') { if(-f $complete_json and not -f $in_labor_json) { $e->echo(__LINE__," I delete in_labor for $given_issuedate coz I see $issue_json."); delete $i->{'in_labor'}->{'d'}->{$given_issuedate}; # print Dumper $i->{$what}; $e->echo(__LINE__," I leave sborn_issue."); return 1; } } $e->echo(__LINE__,"I load $issue_json."); $i->{'i'}=&Ernad::Store::load($issue_json); $i->remove_namf_papids(); $i->remove_report_papids(); my $d=$i->{'i'}->{'d'}; $i->{$what}->{'d'}->{$given_issuedate}=clone($d); #print Dumper $i->{$what}->{'d'}; #delete $i->{'i'}; return 1; } sub sborn { my $i=shift; my $what=shift // ''; if(not ($what eq 'complete' or $what eq 'in_labor')) { confess "I don't know what to do with what '$what'."; } my $given_issuedate=shift // ''; my $e=$i->{'e'}; # $i->clear(); $i->{'what'}=$what; my $sborn_json=$i->{'dir'}->{'indat'}."/$what.json"; my $sborn_age; if(-f $sborn_json) { $sborn_age=-M $sborn_json; $i->{'sborn_age'}=$sborn_age; } if(not $i->{$what}) { if(-f $sborn_json) { $i->{$what}=&Ernad::Store::load($sborn_json); } else { $i->{$what}->{'d'}={}; $i->{$what}->{'v'}=&Krichel::Shoti::now; } } ## this really is only for incremental processing at complete level, ## we don't really need it for in_labor processing. my $issuedates=$i->get_issuedates($what); #print "what is $what\n"; #print Dumper $issuedates; #die; my $do_save=0; foreach my $issuedate (@$issuedates) { $e->echo(__LINE__,"I look at $issuedate.",10); if(-f $sborn_json) { if($given_issuedate and $issuedate ne $given_issuedate) { $e->echo(__LINE__,"I skip $issuedate because I look for $given_issuedate.",10); next; } } $e->echo(__LINE__,"I sborn $what work on $issuedate."); $do_save+=$i->sborn_issue($what,$issuedate); $e->echo(__LINE__,"I am done with sborn_issue for $what."); } if($do_save) { $e->echo(__LINE__,"I save i->{$what} to $sborn_json."); &Ernad::Store::save($i->{$what},$sborn_json); } else { $e->echo(__LINE__,"I don't save i->{$what} to $sborn_json."); } $e->echo(__LINE__,"I delete \$i->{$what}."); delete $i->{$what}; } ## FixMe: this should be moved to another place sub is_prenatal { my $i=shift; my $repcode=shift // confess "I need a repcode here."; my $issuedate=shift // $main::issuedate // $i->{'issuedate'} // confess "I need an issuedate here."; my $e=$i->{'e'} // confess "I need an erimp here."; if(not defined($e->{'report'}->{$repcode})) { $e->echo(__LINE__,"I don't know about $repcode."); return 1; } my $birthday=$e->get_report_birthday($repcode) // confess "I don't see a birthday for $repcode."; if(&Ernad::Dates::compare_dates($issuedate, $birthday) > 0) { return 1; } return 0; } 1;