File Coverage

lib/Win32/PowerPoint.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             package Win32::PowerPoint;
2              
3 1     1   672 use strict;
  1         1  
  1         30  
4 1     1   4 use warnings;
  1         1  
  1         23  
5 1     1   3 use Carp;
  1         1  
  1         58  
6              
7             our $VERSION = '0.10';
8              
9 1     1   4 use File::Spec;
  1         1  
  1         19  
10 1     1   4 use File::Basename;
  1         1  
  1         52  
11 1     1   217 use Win32::OLE;
  0            
  0            
12             use Win32::PowerPoint::Constants;
13             use Win32::PowerPoint::Utils qw(
14             RGB
15             canonical_alignment
16             canonical_pattern
17             canonical_datetime
18             convert_cygwin_path
19             _defined_or
20             );
21              
22             sub new {
23             my $class = shift;
24             my $self = bless {
25             c => Win32::PowerPoint::Constants->new,
26             was_invoked => 0,
27             application => undef,
28             presentation => undef,
29             slide => undef,
30             }, $class;
31              
32             $self->connect_or_invoke;
33              
34             return $self;
35             }
36              
37             sub c { shift->{c} }
38              
39             ##### application #####
40              
41             sub application { shift->{application} }
42              
43             sub connect_or_invoke {
44             my $self = shift;
45              
46             $self->{application} = Win32::OLE->GetActiveObject('PowerPoint.Application');
47              
48             unless (defined $self->{application}) {
49             $self->{application} = Win32::OLE->new('PowerPoint.Application')
50             or die Win32::OLE->LastError;
51             $self->{was_invoked} = 1;
52             }
53             }
54              
55             sub quit {
56             my $self = shift;
57              
58             return unless $self->application;
59              
60             $self->application->Quit;
61             $self->{application} = undef;
62             }
63              
64             ##### presentation #####
65              
66             sub new_presentation {
67             my $self = shift;
68              
69             return unless $self->{application};
70              
71             my %options = ( @_ == 1 and ref $_[0] eq 'HASH' ) ? %{ $_[0] } : @_;
72              
73             $self->{slide} = undef;
74              
75             $self->{presentation} = $self->application->Presentations->Add
76             or die Win32::OLE->LastError;
77              
78             $self->_apply_background(
79             $self->presentation->SlideMaster->Background->Fill,
80             %options
81             );
82             }
83              
84             sub presentation {
85             my $self = shift;
86              
87             return unless $self->{application};
88              
89             $self->{presentation} ||= $self->application->ActivePresentation
90             or die Win32::OLE->LastError;
91             }
92              
93             sub _apply_background {
94             my ($self, $target, %options) = @_;
95              
96             my $forecolor = _defined_or(
97             $options{background_forecolor},
98             $options{masterbkgforecolor}
99             );
100             if ( defined $forecolor ) {
101             $target->ForeColor->{RGB} = RGB($forecolor);
102             $self->slide->{FollowMasterBackground} = $self->c->msoFalse if $options{slide};
103             }
104              
105             my $backcolor = _defined_or(
106             $options{background_backcolor},
107             $options{masterbkgbackcolor}
108             );
109             if ( defined $backcolor ) {
110             $target->BackColor->{RGB} = RGB($backcolor);
111             $self->slide->{FollowMasterBackground} = $self->c->msoFalse if $options{slide};
112             }
113              
114             if ( defined $options{pattern} ) {
115             if ( $options{pattern} =~ /\D/ ) {
116             my $method = canonical_pattern($options{pattern});
117             $options{pattern} = $self->c->$method;
118             }
119             $target->Patterned( $options{pattern} );
120             }
121             }
122              
123             sub save_presentation {
124             my ($self, $file) = @_;
125              
126             return unless $self->presentation;
127             return unless defined $file;
128              
129             my $absfile = File::Spec->rel2abs($file);
130             my $directory = dirname( $file );
131             unless (-d $directory) {
132             require File::Path;
133             File::Path::mkpath($directory);
134             }
135              
136             $self->presentation->SaveAs( convert_cygwin_path( $absfile ) );
137             }
138              
139             sub close_presentation {
140             my $self = shift;
141              
142             return unless $self->presentation;
143              
144             $self->presentation->Close;
145             $self->{presentation} = undef;
146             }
147              
148             sub set_master_footer {
149             my $self = shift;
150              
151             return unless $self->presentation;
152             my $master_footers = $self->presentation->SlideMaster;
153             $self->_set_footer($master_footers, @_);
154             }
155              
156             sub _set_footer {
157             my ($self, $slide, @args) = @_;
158              
159             my $target = $slide->HeadersFooters;
160              
161             my %options = ( @args == 1 and ref $args[0] eq 'HASH' ) ? %{ $args[0] } : @args;
162              
163             if ( defined $options{visible} ) {
164             $target->Footer->{Visible} = $options{visible} ? $self->c->msoTrue : $self->c->msoFalse;
165             }
166              
167             if ( defined $options{text} ) {
168             $target->Footer->{Text} = $options{text};
169             }
170              
171             if ( defined $options{slide_number} ) {
172             $target->SlideNumber->{Visible} = $options{slide_number} ? $self->c->msoTrue : $self->c->msoFalse;
173             }
174              
175             if ( defined $options{datetime} ) {
176             $target->DateAndTime->{Visible} = $options{datetime} ? $self->c->msoTrue : $self->c->msoFalse;
177             }
178              
179             if ( defined $options{datetime_format} ) {
180             if ( !$options{datetime_format} ) {
181             $target->DateAndTime->{UseFormat} = $self->c->msoFalse;
182             }
183             else {
184             if ( $options{datetime_format} =~ /\D/ ) {
185             my $format = canonical_datetime($options{datetime_format});
186             $options{datetime_format} = $self->c->$format;
187             }
188             $target->DateAndTime->{UseFormat} = $self->c->msoTrue;
189             $target->DateAndTime->{Format} = $options{datetime_format};
190             }
191             }
192             }
193              
194             ##### slide #####
195              
196             sub slide {
197             my ($self, $id) = @_;
198             if ($id) {
199             $self->{slide} = $self->presentation->Slides->Item($id)
200             or die Win32::OLE->LastError;
201             }
202             $self->{slide};
203             }
204              
205             sub new_slide {
206             my $self = shift;
207              
208             my %options = ( @_ == 1 and ref $_[0] eq 'HASH' ) ? %{ $_[0] } : @_;
209              
210             $self->{slide} = $self->presentation->Slides->Add(
211             $self->presentation->Slides->Count + 1,
212             $self->c->LayoutBlank
213             ) or die Win32::OLE->LastError;
214             $self->{last} = undef;
215              
216             $self->_apply_background(
217             $self->slide->Background->Fill,
218             %options,
219             slide => 1,
220             );
221             }
222              
223             sub set_footer {
224             my $self = shift;
225              
226             return unless $self->slide;
227             $self->_set_footer($self->slide, @_);
228             }
229              
230             sub add_text {
231             my ($self, $text, $options) = @_;
232              
233             return unless $self->slide;
234             return unless defined $text;
235              
236             $options = {} unless ref $options eq 'HASH';
237              
238             $text =~ s/\n/\r/gs;
239              
240             my ($left, $top, $width, $height);
241             if (my $last = $self->{last}) {
242             $left = _defined_or($options->{left}, $last->Left);
243             $top = _defined_or($options->{top}, $last->Top + $last->Height + 20);
244             $width = _defined_or($options->{width}, $last->Width);
245             $height = _defined_or($options->{height}, $last->Height);
246             }
247             else {
248             $left = _defined_or($options->{left}, 30);
249             $top = _defined_or($options->{top}, 30);
250             $width = _defined_or($options->{width}, 600);
251             $height = _defined_or($options->{height}, 200);
252             }
253              
254             my $new_textbox = $self->slide->Shapes->AddTextbox(
255             $self->c->TextOrientationHorizontal,
256             $left, $top, $width, $height
257             );
258              
259             my $frame = $new_textbox->TextFrame;
260             my $range = $frame->TextRange;
261              
262             $frame->{WordWrap} = $self->c->True;
263             $range->ParagraphFormat->{FarEastLineBreakControl} = $self->c->True;
264             $range->{Text} = $text;
265              
266             $self->decorate_range( $range, $options );
267              
268             $frame->{AutoSize} = $self->c->AutoSizeNone;
269             $frame->{AutoSize} = $self->c->AutoSizeShapeToFitText;
270              
271             $self->{last} = $new_textbox;
272              
273             return $new_textbox;
274             }
275              
276             sub add_picture {
277             my ($self, $file, $options) = @_;
278              
279             return unless $self->slide;
280             return unless defined $file and -f $file;
281              
282             $options = {} unless ref $options eq 'HASH';
283              
284             my ($left, $top);
285             if (my $last = $self->{last}) {
286             $left = _defined_or($options->{left}, $last->Left);
287             $top = _defined_or($options->{top}, $last->Top + $last->Height + 20);
288             }
289             else {
290             $left = _defined_or($options->{left}, 30);
291             $top = _defined_or($options->{top}, 30);
292             }
293              
294             my $new_picture = $self->slide->Shapes->AddPicture(
295             convert_cygwin_path( $file ),
296             ( $options->{link}
297             ? ( $self->c->msoTrue, $self->c->msoFalse )
298             : ( $self->c->msoFalse, $self->c->msoTrue )
299             ),
300             $left, $top, $options->{width}, $options->{height}
301             );
302              
303             $self->{last} = $new_picture;
304              
305             return $new_picture;
306             }
307              
308             sub insert_before {
309             my ($self, $text, $options) = @_;
310              
311             return unless $self->slide;
312             return unless defined $text;
313              
314             $options = {} unless ref $options eq 'HASH';
315              
316             $text =~ s/\n/\r/gs;
317              
318             my $num_of_boxes = $self->slide->Shapes->Count;
319             my $last = $num_of_boxes ? $self->slide->Shapes($num_of_boxes) : undef;
320             my $range = $self->slide->Shapes($num_of_boxes)->TextFrame->TextRange;
321              
322             my $selection = $range->InsertBefore($text);
323              
324             $self->decorate_range( $selection, $options );
325              
326             return $selection;
327             }
328              
329             sub insert_after {
330             my ($self, $text, $options) = @_;
331              
332             return unless $self->slide;
333             return unless defined $text;
334              
335             $options = {} unless ref $options eq 'HASH';
336              
337             $text =~ s/\n/\r/gs;
338              
339             my $num_of_boxes = $self->slide->Shapes->Count;
340             my $last = $num_of_boxes ? $self->slide->Shapes($num_of_boxes) : undef;
341             my $range = $self->{slide}->Shapes($num_of_boxes)->TextFrame->TextRange;
342              
343             my $selection = $range->InsertAfter($text);
344              
345             $self->decorate_range( $selection, $options );
346              
347             return $selection;
348             }
349              
350             sub decorate_range {
351             my ($self, $range, $options) = @_;
352              
353             return unless defined $range;
354              
355             $options = {} unless ref $options eq 'HASH';
356              
357             my ($true, $false) = ($self->c->True, $self->c->False);
358              
359             $range->Font->{Bold} = $options->{bold} ? $true : $false;
360             $range->Font->{Italic} = $options->{italic} ? $true : $false;
361             $range->Font->{Underline} = $options->{underline} ? $true : $false;
362             $range->Font->{Shadow} = $options->{shadow} ? $true : $false;
363             $range->Font->{Subscript} = $options->{subscript} ? $true : $false;
364             $range->Font->{Superscript} = $options->{superscript} ? $true : $false;
365             $range->Font->{Size} = $options->{size} if $options->{size};
366             $range->Font->{Name} = $options->{name} if $options->{name};
367             $range->Font->{Name} = $options->{font} if $options->{font};
368             $range->Font->Color->{RGB} = RGB($options->{color}) if $options->{color};
369              
370             my $align = $options->{alignment} || $options->{align} || 'left';
371             if ( $align =~ /\D/ ) {
372             my $method = canonical_alignment( $align );
373             $align = $self->c->$method;
374             }
375             $range->ParagraphFormat->{Alignment} = $align;
376              
377             $range->ActionSettings(
378             $self->c->MouseClick
379             )->Hyperlink->{Address} = $options->{link} if $options->{link};
380             }
381              
382             sub DESTROY {
383             my $self = shift;
384              
385             $self->quit if $self->{was_invoked};
386             }
387              
388             1;
389             __END__