view release on metacpan or  search on metacpan

lib/ControlBreak.pm  view on Meta::CPAN

            ...
            # accumulate subtotals
            map { $totals[$_] += $number } $cb->level_numbers;
        };

        $cb->test_and_do(
            $control1,
            $control2,
            $cb->iteration == $list_of_lists - 1,
            $sub_totals
        );
    }


=cut

method level_numbers () {
    return 1 .. $_num_levels;
}

=head2 reset

Resets the state of the object so it can be used again for another
set of iterations using the same number and type of controls
establish when the object was instantiated with B<new()>.  Any
comparisons that were subsequently modified are retained.

=cut

method reset () {   ## no critic [ProhibitParensWithBuiltins]
    $iteration          = 0;
    $_continue_count    = 0;
    $_test_levelnum     = 0;
    $_test_levelname    = 0;
    @_test_values       = ();
    @_last_values = ( undef ) x $_num_levels;
}

=head2 test ( $var1 [, $var2 ]... )

Submits the control variables for testing against the values from the
previous iteration.

Testing is done in reverse order, from highest to lowest (major to
minor) and stops once a change is detected. Where it stops determines
the control break level.  For example, if $var2 changed, method
levelnum will return 2.  If $var2 did not change, but $var1 did, then
method B<levelnum()> will return 1.  If nothing changes, then
B<levelnum()> will return 0.

Note that the level numbers set by B<test(...)> are true if there was
a level change, and false if there wasn't.  So, they can be used as a
simple boolean test of whether there was a change.  Or you can use
the B<break()> method to determine whether any control break has
occurred.

Because level numbers correspond to the hierarchical data order, they
can be use to trigger multiple actions; e.g. B<levelnum()> >= 1 could
be used to print subtotals for levels 1 whenever a control break
occurred for level 1, 2 or 3.  It is usually the case that higher
control breaks are meant to cascade to lower control levels and this
can be achieved in this fashion.  The B<break()> method simplifies
this.

Note that method B<continue()> must be called at the end of each
iteration in order to save the values of the iteration for the next
iteration. If not, the next B<test(...)> invocation will croak.

=cut

method test (@args) {
    croak '*E* number of arguments to test() must match those given in new()'
        if @args != $_num_levels;

    croak '*E* continue() must be called after test()'
        unless $iteration == $_continue_count;

    @_test_values = @args;

    $iteration++;

    my $is_break;
    my $lev_idx = 0;

    # process tests in reverse order of arguments; i.e. major to minor
    my $jj = @args;
    foreach my $arg (reverse @args) {
        $jj--;

        # on the first iteration, make the last values match the current
        # ones so we don't detect any control break

        $_last_values[$jj] //= $arg # uncoverable condition left
            if $iteration == 1;

        my $level_name = $_levname{$jj};

        # compare the current and last values using the comparison function
        # if they don't match, then it's a control break
        $is_break = not $_fcomp{$level_name}->( $arg, $_last_values[$jj] );

        if ( $is_break ) {
            # internally our lists use the usual zero-based indexing
            # but externally our level numbers are 1-based, where
            # 1 is the most minor control variable.  Level 0 is used
            # to denote no level; i.e. no control break.  Since zero
            # is treated as false by perl, and non-zero as true, we
            # can use the level number in a condition to determine if
            # there's been a control break; ie. $level ? 'break' : 'no break'
            $lev_idx = $jj + 1;
            last;
        }
    }
    my $lev_num = $lev_idx;

    $_test_levelnum  = $lev_num;
    $_test_levelname = $_levname{$jj};

    return;
}