use strict;
use Win32::OLE;
use Win32::OLE::Const 'Microsoft Word';

my ($exec_res, $filepath, $oldfile, $editfile, %str_changes, %wingding_changes, $return_message, $return_code );

#================================================================================
#
# sub edit_word_doc
#
# this sub alters the given word document by
#	substituting one character string with another	and/or
#                 one character string for a wingding or similar symbol
# stores the edited document under given name
#
# arguments
# 1	full path of original document
# 2	full path of edited document
# 3	reference to hash holding the string substitutions
# 4	reference to hash holding the wingding substitutions
# 5	reference to variable holding accumulated messages when failures occur
# 6	reference to return code - 1 OK - 2 failure
#
# structure of string substitution hash
#	$str_sb{a}{b} = v
#    where a is substitution number
#          b is one of
#			target - target string given by v
#			required - required string given by v 
#
# structure of string substitution hash
#	$wng_sb{a}{b} = v
#    where a is substitution number
#          b is one of
#			target - target string given by v
#			wingding - required ASCII number of symbol given by v 
#			font - name of symbol 'font' given by v (for example wingdings)
#
#=================================================================================


sub edit_word_doc($$$$$$) {

my ($oldfile, $editfile, $ref_str_sb, $ref_wng_sb, $ref_return_message, $ref_return_code) = @_;

my ($word, $doc, $sb_item, $find_sb_item, $fail_cou, $selection);
my ($search, $replace, $search_res, $save_word_res);

# open the given file

$word = Win32::OLE-> GetActiveObject('Word.Application')
	|| Win32::OLE-> new('Word.Application','Quit');

$doc = $word->Documents->Open("$oldfile");

#check that $doc inlcudes required characters

if($doc =~ m/OLE=HASH/) {

} else {

	$$ref_return_message = "failure to use given file <$oldfile>\n";
	$$ref_return_code    = 0;

	return
}

# is application visible 0=no  1=yes
$word-> {visible} = 0;

# initialse return values
$$ref_return_message = '';
$$ref_return_code    = 1;

# initialise failure count
$fail_cou = 0;

# substitute using wingdings 

$selection = $word->Selection;

foreach $sb_item (sort {$a <=> $b} keys %$ref_wng_sb) {

	$selection->MoveLeft ({Unit => wdCharacter, Count => 9999});
	$selection->MoveUp   ({Unit => wdLine, Count => 99999});

	$selection->Find->ClearFormatting;
	$selection->Find->{Text} = $ref_wng_sb->{$sb_item}{target};
	$find_sb_item = $selection->Find->Execute;

	if($find_sb_item != 1) {

# failure

		$fail_cou += 1;
		$$ref_return_message .= "wingding - failure to find $ref_wng_sb->{$sb_item}{target}\n";

	} else {
		
		$selection->MoveRight ( {Unit => wdCharacter, Count => 1} );

		$selection->InsertSymbol( { Font=> $ref_wng_sb->{$sb_item}{font}, CharacterNumber => $ref_wng_sb->{$sb_item}{wingding} - 4096, Unicode => 1 });
	}
}

# remove wingding insertion strings


$selection->MoveLeft ({Unit => wdCharacter, Count => 9999});
$selection->MoveUp   ({Unit => wdLine, Count => 99999});

$search =  $doc-> Content->Find;          
$replace = $search-> Replacement;   

# remove wingding insertion strings

foreach $sb_item (sort {$a <=> $b} keys %$ref_wng_sb) {

	$search-> {Text} = $ref_wng_sb->{$sb_item}{target};                 
	$replace-> {Text} = "";                
	$search_res = $search-> Execute({Replace => wdReplaceAll});

	if($search_res != 1) {

# failure

		$fail_cou += 1;
		$$ref_return_message .= "wingding - failure to remove $ref_wng_sb->{$sb_item}{target}\n";

	}
}

# make character substitutions

foreach $sb_item (sort {$a <=> $b} keys %$ref_str_sb) {

	$search-> {Text} = $ref_str_sb->{$sb_item}{target};                 
	$replace-> {Text} = $ref_str_sb->{$sb_item}{required};                
	$search_res = $search-> Execute({Replace => wdReplaceAll});

	if($search_res != 1) {

# failure

		$fail_cou += 1;
		$$ref_return_message .= "string - failure to change $ref_str_sb->{$sb_item}{target} for $ref_str_sb->{$sb_item}{required}\n";

	}
}

# save edited file

$save_word_res = $word-> ActiveDocument->SaveAs($editfile);

# close word file
$doc-> Close();
$word-> Quit();

# ensure return code is correct

if($fail_cou > 0) {

	$$ref_return_code    = 0;

}
}



#=================================================================================
#
# test data

$filepath = 'C:\tmp';

# set $filepath to the full path to the direcotry where the file to be changed, test.doc, is stored

$oldfile = $filepath . '\wingding1.doc';
$editfile = $filepath . '\wingding1-edit.doc';

$str_changes{1}{target}   = '#s1';
$str_changes{1}{required} = 'abc';
$str_changes{2}{target}   = '#s2';
$str_changes{2}{required} = 'def';
$str_changes{3}{target}   = '#s3';
$str_changes{3}{required} = 'ghi';
$str_changes{4}{target}   = '#s4';
$str_changes{4}{required} = 'jklmnop';
$str_changes{5}{target}   = '#s5';
$str_changes{5}{required} = 'rstuvwxyz';

$wingding_changes{1}{target}   = '#w1';
$wingding_changes{1}{wingding} = 252;
$wingding_changes{1}{font}     = 'wingdings';
$wingding_changes{2}{target}   = '#w2';
$wingding_changes{2}{wingding} = 70;
$wingding_changes{2}{font}     = 'wingdings 2';
$wingding_changes{3}{target}   = '#w3';
$wingding_changes{3}{wingding} = 200;
$wingding_changes{3}{font}     = 'wingdings 3';
$wingding_changes{4}{target}   = '#w4';
$wingding_changes{4}{wingding} = 40;
$wingding_changes{4}{font}     = 'wingdings 3';
$wingding_changes{5}{target}   = '#w5';
$wingding_changes{5}{wingding} = 38;
$wingding_changes{5}{font}     = 'webdings';

edit_word_doc ($oldfile, $editfile, \%str_changes, \%wingding_changes, \$return_message, \$return_code);

print "\nafter edit doc - return code <$return_code> message <$return_message>\n";