Win32::OLE merge rtf files - table structure missing

#! C:\Strawberry\perl\bin

use strict;
use Win32::OLE;
use Win32::OLE::Const;
use File::Spec::Functions 'canonpath';
#use Data::Dumper;
use File::Basename;
use Cwd 'abs_path';
use utf8;
 use Encode;
Win32::OLE->Option (CP => Win32::OLE::CP_UTF8);

my $document_name = $ARGV[0];
 $document_name =~ s/\\/\\\\/g;

print "document_name:$document_name\n";
my $wd = Win32::OLE->new('Word.Application', 'Quit')
  or die "Couldn't run Word";

	
my $ob_report_dump_file = 'ob_report.txt';
my $report_dump_filename = abs_path($ob_report_dump_file);
my $ob_report_file = $report_dump_filename.'/'.$ob_report_dump_file;

my $report_file = 'customized_report.rtf';
my $report_refined_filename = abs_path($report_file);
my $report_refined_file = $report_refined_filename.'/'.$report_file;



open(my $fh, '+>:encoding(UTF-8)', $ob_report_file) or die "Could not open file '$ob_report_file' $!";

my $word = Win32::OLE->GetActiveObject('Word.Application')
    || Win32::OLE->new('Word.Application','Quit')
    or die Win32::OLE->LastError();
	my $document = $word->Documents->Open($document_name)
    or die Win32::OLE->LastError();
my $paragraphs = $document->Paragraphs();
my $n_paragraphs = $paragraphs->Count();


for my $p (1..$n_paragraphs) {
    my $paragraph = $paragraphs->Item($p);
    #my $text = $paragraph->Range->Text();
	my $text = substr($paragraph->Range->Text, 0, -1);
		next if $text =~ /^\s*$/;
		next if $text =~ /
/;
		$text = '' if $text =~/Comments:/g;
		$text = '' if $text =~/Signature.*/g;
		$text = '' if $text =~/Date Signed.*/g;
	 #print $text;
	print $fh $text."\n";
	
}
close $fh;

$document->Save;
$document->Close;


