in reply to Refactor huge subroutine

Here's a start. Note that "global" stuff is added to a rptGlobal hash in $self to save passing around a bunch of stuff explicitly. A couple of large chunks of code have been refactored into subs. Early exits allow nested if/elsif structures to be flattened.

use strict; use warnings; sub produce_report { my ($self) = @_; # Initiate a hash to check if the same data has been # found earlier in this lodgement. This is to avoid # printing duplicate lines on multiple lodgements. $self->{rptGlobal}{check} = {}; # Get all lodgements and sort it... my @lodgements = $self->_get_lodgements ($self->{date_str}); my @sorted_lodgements = sort { $a->{dockets} cmp $b->{dockets} } @lodgements; foreach my $lodgement (@sorted_lodgements) { # Get Local actuals... $self->{rptGlobal}{actual} = $self->_get_Local ($lodgement); # Get all job from client_job... my @jobs = $self->_get_jobs ($lodgement); # Scalar to hold total outstanding and documents # lodged for this batch... $self->{rptGlobal}{total_lodged} = 0; $self->{rptGlobal}{total_qcs_docs} = 0; $self->{rptGlobal}{outstanding} = 0; # Total document in all QCS for this batch... $self->{rptGlobal}{total_qcs_docs} = $self->_total_docs_in_batch (\@jobs); # Total _all_ lodged... my @all_possible_lodgements = ClientDB::Local_Lodgements->sear +ch_where ( { reference => $lodgement->{reference}, hb_stream => $lodgement->{hb_stream}, }, {order_by => 'dockets'} ); # Grep only all lodgements ON OR BEFORE today... @{$self->{rptGlobal}{all_lodgements}} = grep { Date_Cmp (_dateformat ($_->get ('hb_Local_date_lodged')), _dateformat ($self->{date_str})) <= 0 } @all_possible_lodgements; $self->{rptGlobal}{total_all_lodged} = $self->_total_all_lodged (@{$self->{rptGlobal}{all_lodgeme +nts}}); # Any previous lodgement for the same batch... my @previous_possible_lodgements = ClientDB::Local_Lodgements->search_where ( { reference => $lodgement->{reference}, hb_stream => $lodgement->{hb_stream}, hb_Local_date_lodged => {'<', $self->{date_str}} } ); # Grep only all lodgements BEFORE today... @{$self->{rptGlobal}{previous_lodgements}} = grep { Date_Cmp (_dateformat ($_->get ('hb_Local_date_lodged')), _dateformat ($self->{date_str})) < 0 } @previous_possible_lodgements; # Total _all_ spoils for this batch... $self->{rptGlobal}{total_all_spoils} = ClientDB::Client_Actuals->sql_sum_hb_spoil ($lodgement->{r +eference}) ->select_val; # Now parse through all jobs and qcs's... foreach my $job (@jobs) { $self->rptProcessJob ($lodgement, $job, scalar @jobs); } } delete $self->{rptGlobal}; } sub rptProcessJob { my ($self, $lodgement, $job, $numJobs, $check) = @_; # Get job QCS informations... foreach ($job->qcs) { # Consolidation jobs... if ($numJobs > 1) { next unless $self->rptGenConsolidated ($job, $lodgement); } else { # Normal Client jobs... $self->{rptGlobal}{total_lodged} = $lodgement->hb_Local_Do +cs_Lodged; $self->{rptGlobal}{outstanding} = $self->{rptGlobal}{total_qcs_docs} - $self->{rptGlobal}{total_all_lodged} - $self->{rptGlobal}{actual}->hb_Local_extractions; } # Generate the array of hashes of lodgement on specific date.. +. push @{$self->{lodgements}}, { reference => $lodgement->{reference}, ap_docket => $lodgement->{dockets}, lodged => $self->{rptGlobal}{total_lodged}, date => $lodgement->hb_Local_date_lodged, time => $lodgement->hb_Local_time_lodged, state => $self->{rptGlobal}{actual}->hb_Local_print_ +location, Localno => $self->{rptGlobal}{actual}->hb_Local_number +, extractions => $self->{rptGlobal}{actual}->hb_Local_extrac +tions, jobname => $_->qcs_job_name, JSN => $_->qcs_sequence_no, batchno => $_->qcs_batch_no, documents => $_->qcs_document_count, formid => $_->qcs_form_id, outstanding => $self->{rptGlobal}{outstanding}, number_of_jobs => scalar ($numJobs), total_all_qcs => $self->{rptGlobal}{total_qcs_docs}, total_all_lodged => $self->{rptGlobal}{total_all_lodged}, }; } } sub rptGenConsolidated { my ($self, $job, $lodgement) = @_; # Spoil for individual Client job... my $client_job_spoil = ClientDB::Client_Actuals->retrieve ( reference => $lodgement->{reference}, cj_job_ref_no => $job->{cj_job_ref_no}, qcs_sequence_no => $_->qcs_sequence_no, ); # If the row has been recorded before and it has no spoil then jus +t skip to # the next one... return 0 if ( exists $self->{rptGlobal}{check}{$_->qcs_job_name} {$lodgement->{reference}}{$_->qcs_sequence_no}) && ($self->{rptGlobal}{check}{$_->qcs_job_name}{$lodgement->{r +eference}} {$_->qcs_sequence_no}) && ($client_job_spoil->hb_Local_spoils == 0); # Mark that we have recorded this job... $self->{rptGlobal}{check}{$_->qcs_job_name}{$lodgement->{reference +}} {$_->qcs_sequence_no} = 1; if ($lodgement->hb_Local_Docs_Lodged == $self->{rptGlobal}{total_q +cs_docs}) { $self->{rptGlobal}{total_lodged} = $_->qcs_document_count (); $self->{rptGlobal}{outstanding} = 0; return 1; } if ( scalar (@{$self->{rptGlobal}{all_lodgements}}) == 2 && ($self->{rptGlobal}{total_all_lodged} == $self->{rptGlobal}{total_qcs_docs}) ) { $self->{rptGlobal}{outstanding} = 0; if (scalar @{$self->{rptGlobal}{previous_lodgements}}) { return 0 unless $client_job_spoil->hb_Local_spoils > 0; $self->{rptGlobal}{total_lodged} = $client_job_spoil->hb_Local_spoils; return 1; } if ( exists $self->{rptGlobal}{check}{"$_->qcs_job_name"} {"$lodgement->{reference}"}{"$_->qcs_sequence_no"}{"lodgem +ent"} && ($self->{rptGlobal}{check}{"$_->qcs_job_name"} {"$lodgement->{reference}"}{"$_->qcs_sequence_no"}{"lo +dgement"}) > 0 ) { $self->{rptGlobal}{total_lodged} = $client_job_spoil->hb_Local_spoils; } else { $self->{rptGlobal}{total_lodged} = $_->qcs_document_count - $client_job_spoil->hb_Local_s +poils; $self->{rptGlobal}{check}{"$_->qcs_job_name"} {"$lodgement->{reference}"}{"$_->qcs_sequence_no"} {"lodgement"} = $self->{rptGlobal}{total_lodged}; } return 1; } if ( scalar (@{$self->{rptGlobal}{all_lodgements}}) > 2 && ($self->{rptGlobal}{total_all_lodged} == $self->{rptGlobal}{total_qcs_docs}) ) { $self->{rptGlobal}{outstanding} = 0; # If there is any previous lodgement, we report only the one w +ith spoil if (scalar @{$self->{rptGlobal}{previous_lodgements}}) { return 0 unless $client_job_spoil->hb_Local_spoils > 0; $self->{rptGlobal}{total_lodged} = '?'; } else { $self->{rptGlobal}{total_lodged} = $client_job_spoil->hb_Local_spoils > 0 ? '?' : $_->qcs_document_count; } return 1; } if ( scalar (@{$self->{rptGlobal}{all_lodgements}}) == 1 && ($self->{rptGlobal}{total_all_spoils} > 0) && ($self->{rptGlobal}{total_all_spoils} + $self->{rptGlobal}{total_all_lodged} == $self->{rptGlobal}{total_qcs_docs}) ) { $self->{rptGlobal}{total_lodged} = $_->qcs_document_count () - $client_job_spoil->hb_Local_sp +oils; $self->{rptGlobal}{outstanding} = $client_job_spoil->hb_Local_ +spoils; } else { $self->{rptGlobal}{total_lodged} = '?'; $self->{rptGlobal}{outstanding} = '?'; } return 1; }

Untested of course with no guarantee against introduced bugs. You do have a comprehensive test suite right?

A little additional commenting in each of the top level if blocks in rptGenConsolidated would be nice.


Perl reduces RSI - it saves typing