File Coverage

blib/lib/OpenOffice/OOBuilder.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package OpenOffice::OOBuilder;

# Copyright 2004, 2007 Stefan Loones
# More info can be found at http://www.maygill.com/oobuilder
#
# This library is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

use 5.008;                   # lower versions not tested
use strict;
use warnings;
no warnings 'uninitialized';  # don't want this, because we use strict
use Archive::Zip;

my ($VERSION, %COLORS, $MINFONTSIZE, $MAXFONTSIZE);
$VERSION=sprintf("%d.%02d", q$Revision: 0.9 $ =~ /(\d+)\.(\d+)/);
%COLORS=('red' => 'ff0000', 'green' => '00ff00', 'blue' => '0000ff',
         'white' => 'ffffff', 'black' => '000000');
$MINFONTSIZE=6;
$MAXFONTSIZE=96;

# - Object constructor
#
sub new {
  my ($proto, $class, $self, $doctype);
  $proto=shift;
  $class=ref($proto) || $proto;
  $doctype=shift;
  $doctype='sxw' if (! $doctype);
  $self={};
  $self->{oooType}    = $doctype;
  $self->{contentxml} = undef;
  $self->{builddir}   = '.';
  $self->{tgt_file}   = 'oo_doc';
  $self->{meta}       = undef;
  $self->{log}        = 0;

  # - Init available fonts
  $self->{availfonts}{Arial}=q{};
  $self->{availfonts}{'Bitstream Vera Sans'}=q{};
  $self->{availfonts}{'Bitstream Vera Serif'}=q{};
  $self->{availfonts}{Bookman}=q{};
  $self->{availfonts}{Courier}=q{};
  $self->{availfonts}{'Courier 10 Pitch'}=q{};
  $self->{availfonts}{Helvetica}=q{};
  $self->{availfonts}{Lucidabright}=q{};
  $self->{availfonts}{Lucidasans}=q{};
  $self->{availfonts}{'Lucida Sans Unicode'}=q{};
  $self->{availfonts}{Lucidatypewriter}=q{};
  $self->{availfonts}{'Luxi Mono'}=q{};
  $self->{availfonts}{'Luxi Sans'}=q{};
  $self->{availfonts}{'Luxi Serif'}=q{};
  $self->{availfonts}{Symbol}=q{};
  $self->{availfonts}{Tahoma}=q{};
  $self->{availfonts}{Times}=q{};
  $self->{availfonts}{'Times New Roman'}=q{};
  $self->{availfonts}{Utopia}=q{};
  $self->{availfonts}{'Zapf Chancery'}=q{};
  $self->{availfonts}{'Zapf Dingbats'}=q{};

  $self->{style}{bold}     = 0;
  $self->{style}{italic}   = 0;
  $self->{style}{underline}= 0;
  $self->{style}{align}    = 'left';
  $self->{style}{txtcolor} = '000000';
  $self->{style}{bgcolor}  = 'ffffff';
  $self->{style}{font}     = 'Luxi Sans';
  $self->{style}{size}     = '10';

  $self->{actstyle}=join('#',($self->{style}{bold}, $self->{style}{italic},
                         $self->{style}{underline},$self->{style}{align},
                         $self->{style}{txtcolor},$self->{style}{bgcolor},
                         $self->{style}{font},$self->{style}{size}));
  $self->{defstyle}=$self->{actstyle};

  bless ($self, $class);
  return $self;
}   # - - End new (Object constructor)

# - * - Setters/Getters Meta.xml data

sub set_title {
  my $self=shift;
  $self->{meta}{title}=$self->encode_data (shift);
  1;
}

sub get_title {
  my $self=shift;
  return $self->{meta}{title};
}

sub set_author {
  my $self=shift;
  $self->{meta}{author}=$self->encode_data (shift);
  1;
}

sub get_author {
  my $self=shift;
  return $self->{meta}{author};
}

sub set_subject {
  my $self=shift;
  $self->{meta}{subject}=$self->encode_data (shift);
  1;
}

sub get_subject {
  my $self=shift;
  return $self->{meta}{subject};
}

sub set_comments {
  my $self=shift;
  $self->{meta}{comments}=$self->encode_data (shift);
  1;
}

sub get_comments {
  my $self=shift;
  return $self->{meta}{comments};
}

sub set_keywords {
  my ($self, @keywords)=@_;
  @{$self->{meta}{keywords}}=map $self->encode_data($_), @keywords;
  1;
}

sub push_keywords {
  my ($self, @keywords)=@_;
  push @{$self->{meta}{keywords}}, map $self->encode_data($_), @keywords;
  1;
}

sub get_keywords {
  my $self=shift;
  return @{$self->{meta}{keywords}};
}

