#!/usr/bin/perl -w
use strict;

my @lines = map {(/([^\n\r]+)/)} <>;

# a couple of globals to reign outright
my (%chunks,$counter) = ();

# iterate over each pair
foreach (@lines) {
 my @words = split / /;
 printf "%2d %s %s\n", min_chunks(@words), @words;
}

sub min_chunks {
 my ($word1,$word2) = @_; # get the two words
 my $len = length $word1; # how many characters?
 my $max = $len;    # as above
 $counter = $max;   # assume maximum number of chunks

 (%chunks) = (); # clear the decks

 # find all the chunks possible
 while($len > 0) {   # while we have something
  my $inx = 0;   # start from the beginning
        # until we can't go any further
  while($inx+$len <= $max) {
        # get a short string
   my $chunk = lc substr($word1,$inx,$len);
        # if it matches remember it
   $chunks{$chunk}++ if($word2 =~ /$chunk/i);
   $inx++;
  }
  $len--;
 }

 # now find the lowest count
 domatch(1,$word1,"");  # now do the real work
 return $counter;   # return the minimum chunks
}

sub domatch {
 my ($cnt,$word,$str) = @_;     # get the arguments

 foreach my $chunk (keys %chunks) {   # check all chunks
  next unless($chunks{$chunk});  # can we use this one?

  if($word =~ /^$str$chunk$/i) {   # if we have an exact match
   $counter = $cnt
    if($cnt < $counter);   # update the counter (if lower)
   return;        # next please :)
  }

  next if($counter <= $cnt+1);   # already gone that far
  next unless($word =~ /^$str$chunk/i);# can we still match?

  $chunks{$chunk}--;      # one less to use
  domatch($cnt+1,$word,"$str$chunk");  # do more work
  $chunks{$chunk}++;      # we can use it again now
 }
}
