File Coverage

lib/Win32/PowerPoint.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

package Win32::PowerPoint;

use strict;
use warnings;
use Carp;
use base qw( Class::Accessor::Fast );

our $VERSION = '0.09';

use File::Spec;
use File::Basename;
use Win32::OLE;
use Win32::PowerPoint::Constants;
use Win32::PowerPoint::Utils qw(
  RGB
  canonical_alignment
  canonical_pattern
  canonical_datetime
  convert_cygwin_path
  _defined_or
);

__PACKAGE__->mk_ro_accessors( qw( c application presentation slide ) );

sub new {
  my $class = shift;
  my $self  = bless {
    c            => Win32::PowerPoint::Constants->new,
    was_invoked  => 0,
    application  => undef,
    presentation => undef,
    slide        => undef,
  }, $class;

  $self->connect_or_invoke;

  return $self;
}

##### application #####

sub connect_or_invoke {
  my $self = shift;

  $self->{application} = Win32::OLE->GetActiveObject('PowerPoint.Application');

  unless (defined $self->{application}) {
    $self->{application} = Win32::OLE->new('PowerPoint.Application')
      or die Win32::OLE->LastError;
    $self->{was_invoked} = 1;
  }
}

sub quit {
  my $self = shift;

  return unless $self->application;

  $self->application->Quit;
  $self->{application} = undef;
}

##### presentation #####

sub new_presentation {
  my $self = shift;

  return unless $self->{application};

  my %options = ( @_ == 1 and ref $_[0] eq 'HASH' ) ? %{ $_[0] } : @_;

  $self->{slide} = undef;

  $self->{presentation} = $self->application->Presentations->Add
    or die Win32::OLE->LastError;

  $self->_apply_background(
    $self->presentation->SlideMaster->Background->Fill,
    %options
  );
}

sub _apply_background {
  my ($self, $target, %options) = @_;

  my $forecolor = _defined_or(
    $options{background_forecolor},
    $options{masterbkgforecolor}
  );
  if ( defined $forecolor ) {
    $target->ForeColor->{RGB} = RGB($forecolor);
    $self->slide->{FollowMasterBackground} = $self->c->msoFalse if $options{slide};
  }

  my $backcolor = _defined_or(
    $options{background_backcolor},
    $options{masterbkgbackcolor}
  );
  if ( defined $backcolor ) {
    $target->BackColor->{RGB} = RGB($backcolor);
    $self->slide->{FollowMasterBackground} = $self->c->msoFalse if $options{slide};
  }

  if ( defined $options{pattern} ) {
    if ( $options{pattern} =~ /\D/ ) {
      my $method = canonical_pattern($options{pattern});
      $options{pattern} = $self->c->$method;
    }
    $target->Patterned( $options{pattern} );
  }
}

sub save_presentation {
  my ($self, $file) = @_;

  return unless $self->presentation;
  return unless defined $file;

  my $absfile   = File::Spec->rel2abs($file);
  my $directory = dirname( $file );
  unless (-d $directory) {
    require File::Path;
    File::Path::mkpath($directory);
  }

  $self->presentation->SaveAs( convert_cygwin_path( $absfile ) );
}

sub close_presentation {
  my $self = shift;

  return unless $self->presentation;

  $self->presentation->Close;
  $self->{presentation} = undef;
}

sub set_master_footer {
  my $self = shift;

  return unless $self->presentation;
  my $master_footers = $self->presentation->SlideMaster;
  $self->_set_footer($master_footers, @_);
}

sub _set_footer {
  my ($self, $slide, @args) = @_;

  my $target = $slide->HeadersFooters;

  my %options = ( @args == 1 and ref $args[0] eq 'HASH' ) ? %{ $args[0] } : @args;

  if ( defined $options{visible} ) {
    $target->Footer->{Visible} = $options{visible} ? $self->c->msoTrue : $self->c->msoFalse;
  }

  if ( defined $options{text} ) {
    $target->Footer->{Text} = $options{text};
  }

  if ( defined $options{slide_number} ) {
    $target->SlideNumber->{Visible} = $options{slide_number} ? $self->c->msoTrue : $self->c->msoFalse;
  }

  if ( defined $options{datetime} ) {
    $target->DateAndTime->{Visible} = $options{datetime} ? $self->c->msoTrue : $self->c->msoFalse;
  }

  if ( defined $options{datetime_format} ) {
    if ( !$options{datetime_format} ) {
      $target->DateAndTime->{UseFormat} = $self->c->msoFalse;
    }
    else {
      if ( $options{datetime_format} =~ /\D/ ) {
        my $format = canonical_datetime($options{datetime_format});
        $options{datetime_format} = $self->c->$format;
      }
      $target->DateAndTime->{UseFormat} = $self->c->msoTrue;
      $target->DateAndTime->{Format}    = $options{datetime_format};
    }
  }
}

##### slide #####

sub new_slide {
  my $self = shift;

  my %options = ( @_ == 1 and ref $_[0] eq 'HASH' ) ? %{ $_[0] } : @_;

  $self->{slide} = $self->presentation->Slides->Add(
    $self->presentation->Slides->Count + 1,
    $self->c->LayoutBlank
  ) or die Win32::OLE->LastError;

  $self->_apply_background(
    $self->slide->Background->Fill,
    %options,
    slide => 1,
  );
}