sub set_meta {
  my ($self, $nb, $name, $value)=@_;
  if ($nb < 1 || $nb > 4 || ! $name) {
    return 0;
  } else {
    delete $self->{meta}{"data$nb"} if (exists ($self->{meta}{"data$nb"}));
    $name=$self->encode_data ($name);
    $name="meta$nb" if (! $name);
    $self->{meta}{"data$nb"}{$name}=$self->encode_data($value);
    1;
  }
}

# ** TODO get_meta : best way to return it: array, hash or ?

# - Setters for active style

# ** TODO getters for active style
# not yet implemented because in the future we will probably add
# ways to get the style of a specifique cell or location
# maybe we also add the possibility to read an existing document, and make
# changes to it. This all makes that we have to be careful about this.

sub set_bold {
  my ($self, $bold)=@_;
  if (! $bold) {
    $self->{style}{bold}=0;
  } else {
    $self->{style}{bold}=1;
  }
  $self->_set_active_style;
  1;
}

sub set_italic {
  my ($self, $italic)=@_;
  if (! $italic) {
    $self->{style}{italic}=0;
  } else {
    $self->{style}{italic}=1;
  }
  $self->_set_active_style;
  1;
}

sub set_underline {
  my ($self, $underline)=@_;
  if (! $underline) {
    $self->{style}{underline}=0;
  } else {
    $self->{style}{underline}=1;
  }
  $self->_set_active_style;
  1;
}

sub set_align {
  my ($self, $align)=@_;
  $align=lc($align);
  if ($align eq 'right' || $align eq 'center' || $align eq 'justify' ||
      $align eq 'left') {
    $self->{style}{align}=$align;
    $self->_set_active_style;
    return 1;
  } else {
    return 0;
  }
}

sub set_txtcolor {
  my ($self, $txtcolor)=@_;
  $txtcolor=$self->_check_color($txtcolor);
  return 0 unless ($txtcolor);
  $self->{style}{txtcolor}=$txtcolor;
  $self->_set_active_style;
  1;
}

sub set_bgcolor {
  my ($self, $bgcolor)=@_;
  $bgcolor=$self->_check_color($bgcolor);
  return 0 unless ($bgcolor);
  $self->{style}{bgcolor}=$bgcolor;
  $self->_set_active_style;
  1;
}

sub set_font {
  my ($self, $font)=@_;
  return 0 unless (exists($self->{availfonts}{$font}));
  $self->{style}{font}=$font;
  $self->_set_active_style;
  1;
}

sub set_fontsize {
  my ($self, $size)=@_;
  $size=~ s/[^0-9]//g;
  return 0 if ($size<$MINFONTSIZE || $size>$MAXFONTSIZE);
  $self->{style}{size}=$size;
  $self->_set_active_style;
  1;
}

 # - * - Build-directory

sub set_builddir {
  my ($self, $builddir)=@_;
  if (-d $builddir) {
    $self->{builddir}=$builddir;
    return 1;
  } else {
    return 0;
  }
}

sub get_builddir {
  my $self=shift;
  return $self->{builddir};
}

