• How are you intending to use $$key = undef? What are you passing to it? In the actual subroutine is there code after all these if's? You do not appear to be using the value of $key (or $$key) anywhere in the function.

  Presumably you are passing something like \$key to this function with the intent of setting it? Is this a necessity because of the calling code? (from the name, it appears to be some sort of callback). If a necessity, you might want to document that in your code or choose a variable name that lets the reader know that $key is a reference to something of interest to the caller, and not the value itself.

  But if it is not a necessity, I would consider a more idiomatic (for Perl) way of getting the value assigned to $key back to the caller: just return the value you want to assign to the key and use an assignment in the calling code:$x=dispatch_closing(...).

  The effect of $$key=undef as the final statement of each if is to make the subroutine return the value assigned to $$key anyway - Perl always returns the value of the last executed statement. If you mean to return undef, then just do it, return undef. The intent is much clearer.

• Are these if statements meant to be mutually exclusive, i.e. if one succeeds the others should be ignored? If so, you might want to consider using if...elsif...else. See perlintro for an example. (For some bizarre reason the possibility of doing this is not clearly explained in perlsyn). Using if...elsif...else will cause Perl to skip past all of those regexes once the matching one is found. As it stands, you are evaluating all of the regexes, even after you find the first match, e.g.

     if ( some condition ) {
     } elsif ( some other conditional ) {
     } elsif ( yet another conditional ) {
     } else {
     }
  [download]

Best, beth

Besides a single >, the thing that the code does in the SERVICE_APPLICATION_EXECUTION_COMPONENT and WEB_APPLICATION_EXECUTION_COMPONENT are identical (as far as I can see). Ensure that the > is really needed there and consider merging the two blocks.

Having the if($os eq 'unx') inside foreach blocks is not a good idea, since the condition is loop-invariant, which means that the outcome of the check inside the ifs won't change, depending on the values of the iterator (foreach). It should be rewritten as:

if(...) {
    foreach ... (...) {
        ...
    }
}
[download]

And again, the two blocks checking for UNX and WNT are nearly identical. See if you can merge them. Redundant redundant code is redundant redundant is redundant.

if ($line =~ /SERVICE_APPLICATION_EXECUTION_COMPONENT)
[download]

if ($line =~ /SERVICE_APPLICATION_EXECUTION_COMPONENT/)
[download]

Few improvement ideas. Untested:

sub dispatch_closing
{
    my ($line,$fw,$key,$HR_record,$os)= @_;
    
    my $brace = ($line =~ /SERVICE_APPLICATION_EXECUTION_COMPONENT|UNX
+/ ? '>' : '');
    
    if ($line =~ /SERVICE_APPLICATION_EXECUTION_COMPONENT|WEB_APPLICAT
+ION_EXECUTION_COMPONENT/)
    {
        while(my($k, $v)=each %$HR_record)
            { print $fw "\tENVIRONMENT_VARIABLE Id=\"$k\">${v}ENVIRONM
+ENT_VARIABLE$brace\n" }
        
    }
    if (($line =~ /UNX/ && $os eq 'unx')
    || ($line =~ /WNT/ && $os eq 'win'))
    {
        while(my($k, $v)=each %$HR_record)
            { print $fw  "\tRESOURCE Id=\"$k\" Source=" . substitute($
+v) . " RESOURCE$brace}\n" }
    }
    if($line =~ /SERVICE_APPLICATION_EXECUTION_COMPONENT|WEB_APPLICATI
+ON_EXECUTION_COMPONENT|UNX|WNT/)
        { $$key = undef }
}
[download]

Not tested

sub dispatch_closing {
    my ( $line, $fh, $HR_record ) = @_; 

    return
      unless $line =~
        /((?:SERVICE|WEB)_APPLICATION_EXECUTION_COMPONENT)|(UNX|WNT)/;

    my $sep = q{>};
    my $env = 'ENVIRONMENT_VARIABLE';
    my $res = 'RESOURCE';

    if ( defined $1 ) { 
        $sep = ( $1 =~ /SERVICE/ ) ? q{>} : q{};
        printf( $fh,
            "\t%s Id=\"%s\"%c%s%s%c\n",
            , $env, $_, $sep, $HR_record->{$_}, $env )
          for keys %$HR_record;
    }   
    else {
        $sep = ( $2 =~ /UNX/ ) ? q{>} : q{};
        printf( $fh,
            "\t%s Id=\"%s\" Source= %s %s%c}\n",
            $res, $_, substitute( $HR_record->{$_} ),
            $res, $sep )
          for keys %$HR_record;
    }   
}
[download]

hth,
PooLpi