#!/usr/bin/perl

@words = qw[ old_word OLD_WORD old_WORD oLd_WoRd OLD_word ];

foreach $word ( @words )
{
   $new = 'this is the new string';
   print "$word:$new:".UpperLower( $word, $new )."\n";
}


sub UpperLower 
{
   my ( $old, $new ) = @_;
   my ( $a );

   ( length( $old ) >= length( $new ) ) ? $length = length( $old ) : $length = length( $new );

   for ( $i = 1; $i < $length+1; $i++ )
   {
      if ( uc( substr( $old, $i-1, 1 ) ) eq 
           substr( $old, $i-1, 1 ) && 
           substr( $old, $i-1, 1 ) )
      {
         $a .= uc( substr( $new, $i-1, 1 ) );
      }
      elsif ( uc( substr( $old, $i-1, 1 ) ) ne 
              substr( $old, $i-1, 1 ) && 
              substr( $old, $i-1, 1 ) )
      {
         $a .= lc( substr( $new, $i-1, 1 ) );
      }
      else
      {
         $a .= substr( $new, $i-1, 1 );
      }
   }
   return $a;
}