perl简化制作PPT

如果你需做的ppt也是一行标题，一段正文;或一行标题，一张图片。可以使用本代码来简化工作。

使用：

__DATA__
=> 标题1
  正文......段落1结束
=> 图片标题1
  1.jpg

...

说明：

=> 表示标题，为正文；=>为图片标题，为图片名，并保证图片与代码放于同一文件夹。

 

注：本代码依赖模块有Win32::PowerPoint、Moo、Sub::Quote、Class::Accessor::Fast与Cwd，请自行安装。

package PPT;
#use Acme::PerlTidy;
use Moo;
use Sub::Quote;

#但凡调用方法为：$self->{ppt}->方法()的，均是调用的Win32::PowerPoint类的方法
use base qw( Class::Accessor::Fast );
__PACKAGE__->mk_ro_accessors(qw(ppt));

#属性T_bold、B_bold为布尔值，分别用来设置标题（Title）与正文（Body）是否为粗体
#属性T_FN、B_FN分别用来设置标题（Title_Font_Name）与正文（Body_Font_Name）的字体，例子中为“楷体_GB2312”
#属性T_FS、B_FS分别用来设置标题（Title_Font_Size）与正文（Body_Font_Size）的字体大小
has T_bold => ( is => 'rw' );
has T_FN => ( is => 'rw' );
has T_FS => (
    is => 'rw',
    isa => quote_sub q{ die "字体太大了" unless $_[0] =~ /^\d{1,2}$/ }
);
has B_bold => ( is => 'rw', );
has B_FN => ( is => 'rw' );
has B_FS => (
    is => 'rw',
    isa => quote_sub q{ die "字体太大了" unless $_[0] =~ /^\d{1,2}$/ }
);

sub AddBody {
    my ( $self, $text_T, $text_B ) = @_;

    #检测是否已存在Win32::PowerPoint，无的话实例化Win32::PowerPoint。
    if ( !$self->{ppt} ) {
        $self->_win32ppt();
    }

#new_slidet()为Win32::PowerPoint类的方法，用于新建一个幻灯片，详见Win32::PowerPoint文档
    $self->{ppt}->new_slide;
    $self->_addTitle($text_T);

 #add_text()为Win32::PowerPoint类的方法，用于写入文字，详见Win32::PowerPoint文档
    $self->{ppt}->add_text(
        $text_B,
        {
            left => 5,
            top => 100,
            width => 710,
            height => 150,
            size => $self->B_FS,
            bold => $self->B_bold,
            name => $self->B_FN
        }
    );
}

sub AddPicture {
    my ( $self, $text_T, $picture ) = @_;
    if ( !$self->{ppt} ) {
        $self->_win32ppt();
    }
    $self->{ppt}->new_slide;
    $self->_addTitle($text_T);

#add_picture()为Win32::PowerPoint类的方法，用于添加图片，详见Win32::PowerPoint文档
    $self->{ppt}->add_picture( $picture,
        { left => 10, top => 100, width => 700, height => 300, link => 0 } );
}

sub _win32ppt {
    require Win32::PowerPoint;
    my $self = shift;
    $self->{ppt} = Win32::PowerPoint->new;
    $self->{ppt}->new_presentation(
        background_forecolor => [ 255, 255, 255 ],
        background_backcolor => 'RGB(255,255,255)',
    );
}

sub _addTitle {
    my ( $self, $text_T ) = @_;
    $self->{ppt}->add_text(
        $text_T,
        {
            left => 0,
            top => 50,
            width => 680,
            height => 50,
            size => $self->T_FS,
            bold => $self->T_bold,
            name => $self->T_FN
        }
    );
}

sub SaveQuit {
    my ( $self, $name ) = @_;
    $self->{ppt}->save_presentation($name);
    $self->{ppt}->close_presentation;
}

package main;
use Cwd;
my $dir = Cwd::getcwd();
my $ppt = new PPT(
    T_FN => '楷体_GB2312',
    T_FS => 28,
    T_bold => 1,
    B_FN => '楷体_GB2312',
    B_FS => 24,
    B_bold => 0
);

{

    #以=>作为换行符
    local $/ = '=>';
    while ( my $data = <DATA> ) {
        my ( %hash, $temp, %rethash );

        #=><BT> 标题1
        # <BB> 正文......段落1结束
        #$hash{BT}=标题1;$hash{BB}=正文......段落1结束
        while ( $data =~ /<(\w{2})>(.*)/g ) {
            $hash{$1} = $2;
        }
        my @arr = grep { /(\w)\1/ } keys %hash;

        #$temp=BB;
        $temp = $arr[0];

#根据%hash改变散列结构，生成%rethash，$rethash{BB}{BT} = 标题1，$rethash{BB}{BB} = 正文......段落1结束
        for my $key ( keys %hash ) {
            $rethash{$temp}{$key} = $hash{$key};
        }

        for my $retkey ( keys %rethash ) {
            if ( $retkey eq 'BB' ) {
                $ppt->AddBody( $rethash{'BB'}{'BT'}, $rethash{'BB'}{'BB'} );
            }
            elsif ( $retkey eq 'PP' ) {
                my $picture = $rethash{'PP'}{'PP'};
                $picture =~ s/\s*//g;
                my $picpath = $dir . '/' . $picture;
                $ppt->AddPicture( $rethash{'PP'}{'PT'}, $picpath );
            }

        }

    }
}
$ppt->SaveQuit('报告.ppt');

__DATA__
=><BT> 标题1
  <BB> 正文......段落1结束
=><PT> 图片标题1
  <PP> 1.jpg
=><BT> 标题2
  <BB> 正文......段落2结束
=><PT> 图片标题2
  <PP> 2.png