my$s=shift;until(length$s<2){print"$s\n";$s=tpr($s)}print"$s\n";sub
tpr{my@d=split//,shift;my $s;while(my@p=splice@d,0,2){unshift@d,$p[1]
unless!@d;my$r=$p[0]+$p[1];until($r<=9){my$c=$r;$r=0;for(split//,$c){
$r+=$_}}$s.=$r}$s}