my ($fhr,$efw,$afi,$edd,%Clinical_data,$trimester);
my (@BPD,@HC,@AC,@FL,@EFW);

    open(FILE,  $ob_report_file) or die "Can't open `$ob_report_file': $!";
	open(my $out_fh, '+> :encoding(UTF-8)', "$report_refined_file") or die "Could not open file '$report_refined_file' $!";

		while ( my $line = <FILE> ) 
		{			
		chomp;
		
			#2D Measurements
			if ( $line =~ /^BPD\s+/ ) {
				for (1 .. 4)
				{
			push (@BPD, scalar <FILE> );
				}		
			}			
			
			if ( $line =~ /^HC\s+/ ) {
				for (1 .. 4)
				{
			push (@HC, scalar <FILE> );
				}		
			}			
			
			if ( $line =~ /^AC\s+/ ) {
				for (1 .. 4)
				{
			push (@AC, scalar <FILE> );
				}		
			}						
			
			if ( $line =~ /^FL\s+/ ) {
				for (1 .. 4)
				{
			push (@FL, scalar <FILE> );
				}		
			}
			
			
		$efw =  scalar <FILE> if ( $line =~ /^Hadlock\(AC\,/ ) ;
		$fhr = $line if ( $line =~ /^FHR/ ) ;
		$afi = $line if ( $line =~ /^AFI:/ ) ;	
		if ($line =~ /^LMP:/) 
		{
			%Clinical_data = split(/\s+/, $line);
			#print Dumper(\%Clinical_data);
			#print $Clinical_data{'LMP:'};
			
			
		}
		
			
		
			
		}


$efw =~ s/[\n\r]//g;
$fhr =~ s/[\n\r]//g;
$afi =~ s/[\n\r]//g;




my $comments = <<'EOF';
  
COMMENTS:  

Single live intrauterine pregnancy
Presentation is  CEPHALIC
Fatal movements and cardiac activity are noted. 

  
EOF

print $out_fh $comments;
print $out_fh $fhr."\n" ;


#Option 1 for constructing the table
use utf8;
use Text::Table ();
binmode STDOUT, ':utf8';
 
my @cols = qw/Fetal_Biometry  Diameter(cms) Growth(%) Gestational_Age/;
my $sep  = \'│';
 
my $major_sep = \'║';
my $tb        = Text::Table->new( $sep,
    ( map { +( " $_ ", $sep ) } @cols ) );
 
my $num_cols = @cols;

my @BPD = qw(BPD 2.44cm 35.57% 14w1d);
my @HCD = qw(HCD 9.08cm 20.90% 14w1d);


 $tb->load( [@BPD] );
 $tb->load( [@HCD] );

 
 
my $make_rule = sub {
    my ($args) = @_;
 
    my $left      = $args->{left};
    my $right     = $args->{right};
    my $main_left = $args->{main_left};
    my $middle    = $args->{middle};
 
    return $tb->rule(
        sub {
            my ( $index, $len ) = @_;
 
            return ( '─' x $len );
        },
        sub {
            my ( $index, $len ) = @_;
 
            my $char = (
                  ( $index == 0 )             ? $left
                : ( $index == 1 )             ? $middle
                : ( $index == $num_cols + 1 ) ? $right
                :                               $middle
            );
 
            return $char x $len;
        },
    );
};
 
my $start_rule = $make_rule->(
    {
        left      => '┌',
        main_left => '╥',
        right     => '┐',
        middle    => '┬',
    }
);
 
my $mid_rule = $make_rule->(
    {
        left      => '├',
        main_left => '╫',
        right     => '┤',
        middle    => '┼',
    }
);
 
my $end_rule = $make_rule->(
    {
        left      => '└',
        main_left => '╨',
        right     => '┘',
        middle    => '┴',
    }
);
 
print $out_fh ($start_rule, $tb->title,
    ( map { $mid_rule, $_, } $tb->body() ), $end_rule);



#Option 2 for constructing the table

select $out_fh; 

my($bpd_name,$bpd_cms,$bpd_percent,$bpd_ga);
my($hc_name,$hc_cms,$hc_percent,$hc_ga);
my($ac_name,$ac_cms,$ac_percent,$ac_ga);
my($fl_name,$fl_cms,$fl_percent,$fl_ga);

# header
print <<EOF;

+-----------------------+--------------------+-----------------+--------------------------+
| Fetal Biometry  | Diameter(cms)| Growth(%)  | Gestational Age  |
+-----------------------+--------------------+-----------------+--------------------------+
EOF

format bpd_measurements =
@<@||||||||||||@<@||||||||||@<@|||||||||@<@|||||||||||||@< 
'|', $bpd_name, '|', $bpd_cms, '|', $bpd_percent, '|', $bpd_ga, '|'
.

$~ = 'bpd_measurements';

   $bpd_name="BPD";	
   $bpd_cms = $BPD[1];
   $bpd_percent = $BPD[2];
   $bpd_ga = $BPD[3];
   write;

format hc_measurements =
@<@||||||||||||@<@||||||||||@<@|||||||||@<@|||||||||||||@< 
'|', $hc_name, '|', $hc_cms, '|', $hc_percent, '|', $hc_ga, '|'
.

$~ = 'hc_measurements';

	$hc_name="HC";
   $hc_cms = $HC[1];
   $hc_percent = $HC[2];
   $hc_ga = $HC[3];
   write;
   
format al_measurements =
@<@||||||||||||@<@||||||||||@<@|||||||||@<@|||||||||||||@< 
'|', $ac_name, '|', $ac_cms, '|', $ac_percent, '|', $ac_ga, '|'
.

$~ = 'al_measurements';

	$ac_name="AC";
   $ac_cms = $AC[1];
   $ac_percent = $AC[2];
   $ac_ga = $AC[3];
   write;   

format fl_measurements =
@<@|||||||||||||@<@||||||||||@<@|||||||||@<@|||||||||||||@<  
'|', $fl_name , '|', $fl_cms, '|', $fl_percent, '|', $fl_ga, '|'
.

$~ = 'fl_measurements';


	$fl_name="FL";
   $fl_cms = $FL[1];
   $fl_percent = $FL[2];
   $fl_ga = $FL[3];
   write;




# footer
print "+-----------------------+--------------------+-----------------+--------------------------+\n";



print $out_fh "EFW ~ ±  $efw.\n"; 
print $out_fh "Liquor volume is ADEQUATE (" .$afi .')'; 

$bpd_ga =~ s/[\n\r]//g;

my $ob3_comments = <<"EOF";


Placenta is noted ANTERIOR   Grade- III   
Internal os is closed
No obvious gross fatal anomalies seen*

IMPRESSION:
-------------------
 
	* SINGLE LIVE INTRAUTERINE PREGNANCY OF $bpd_ga GESTATION.
	* PRESENTATION : CEPHALIC
	* PLACENTA :ANTERIOR
	* LIQUOR :ADEQUATE
	* NO EVIDENCE OF CORD AROUND THE NECK
	* ESTIMATED DELIVERY DATE $Clinical_data{'LMP:'}
                       

-------------------------------------------------------------
Limitations of Obstetrics ultrasound scanning :
-------------------------------------------------------------
*Although a structural screening scan is undertaken, detection of structural anomalies will never be 100%. Detection rates vary and may be reduced by factors like maternal obesity, abdominal scars, gestation age, inappropriate fetal position and reduced amniotic fluid volume. Even in the best of hands, a small percentage of fetal anomalies will remain undetected. Internationally accepted detection rate of major abnormalities is around 70%. As this is a level I obstetric scan center. To the extent visualized no gross sonographically congenital anomalies could be detected in the present study and fetal position. However not all anomalies could be rule out. To rule out cardiac anomalies fetal echo is suggested. Sometimes fetal parts could not be seen in advanced stage of pregnancy and due to poor or inadequate acoustic window. Sometimes not all four limbs can be clearly visualized due fetal position and acoustic window. This has been clearly explained to the patient.







		Signature(seal):	 	    				Date Signed:  
						
						
----------------------------------------------------------------THANK YOU!!!----------------------------------------------------
EOF

print $out_fh $ob3_comments;

close FILE;
close $out_fh;
$document->close;

	my $source_doc = $report_refined_file;
	my $dest_doc   = $document_name;
	
	use Win32::OLE::Const 'Microsoft Word';
	Win32::OLE->Option (CP => Win32::OLE::CP_UTF8);
	binmode STDOUT, 'encoding(utf8)';
	use Win32::OLE::Const 'Microsoft Office [0-9.]+ Object Library';
    use constant msoEncodingUTF8 => 65001;
	
	
	my $Word = new Win32::OLE 'Word.Application', 'Quit';

    $Word->Documents->open( $source_doc )
      or die "Unable to open $source_doc ", Win32::OLE->LastError();
    my $text = $Word->ActiveDocument->Content->Text;
    $Word->ActiveDocument->Close;

    $Word->Documents->open( $dest_doc )
      or die "Unable to open $dest_doc ", Win32::OLE->LastError();
	 my $dest_text = $Word->ActiveDocument->Content->Text; 
    $Word->ActiveDocument->Content->InsertAfter({ Text => $text });
    $Word->ActiveDocument->Close;

	

#$Word->Documents->save;

$Word->Documents->Save({
    FileName => $dest_doc,
    FileFormat => wdFormatEncodedText,
    Encoding => msoEncodingUTF8
    });

$Word->Documents->close;

• Win32::OLE merge rtf files - table structure missing by perl kamal
• Re: Win32::OLE merge rtf files - table structure missing by perl kamal
• Re: Win32::OLE merge rtf files - table structure missing by Mike
• Fwd: Win32::OLE merge rtf files - table structure missing by perl kamal
• Re: Fwd: Win32::OLE merge rtf files - table structure missing by Mike
• Re: Fwd: Win32::OLE merge rtf files - table structure missing by perl kamal