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

In reply to Re: Refactor huge subroutine by GrandFather
in thread Refactor huge subroutine by est

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.