while ($text =~ m/
   (APC[s]?)
   (
      \s \d{3}
      (?:
         (?: , \s \d{3} )*
         \s and \s \d{3}
      )?
   )
/xg) {
   my ($apc, $nums) = ($1, $2);
   my @nums = $nums =~ /(\d+)/g;
   push @extracts, $apc, @nums;
}