#!/usr/bin/perl
use strict;
use warnings;
use Parse::RecDescent;

$Parse::RecDescent::skip = '';

my $grammar = q{
    match  : PREFIX TOKEN SUFFIX
             {print join '', @item[1..3]}
    PREFIX : /.*?(?=a+b+)/
    TOKEN  : /a+b+/
             {
                 my $str   = $item[1];
                 my $a_cnt = $str =~ tr/a//;
                 my $b_cnt = $str =~ tr/b//;
                 if ($a_cnt == $b_cnt) {
                     $return = ('c' x $a_cnt) . ('d' x $b_cnt);
                 }
                 elsif ($a_cnt > $b_cnt) {
                     $return = ('a' x ($a_cnt - $b_cnt)) . ('c' x $b_cnt) . ('d' x $b_cnt);
                 }
                 else {
                     $return = ('c' x $a_cnt) . ('d' x $a_cnt) . ('b' x ($b_cnt - $a_cnt));
                 }
             }
    SUFFIX : /.*$/
};
my $parser = Parse::RecDescent->new($grammar);
$parser->match('sing aaaaaabbb song');