--why the code still not working

The short answer to your question is that you are trying to do way too much in a single regular expression.

Try breaking down the problem into smaller steps. First get a program that does what you want with the lines beginning with AU. When you get that right, then and only then expand the program to also replace ids.

Even doing the right thing with lines that begin with AU can be broken down into single steps. You don't need to select the lines beginning with 'AU' and do the substitutions and insert "Written by" all in one go. Instead break it down into steps:

1. Use if ($line =~ /^AU:/) {...} to select the lines beginning with 'AU' for special processing.
2. Find the place to insert "Written by". Do this as a single step on its lonesome.
3. Capitalize each word using a simple regular expression, something like this: s/\s(\w+)/ \u$1/g

Here is a part of your problem broken down into smaller steps. You might find substr especially helpful. It can be used on the left side to replace parts of a string.

my $iLength = length('AU: Written by:');

# read lines one at a line instead of slurping into an array
# this is more memory friendly
while (my $line = <INPUT>) {

  # single out lines beginning with 'AU' for special processing
  if ($line =~ /^AU:/) {
     
     # insert "Written by"
     # Note: substr on the left means
     #   replace the zero-length string at position 3
     #   in other words: insert something at position 3
     substr($line, 3,0) = ' Written by:';

     # capitalize the first letter of every word
     # Note: substr on the left means
     #   make substitutions in the part of the string after
     #   "AU: written by" 
     substr($line, $iLength) =~ s/\s(\w+)/ \u$1/g;
  }
  print $line;
}
[download]