# - * - PrivateMethods
sub generate {
  my ($self, $tgtfile)=@_;

  # - check workdirectory & filename
  $self->{builddir}='.' unless (-d $self->{builddir});
  $tgtfile='oo_doc' unless ($tgtfile);
  $tgtfile.=qq{.$self->{oooType}};

  # - Available Document types and their mime types
  my (%mimetype);
  # Text - oowriter - sxw - OOWBuilder
  $mimetype{sxw}='application/vnd.sun.xml.writer';
  # Spreadsheet - oocalc - sxc - OOCBuilder
  $mimetype{sxc}='application/vnd.sun.xml.calc';
  # Drawing - oodraw - sxd - OODBuilder
  $mimetype{sxd}='application/vnd.sun.xml.draw';
  # Presentation - ooimpress - sxi - OOIBuilder
  $mimetype{sxi}='application/vnd.sun.xml.impress';
  # Formula - oomath - OOMBuilder
  $mimetype{sxm}='application/vnd.sun.xml.math';
# ** TODO
  # Chart            application/vnd.sun.xml.chart
  # Master Document  application/vnd.sun.xml.writer.global

  # - Generate mimetype.xml
  open TGT, qq{>$self->{builddir}/mimetype};
  print TGT $mimetype{$self->{oooType}};
  close TGT;

  # - Generate content.xml
  #   (must be build by the derived class and put into $self->{contentxml})
  open TGT, qq{>$self->{builddir}/content.xml};
  print TGT $self->{contentxml};
  close TGT;

  # - Generate meta.xml, styles.xml, settings.xml
  $self->_generate_meta;
  $self->_generate_styles;
  $self->_generate_settings;

  # - Generate Manifest
  mkdir(qq{$self->{builddir}/META-INF}) unless (-d qq{$self->{builddir}/META-INF});
  open TGT, qq{>$self->{builddir}/META-INF/manifest.xml};
  print TGT qq{








};
  close (TGT);

  # - Build compressed target file
  # windows support added by using Archive::Zip
  # thanks to Magnus Nufer
  my $zip = Archive::Zip->new();
  $zip->addFile(qq{$self->{builddir}/mimetype}, 'mimetype');
  $zip->addFile(qq{$self->{builddir}/content.xml}, 'content.xml');
  $zip->addFile(qq{$self->{builddir}/styles.xml}, 'styles.xml');
  $zip->addFile(qq{$self->{builddir}/meta.xml}, 'meta.xml');
  $zip->addFile(qq{$self->{builddir}/settings.xml}, 'settings.xml');
  $zip->addFile(qq{$self->{builddir}/META-INF/manifest.xml}, 'META-INF/manifest.xml');
  my $status = $zip->overwriteAs($tgtfile);
# if you are on a Linux system with zip available and you don't want to
# use Archive::Zip, you could use the following 6 lines, and comment out the
# above 8 lines and of course the 'use Archive::Zip' statement at the top
#   system("cd $self->{builddir}; zip -r '$tgtfile' mimetype &> /dev/null");
#   system("cd $self->{builddir}; zip -r '$tgtfile' content.xml &> /dev/null");
#   system("cd $self->{builddir}; zip -r '$tgtfile' styles.xml &> /dev/null");
#   system("cd $self->{builddir}; zip -r '$tgtfile' meta.xml &> /dev/null");
#   system("cd $self->{builddir}; zip -r '$tgtfile' settings.xml &> /dev/null");
#   system("cd $self->{builddir}; zip -r '$tgtfile' META-INF/manifest.xml &> /dev/null");

  # - remove workfiles & directory
  unlink("$self->{builddir}/mimetype");
  unlink("$self->{builddir}/content.xml");
  unlink("$self->{builddir}/styles.xml");
  unlink("$self->{builddir}/meta.xml");
  unlink("$self->{builddir}/settings.xml");
  unlink("$self->{builddir}/META-INF/manifest.xml");
  rmdir("$self->{builddir}/META-INF");

  1;
}

sub _generate_meta {
  my ($self);
  $self=shift;

  # - prepare data
  my ($timestamp, $keywords);
  $timestamp=$self->_oo_timestamp;
  $keywords=join('',map qq{$_}, @{$self->{meta}{keywords}});

  # - user defined vars
  my ($meta, $name, $value, @tmp);
  for (1 .. 4) {
    if ($self->{meta}{"data$_"}) {
      @tmp=keys(%{$self->{meta}{"data$_"}});
      $name=shift @tmp;
    } else {
      $name="meta$_";
    }
    $value=$self->{meta}{"data$_"}{$name};
    if ($value) {
      $meta.=qq{$value};
    } else {
      $meta.=qq{};
    }
  }

  open (TGT, qq{>$self->{builddir}/meta.xml});
  print TGT
qq{



oooBuilder $VERSION
$self->{meta}{title}
$self->{meta}{comments}
$self->{meta}{subject}
$self->{meta}{author}
$timestamp
$self->{meta}{author}
$timestamp
$keywords
en-US
1
PT0S
$meta


};
  1;
}   # - - End _generate_meta


sub _generate_styles {
  my ($self);
  $self=shift;

# ** TODO

  1;
}   # - - End _generate_styles


sub _generate_settings {
  my ($self);
  $self=shift;

# ** TODO

  1;
}   # - - End _generate_settings


sub _set_active_style {
  my ($self);
  $self=shift;
  $self->{actstyle}=join('#',($self->{style}{bold}, $self->{style}{italic},
                         $self->{style}{underline},$self->{style}{align},
                         $self->{style}{txtcolor},$self->{style}{bgcolor},
                         $self->{style}{font},$self->{style}{size}));
  1;
}

sub _check_color {
  my ($self, $color)=@_;
  $color=lc($color);
  $color=$COLORS{$color} if (! ($color =~ /^[0-9a-f]{6}$/));
  return $color
}

# OpenOffice TimeStamp (form = yyyy-mm-ddThh:mm:ss)
sub _oo_timestamp {
  my ($self);
  $self=shift;
  my ($sec,$min,$hour,$mday,$mon,$year,@rest) = gmtime(time);
  return (sprintf("%04d-%02d-%02dT%02d:%02d:%02d",
                  $year+1900,$mon+1,$mday,$hour,$min,$sec));
}

sub encode_data {
  my ($self, $data)=@_;
  $data=~ s/\&/\&/g;
  $data=~ s/
  $data=~ s/>/\>/g;
  $data=~ s/'/\'/g;
  $data=~ s/"/\"/g;
  $data=~ s/\t//g;
  return $data;
}

1;
__END__