Monday, February 11, 2013

Generating a Word document with Perl and Win32::OLE

I'm about to have to throw this particular bit of code away, as I'm not able to get this to work from Scheduled Tasks on Windows 7.  Before I sent it to the bit bucket, however, I thought I'd post it here with the hope that someone will find it useful.



# Expects arguments as a hashref with the keys:
# # log_date: Date of the log
# # data: an arrayref of arrayrefs.  First line is treated as column headings, following lines are treated as data.
#
# A double horizontal rule will be added between the column headings and the data.
#
# NB: The reason that everything gets its own object (e.g. "my $tables = $doc->Tables; my $table = $tables->Add(...);")
# is not (neccessarily) for "Law of Demeter" reasons, but rather MS recommended practice when
# automating Office applications from Visual Studio (and by extension, OLE): http://support.microsoft.com/kb/317109
# Experimentally, I have noticed instances of the Word executable remaining in memory after program exit;
# refactoring the code in this way is an attempt to deal with that issue.
# 11 Feb 2013 KP
sub _print_with_word {
    my $args = shift;

    if ( ref $args ne q/HASH/ ) {
        croak(
            sprintf q/Usage: %s /,
            ( caller 0 )[$FUNCTION_NAME_POSITION]
        );
    }
    foreach my $required_key (qw/log_date data/) {
        if ( !$args->{$required_key} ) {
            croak(qq/Missing required key '$required_key' in args/);
        }
    }

    my $header = _slurp_file( $CONFIG->{'_'}{'header_file'} );
    my $footer = _slurp_file( $CONFIG->{'_'}{'footer_file'} );

    my @rows = @{ $args->{'data'} };

    my $word   = Win32::OLE->new( 'Word.Application', 'Quit' );
    _debug(q/Created new Word object/);

    my $doc    = $word->Documents->Add();
    _debug(q/Added new document/);

    my $selection = $word->Selection;
    _debug(q/Got Selection instance/);    

    
    my $selection_paragraph_format = $selection->ParagraphFormat;
    _debug(q/Got ParagraphFormat instance for selection/);
    
    $selection_paragraph_format->{'SpaceAfter'} = 0;
    _debug(q/Set paragraph spacing for header/);
    
    $selection->TypeText( { 'Text' => qq/$header\n\n/, } );
    _debug(q/Typing header into selection/);
    
    $selection->BoldRun();
    _debug(q/started bold run/);
    
    $selection_paragraph_format->{'Alignment'} = wdAlignParagraphRight;
    _debug(q/Set date paragraph format to right/);
    
    $selection->TypeText(
        {
            'Text' => Time::Piece->strptime(
                $args->{'log_date'}, q|%m/%d/%Y %H:%M:%S|
              )->strftime(qq/%A %B %d %Y\n\n/)
        }
    );
    _debug(q/Typing date header into selection/);
    
    $selection->BoldRun();
    _debug(q/End bold run/);

    my $range  = $selection->Range;
    _debug(q/Got Range instance from selection/);
    
    my $tables = $doc->Tables;
    _debug(q/Got Tables collection from document/);
    
    my $table  = $tables->Add( $range, scalar @rows, scalar @{ $rows[0] } );
    _debug(q/Added new table to document/);
    
    for my $rownum ( 0 .. $#rows ) {
        my $cols = $rows[$rownum];
        for my $colnum ( 0 .. $#{ $rows[$rownum] } ) {
            my @cellpos    = ( $rownum + 1, $colnum + 1 );
            my $cell       = $table->Cell(@cellpos);
            _debug(qq/Got cell at ($cellpos[0], $cellpos[1]) /);
            
            my $cell_range = $cell->Range;
            _debug(qq/Got Range instance for cell at ($cellpos[0], $cellpos[1])/);
            
            $cell_range->{'Text'} = $cols->[$colnum];
            _debug(qq/Set text of Range for cell at ($cellpos[0], $cellpos[1]) to "$cols->[$colnum]"/);
        }
    }
    my $rows                 = $table->Rows;
    _debug(q/Got Rows collection from table/);
    
    my $first_row            = $rows->First;
    _debug(q/Got first Row object (header row) from Rows collection/);
    
    my $first_row_range      = $rows->First->Range;
    _debug(q/Got Range instance for header row/);
    
    my $first_row_range_font = $first_row_range->Font;
    _debug(q/Got Font instance for header row Range/);
    
    $first_row_range_font->{'Bold'} = 1;
    _debug(q/Set header row Range Font to bold/);
    
    my $first_row_range_paragraph_format = $first_row_range->ParagraphFormat;
    _debug(q/Got ParagraphFormat instance for header row/);
    
    $first_row_range_paragraph_format->{'Alignment'} = wdAlignParagraphCenter;
    _debug(q/Set alignment for table headers to center/);
    
    my $first_row_bottom_border = $first_row->Borders(wdBorderBottom);
    _debug(q/Got Border instance for bottom of header row/);
    
    @{$first_row_bottom_border}{qw/LineStyle LineWidth/} =
      ( wdLineStyleDouble, wdLineWidth100pt );
    _debug(q/Set bottom border of header row to 10 pt double line/);
      
    my $paragraphs            = $doc->Paragraphs;
    _debug(q/Got Paragraphs collection from document/);
    
    my $last_paragraph        = $paragraphs->Last;
    _debug(q/Got last paragraph from document/);
    
    my $last_paragraph_format = $last_paragraph->Format;
    _debug(q/Got Format instance for last paragraph/);
    
    $last_paragraph_format->{'Alignment'}  = wdAlignParagraphLeft;
    _debug(q/Set last paragraph alignment to left/);
    
    $last_paragraph_format->{'SpaceAfter'} = 0;
    _debug(q/Set spacing on last paragraph/);
    
    my $last_paragraph_range = $last_paragraph->Range;
    _debug(q/Got Range instance for last paragraph/);
    
    $last_paragraph_range->InsertAfter( { 'Text' => qq/\n$footer/ } );
    _debug(q/Inserting footer after last paragraph range/);
    
    #$doc->SaveAs( { 'Filename' => Cwd::getcwd . '/test.doc' } );
    
    $doc->PrintOut();
    _debug(q/Printed document/);
    
    $doc->Close( { 'SaveChanges' => wdDoNotSaveChanges } );
    _debug(q/Close document without saving/);
    
    $word->Quit();
    _debug(q/Quit Word/);
    
    return 1;
}

No comments: