sub _build_match_subs()

in automation/tinc/main/ext/atmsort.pl [478:584]

• 70 lines of code
• 7 McCabe index (conditional complexity)

sub _build_match_subs
{
    my ($here_matchsubs, $whomatch) = @_;

    my $stat = [1];

     # filter out the comments and blank lines
     $here_matchsubs =~ s/^\s*\#.*$//gm;
     $here_matchsubs =~ s/^\s+$//gm;

#    print $here_matchsubs;

    # split up the document into separate lines
    my @foo = split(/\n/, $here_matchsubs);

    my $ii = 0;

    my $matchsubs_arr = [];
    my $msa;

    # build an array of arrays of match/subs pairs
    while ($ii < scalar(@foo))
    {
        my $lin = $foo[$ii];

        if ($lin =~ m/^\s*$/) # skip blanks
        {
            $ii++;
            next;
        }

        if (defined($msa))
        {
            push @{$msa}, $lin;

            push @{$matchsubs_arr}, $msa;

            undef $msa;
        }
        else
        {
            $msa = [$lin];
        }
        $ii++;
        next;
    } # end while

#    print Data::Dumper->Dump($matchsubs_arr);

    my $bigdef;

    my $fn1;

    # build a lambda function for each expression, and load it into an
    # array
    my $mscount = 1;

    for my $defi (@{$matchsubs_arr})
    {
        unless (2 == scalar(@{$defi}))
        {
            my $err1 = "bad definition: " . Data::Dumper->Dump([$defi]);
            $stat->[0] = 1;
            $stat->[1] = $err1;
            return $stat;
        }

        $bigdef = '$fn1 = sub { my $ini = shift; '. "\n";
        $bigdef .= 'if ($ini =~ ' . $defi->[0];
        $bigdef .= ') { ' . "\n";
#        $bigdef .= 'print "match\n";' . "\n";
        $bigdef .= '$ini =~ ' . $defi->[1];
        $bigdef .= '; }' . "\n";
        $bigdef .= 'return $ini; }' . "\n";

#        print $bigdef;

        if (eval $bigdef)
        {
            my $cmt = $whomatch . " matchsubs \#" . $mscount;
            $mscount++;

            # store the function pointer and the text of the function
            # definition
            push @{$glob_match_then_sub_fnlist}, 
			[$fn1, $bigdef, $cmt, $defi->[0], $defi->[1]];

			if ($glob_verbose)
			{
				print "GP_IGNORE: Defined $cmt\t$defi->[0]\t$defi->[1]\n"
			}
        }
        else
        {
            my $err1 = "bad eval: $bigdef";
            $stat->[0] = 1;
            $stat->[1] = $err1;
            return $stat;
        }

    }

#    print Data::Dumper->Dump($glob_match_then_sub_fnlist);
   
    return $stat;

} # end _build_match_subs