sub set_footer {
  my $self = shift;

  return unless $self->slide;
  $self->_set_footer($self->slide, @_);
}

sub add_text {
  my ($self, $text, $options) = @_;

  return unless $self->slide;
  return unless defined $text;

  $options = {} unless ref $options eq 'HASH';

  $text =~ s/\n/\r/gs;

  my $num_of_boxes = $self->slide->Shapes->Count;
  my $last  = $num_of_boxes ? $self->slide->Shapes($num_of_boxes) : undef;
  my ($left, $top, $width, $height);
  if ($last) {
    $left   = _defined_or($options->{left},   $last->Left);
    $top    = _defined_or($options->{top},    $last->Top + $last->Height + 20);
    $width  = _defined_or($options->{width},  $last->Width);
    $height = _defined_or($options->{height}, $last->Height);
  }
  else {
    $left   = _defined_or($options->{left},   30);
    $top    = _defined_or($options->{top},    30);
    $width  = _defined_or($options->{width},  600);
    $height = _defined_or($options->{height}, 200);
  }

  my $new_textbox = $self->slide->Shapes->AddTextbox(
    $self->c->TextOrientationHorizontal,
    $left, $top, $width, $height
  );

  my $frame = $new_textbox->TextFrame;
  my $range = $frame->TextRange;

  $frame->{WordWrap} = $self->c->True;
  $range->ParagraphFormat->{FarEastLineBreakControl} = $self->c->True;
  $range->{Text} = $text;

  $self->decorate_range( $range, $options );

  $frame->{AutoSize} = $self->c->AutoSizeNone;
  $frame->{AutoSize} = $self->c->AutoSizeShapeToFitText;

  return $new_textbox;
}

sub add_picture {
  my ($self, $file, $options) = @_;

  return unless $self->slide;
  return unless defined $file and -f $file;

  $options = {} unless ref $options eq 'HASH';

  my $num_of_boxes = $self->slide->Shapes->Count;
  my $last  = $num_of_boxes ? $self->slide->Shapes($num_of_boxes) : undef;
  my ($left, $top);
  if ($last) {
    $left   = _defined_or($options->{left}, $last->Left);
    $top    = _defined_or($options->{top},  $last->Top + $last->Height + 20);
  }
  else {
    $left   = _defined_or($options->{left}, 30);
    $top    = _defined_or($options->{top},  30);
  }

  my $new_picture = $self->slide->Shapes->AddPicture(
    convert_cygwin_path( $file ),
    ( $options->{link}
      ? ( $self->c->msoTrue,  $self->c->msoFalse )
      : ( $self->c->msoFalse, $self->c->msoTrue )
    ),
    $left, $top, $options->{width}, $options->{height}
  );

  return $new_picture;
}

sub insert_before {
  my ($self, $text, $options) = @_;

  return unless $self->slide;
  return unless defined $text;

  $options = {} unless ref $options eq 'HASH';

  $text =~ s/\n/\r/gs;

  my $num_of_boxes = $self->slide->Shapes->Count;
  my $last  = $num_of_boxes ? $self->slide->Shapes($num_of_boxes) : undef;
  my $range = $self->slide->Shapes($num_of_boxes)->TextFrame->TextRange;

  my $selection = $range->InsertBefore($text);

  $self->decorate_range( $selection, $options );

  return $selection;
}

sub insert_after {
  my ($self, $text, $options) = @_;

  return unless $self->slide;
  return unless defined $text;

  $options = {} unless ref $options eq 'HASH';

  $text =~ s/\n/\r/gs;

  my $num_of_boxes = $self->slide->Shapes->Count;
  my $last  = $num_of_boxes ? $self->slide->Shapes($num_of_boxes) : undef;
  my $range = $self->{slide}->Shapes($num_of_boxes)->TextFrame->TextRange;

  my $selection = $range->InsertAfter($text);

  $self->decorate_range( $selection, $options );

  return $selection;
}

sub decorate_range {
  my ($self, $range, $options) = @_;

  return unless defined $range;

  $options = {} unless ref $options eq 'HASH';

  my ($true, $false) = ($self->c->True, $self->c->False);

  $range->Font->{Bold}        = $options->{bold}        ? $true : $false;
  $range->Font->{Italic}      = $options->{italic}      ? $true : $false;
  $range->Font->{Underline}   = $options->{underline}   ? $true : $false;
  $range->Font->{Shadow}      = $options->{shadow}      ? $true : $false;
  $range->Font->{Subscript}   = $options->{subscript}   ? $true : $false;
  $range->Font->{Superscript} = $options->{superscript} ? $true : $false;
  $range->Font->{Size}        = $options->{size}       if $options->{size};
  $range->Font->{Name}        = $options->{name}       if $options->{name};
  $range->Font->{Name}        = $options->{font}       if $options->{font};
  $range->Font->Color->{RGB}  = RGB($options->{color}) if $options->{color};

  my $align = $options->{alignment} || $options->{align} || 'left';
  if ( $align =~ /\D/ ) {
    my $method = canonical_alignment( $align );
    $align = $self->c->$method;
  }
  $range->ParagraphFormat->{Alignment} = $align;

  $range->ActionSettings(
    $self->c->MouseClick
  )->Hyperlink->{Address} = $options->{link} if $options->{link};
}

sub DESTROY {
  my $self = shift;

  $self->quit if $self->{was_invoked};
}

1;
__END__