I have now used your example to give a subroutine to which I give an array of the extensions for which I want the path to the .exe.This is below in case it is of any use to another Monk.
Although this works, it would be good if someone could explain how the follwing two Perl lines work since I do not understand them.
my ( $extention, $type ) = split '=', `assoc $arg_item 2>nul`;
my( undef, $cmd ) = split '=', `ftype $type 2>nul`;
The sub and test code is below#! perl -slw
use strict;
#
# sub get_file_association
#
# this gets the path for the given file extension
#
# argument
# 1 $ref_arg reference to array holding the extensions to be tested
# 2 $ref_file_path reference to the hash holding the .exe asscia
+tions
# strucutre
# {extension}{exe} just to the end of the .exe
# {extension}{all} the whole of the result
# 3 $ref_path reference to the has holding the path for the exte
+nsion
# structure
# {extension}{path<n>} gives all the assciations found
# 4 $ref_error result of finding extensions one of 'none', 'some' a
+nd 'all'
# 5 $ref_error_message acucmulation of error messages (if there are
+ any)
#
sub get_file_association($$$$$) {
my ($ref_arg, $ref_file_path, $ref_file_path_all, $ref_error, $ref_err
+or_message) = @_;
my ($arg_item);
my ($cmd_length, $j, $ord_value, $str, $path_cou, $cur_path, $path_cou
+_str, $add_chr, $path_item);
my ($error_count, @path_split);
$$ref_error = 'none';
$$ref_error_message = '';
$error_count = 0;
foreach $arg_item ( @$ref_arg ) {
my ( $extention, $type ) = split '=', `assoc $arg_item 2>nul`;
if(defined($type) == 0) {
print "No association was found for extension <$arg_item>\n";
$error_count +=1;
$$ref_error_message .= "No association was found for extension
+ <$arg_item>\n";
} else {
chomp $type;
my( undef, $cmd ) = split '=', `ftype $type 2>nul`;
if(defined($cmd) == 0) {
print "No command was associated with type '$type'";
$error_count +=1;
$$ref_error_message .= "No command was associated with typ
+e '$type'";
chomp $cmd;
} else {
print "Extension '$arg_item' is associated with type '$typ
+e' "
. "\n\tand the command: <$cmd>\n\n";
$cur_path = '';
$path_cou = 0;
$add_chr = 0;
$cmd_length = length($cmd);
for($j = 0; $j < $cmd_length; $j ++) {
$str = substr($cmd, $j, 1);
$ord_value = ord(substr($cmd, $j, 1));
if($ord_value ne 10) {
$cur_path .= $str;
$add_chr += 1;
} else {
$path_cou += 1;
$path_cou_str = 'path' . $path_cou;
$ref_file_path_all->{$arg_item}{$path_cou_str} = $
+cur_path;
$cur_path = '';
$add_chr = 0;
}
}
if($add_chr > 0) {
$path_cou += 1;
$path_cou_str = 'path' . $path_cou;
$ref_file_path_all->{$arg_item}{$path_cou_str} = $cur_
+path;
}
foreach $path_item (keys %{$ref_file_path_all->{$arg_item}
+}) {
$cur_path = $ref_file_path_all->{$arg_item}{$path_item
+};
if(lc($cur_path) =~ m/\.exe/) {
$ref_file_path->{$arg_item}{all} = $cur_path;
@path_split = split (/\.exe/, lc($cur_path));
$ref_file_path->{$arg_item}{exe} = substr($cur_pat
+h, 0, length($path_split[0])) . '.exe';
}
}
}
}
}
if($error_count > 0) {
if($error_count == scalar(@$ref_arg)) {
$$ref_error = 'all';
} else {
$$ref_error = 'some';
}
}
}
my (@file_ext, %file_path, %file_path_all, $k1, $k2, $error, $error_me
+ssage);
@file_ext = ( '.pl', '.doc', '.csv', '.xls' );
#@file_ext = ( '.pl' , 'xyz');
#@file_ext = ( 'xyz', 'pqr');
get_file_association(\@file_ext, \ %file_path, \%file_path_all, \$erro
+r, \$error_message);
print "\nafter get_file_association - error <$error> message \n$error_
+message\n\n";
foreach $k1 (sort {$a cmp $b} keys %file_path) {
print "\nextension <$k1>\n";
print "exe <$file_path{$k1}{exe}>\nall <$file_path{$k1}{all}>\n";
foreach $k2 (sort {$a cmp $b} keys %{$file_path_all{$k1}}) {
print "$k2 path <$file_path_all{$k1}{$k2}>\n";
}
}
|