Howdy fellow monks!

I have a (shamely) very long subroutine which looks ugly yet work. I've been trying to refactor the code into something more maintainable but couldn't figure out how.

Any help is appreciated!

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. my %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; LODGEMENT: foreach my $lodgement (@sorted_lodgements) { # Get Local actuals... my $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... my $total_lodged = 0; my $total_qcs_docs = 0; my $outstanding = 0; # Total document in all QCS for this batch... $total_qcs_docs = $self->_total_docs_in_batch(\@jobs); # Total _all_ lodged... my @all_possible_lodgements = ClientDB::Local_Lodgements->search_where({ reference => $lodgement->{reference}, hb_stream => $lodgement->{hb_stream}, }, { order_by => 'dockets' } ); # Grep only all lodgements ON OR BEFORE today... my @all_lodgements = grep { Date_Cmp( _dateformat($_->get('hb_Local_date_lodged')), _dateformat($self->{date_str}) ) <= 0 } @all_possible_lodgements; my $total_all_lodged = $self->_total_all_lodged(@all_lodgements); # 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... my @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... my $total_all_spoils = ClientDB::Client_Actuals ->sql_sum_hb_spoil($lodgement->{reference}) ->select_val; # Now parse through all jobs and qcs's... JOB: foreach my $job (@jobs) { # Get job QCS informations... QCS: foreach ($job->qcs) { # # Consolidation jobs... # if ( scalar(@jobs) > 1 ) { # 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 # just skip to the next one... next QCS if ( exists $check{$_->qcs_job_name} {$lodgement->{reference}} {$_->qcs_sequence_no}) && ($check{$_->qcs_job_name} {$lodgement->{reference}} {$_->qcs_sequence_no}) && ($client_job_spoil ->hb_Local_spoils == 0); # Mark that we have recorded this job... $check{$_->qcs_job_name} {$lodgement->{reference}} {$_->qcs_sequence_no} = 1; if ( $lodgement->hb_Local_Docs_Lodged == $total_qcs_docs ) { $total_lodged = $_->qcs_document_count(); $outstanding = 0; } elsif ( scalar(@all_lodgements) == 2 && ($total_all_lodged == $total_qcs_docs) ) { $outstanding = 0; if (scalar @previous_lodgements) { next QCS unless $client_job_spoil ->hb_Local_spoils > 0; $total_lodged = $client_job_spoil ->hb_Local_spoils; + } else { if ( exists $check{"$_->qcs_job_name"} {"$lodgement->{reference}"} {"$_->qcs_sequence_no"} {"lodgement"} && ($check{"$_->qcs_job_name"} {"$lodgement->{reference}"} {"$_->qcs_sequence_no"} {"lodgement"} ) > 0 ) { $total_lodged = $client_job_spoil ->hb_Local_spoils; } else { $total_lodged = $_->qcs_document_count - $client_job_spoil ->hb_Local_spoils; $check{"$_->qcs_job_name"} {"$lodgement->{reference}"} {"$_->qcs_sequence_no"} {"lodgement"} = $total_lodged; } } } elsif ( scalar(@all_lodgements) > 2 && ($total_all_lodged == $total_qcs_docs) ) { $outstanding = 0; # If there is any previous #lodgement, we report only the # one with spoil if (scalar @previous_lodgements) { next QCS unless $client_job_spoil ->hb_Local_spoils > 0; $total_lodged = '?'; } else { $total_lodged = $client_job_spoil ->hb_Local_spoils > 0 ? '?' : $_->qcs_document_count ; } } elsif ( scalar(@all_lodgements) == 1 && ($total_all_spoils > 0) && ($total_all_spoils + $total_all_lodged == $total_qcs_docs) ) { $total_lodged = $_->qcs_document_count() - $client_job_spoil ->hb_Local_spoils; $outstanding = $client_job_spoil ->hb_Local_spoils; } else { $total_lodged = '?'; $outstanding = '?'; } } else { # # Normal Client jobs... # $total_lodged = $lodgement->hb_Local_Docs_Lodged; $outstanding = $total_qcs_docs - $total_all_lodged - $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 => $total_lodged, date => $lodgement ->hb_Local_date_lodged, time => $lodgement ->hb_Local_time_lodged, state => $actual ->hb_Local_print_location, Localno => $actual ->hb_Local_number, extractions => $actual ->hb_Local_extractions, jobname => $_->qcs_job_name, JSN => $_->qcs_sequence_no, batchno => $_->qcs_batch_no, documents => $_->qcs_document_count, formid => $_->qcs_form_id, outstanding => $outstanding, number_of_jobs => scalar(@jobs), total_all_qcs => $total_qcs_docs, total_all_lodged => $total_all_lodged, }; } } } }

In reply to 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.