package SXWWriter::Elt;
use XML::Twig;
use base "XML::Twig::Elt";

##########################################################
# Add to element
##########################################################

# 'public' functions
sub add_h { add_text($_[0],'h',$_[1],$_[2]);}	# add a <text:h> element
sub add_p { add_text($_[0],'p',$_[1],$_[2]);}	# add a <text:p> element
sub add {				# insert an object into another (oo err missus)
	my ($self,$obj) = @_;
	$obj->paste('last_child',$self);
	$obj;
}	
# internals
sub add_text {									# add a <text:$type> element
	my ($self,$type,$text,$style) = @_;
	$style ||= "Standard";
	$text  ||= '#EMPTY'; # Ensure an <empty/> tag
	my @t;
	foreach ((ref $text eq 'ARRAY') ? @$text : $text) {
		while (s/^(.*?)\t//) {	#replace tabs with <text:tab-stop />
			push @t,$1;
			push @t,SXWWriter::Elt->new('text:tab-stop','#EMPTY');
		}
		push @t,$_;
	}
	my $t = SXWWriter::Elt->new("text:$type"=>{'text:style-name'=>$style},@t);
	$t->paste('last_child',$self);
}
sub insert_new { # 'cos insert_new_elt returns an XML::Twig::Elt
	my $s = shift();
	$s->add(SXWWriter::Elt->new(@_));
}

1;

package SXWWriter;

use XML::Twig;
use strict;
use warnings;
use File::Basename;

our $compression = 6;	# default compression level
$XML::Twig::base_ent{'£'}='&pound;';
sub new {
	my ($class) = shift();
	my %doc=(
		'manifest'=>{fname=>"Meta-Inf\\manifest.xml",xml=>make_xml("manifest:manifest")},
		'meta'=>{fname=>"meta.xml",xml=>make_xml("office:document-meta")},
		'styles'=>{fname=>"styles.xml",xml=>make_xml("office:document-content")},
		'content'=>{fname=>"content.xml",xml=>make_xml("office:document-styles")},
		'index'=>1
	);
	my @ns = (['office:version','1.0'],['xmlns:office','http://openoffice.org/2000/office'],
		['xmlns:number','http://openoffice.org/2000/datastyle'],['xmlns:math','http://www.w3.org/1998/Math/MathML'],
		['xmlns:xlink','http://www.w3.org/1999/xlink'],['xmlns:form','http://openoffice.org/2000/form'], 
		['xmlns:table','http://openoffice.org/2000/table'], ['xmlns:style','http://openoffice.org/2000/style'],
		['xmlns:script','http://openoffice.org/2000/script'], ['xmlns:draw','http://openoffice.org/2000/drawing'],
		['xmlns:svg','http://www.w3.org/2000/svg'], ['xmlns:fo','http://www.w3.org/1999/XSL/Format'],
		['xmlns:text','http://openoffice.org/2000/text'], ['xmlns:dr3d','http://openoffice.org/2000/dr3d'],
		['xmlns:chart','http://openoffice.org/2000/chart']);

	my $mroot = SXWWriter::Elt->new('manifest:manifest'=>{'xmlns:manifest'=>"http://openoffice.org/2001/manifest"}); 
	$doc{manifest}{xml}->set_root($mroot);

	my %props = map {$_->[0]=>$_->[1]} @ns[0..1];
	my $nroot = SXWWriter::Elt->new('office:document-meta'=>{%props,
		'xmlns:meta'=> 'http://openoffice.org/2000/meta',
		'xmlns:xlink'=> 'http://www.w3.org/1999/xlink',
		'xmlns:dc'=>'http://purl.org/dc/elements/1.1/'});
	$nroot->insert_new("office:meta");
	$doc{meta}{xml}->set_root($nroot);

	%props = map {$_->[0]=>$_->[1]} @ns;

	my $sroot = SXWWriter::Elt->new('office:document-styles'=>{%props,'office:class'=>'text'});

	my $fd = $sroot->insert_new("office:font-decls");
	my $ss = $sroot->insert_new("office:styles");
	my $as = $sroot->insert_new("office:automatic-styles");
	my $pm = $as->insert_new("style:page-master"=>{"style:name"=>"pm1"});
	$pm->insert_new("style:header-style",'#EMPTY');
	$pm->insert_new("style:footer-style",'#EMPTY');
	my $psp = $pm->insert_new("style:properties"=>{
			'style:print-orientation'=>'portrait','style:footnote-max-height'=>'0cm',
			'fo:page-width'=>"21.001cm",'fo:page-height'=>"29.7cm",
			'fo:margin-right'=>'2cm','fo:margin-bottom'=>'2cm','fo:margin-top' => '2cm','fo:margin-left'=>'2cm'});
	$psp->insert_new('style:footnote-sep'=>{
		'style:distance-before-sep'=>'0.101cm','style:adjustment'=>'left','style:width'=>'0.018cm',
		'style:rel-width'=>'25%','style:distance-after-sep'=>'0.101cm','style:color' =>'#000000'});
	$ss->insert_new("text:linenumbering-configuration"=>
		{'text:increment'=>'5','text:number-lines'=>'false','text:number-position'=>'left','text:offset'=>'0.499cm','style:num-format'=>'1'},
		'#EMPTY');
	$ss->insert_new("text:footnotes-configuration"=>
		{'style:num-format'=>"1",'text:start-value'=>"0",'text:footnotes-position'=>"page",'text:start-numbering-at'=>"document"},
		'#EMPTY');
	$ss->insert_new("text:endnotes-configuration"=>{'style:num-format'=>"i",'text:start-value'=>"0"},'#EMPTY');
	my $tos = $ss->insert_new("text:outline-style");
	$tos->insert_new('text:outline-level-style'=>{'style:num-format'=>'','text:level'=>$_},'#EMPTY') foreach (0..10);
	my $ms = $sroot->insert_new("office:master-styles");
	$ms->insert_new("style:master-page"=>{"style:name"=>"Standard","style:page-master-name"=>"pm1"});
	$doc{styles}{xml}->set_root($sroot);
	
	my $croot = SXWWriter::Elt->new('office:document-content'=>{%props,'office:class'=>'text'});
	$croot->insert_new("office:script",'#EMPTY');
	$croot->insert_new("office:font-decls");
	$croot->insert_new("office:automatic-styles");
	my $body = $croot->insert_new("office:body");
	my $fds = $body->insert_new("text:sequence-decls");
	foreach (qw/Illustration Table Text Drawing/) {
		$fds->insert_new('text:sequence-decl'=>{'text:name'=>$_,'text:display-outline-level'=>'0'},'#EMPTY');
	}
	$doc{content}{xml}->set_root($croot);
	$doc{body} = $body;
	$doc{pageprops} = $psp;	# save page props - saves us having to find them again

	my $doc = bless \%doc ,$class;
	
	$doc->add_dc('generator',"SWX Creator");
	$doc->add_manifest('/','application/vnd.sun.xml.writer','Pictures/','','content.xml',
		'text/xml','styles.xml','text/xml','meta.xml','text/xml');
	$doc->add_font('font-family-generic'=>'roman','font-pitch'=>'variable','name' => 'Thorndale','font-family' => 'Thorndale');
	$doc->add_font('font-family-generic'=>'swiss','font-pitch'=>'variable','name'=>'Arial','font-family' => 'Arial');
	$doc->add_sstyle(family=>'paragraph',name=>'Standard'); 
	$doc->add_sstyle('parent-style-name'=>'Standard','family'=>'paragraph','name'=>'Text body',
			'properties' =>	{'fo:margin-top'=>'0cm','fo:margin-bottom'=>'0.212cm'}
	);
	$doc;
}

sub save {
	my ($self,$filename) = @_;
	use Archive::Zip qw( :ERROR_CODES);
	my $zip = Archive::Zip->new();
	my $m = $self->{manifest}{xml}->root;
	foreach ($m->children()) {
		if ($_->att('manifest:media-type') =~/image/) {
			my $file = $_->att('manifest:full-path');
			my $filename = basename($file);
			my $m = $zip->addFile($file,"Pictures\\$filename");
			$_->set_att('manifest:full-path',"Pictures/$filename");
		}
	}
	foreach (keys %$self) {
		next if /index|body|page/;
		my $m = $zip->addString($self->{$_}{xml}->sprint,$self->{$_}{fname});
		$m->desiredCompressionLevel($compression);
	}
	die "Can't write file $!" unless $zip->writeToFileNamed($filename) == AZ_OK;
}

##########################################################
# Add to Document
##########################################################
sub add_manifest {
	my $self = shift;
	while (@_) {
		$self->{manifest}{xml}->root->insert_new(
			'manifest:file-entry'=>{"manifest:full-path"=>shift,'manifest:media-type'=>shift},'#EMPTY'
		);
	}
}

sub add_meta {add_to_meta($_[0],"meta:".$_[1],$_[2]);}
sub add_dc {add_to_meta($_[0],"dc:".$_[1],$_[2]);}
sub add_to_meta {
	$_[0]->{meta}{xml}->root->first_child->insert_new($_[1],$_[2]);
}

sub add_font {
	my ($self,%properties) = @_;
	my $style = make_style(%properties);
	$self->{content}{xml}->root->first_child('office:font-decls')->insert_new('style:font-decl',$style,'#EMPTY');
	$self->{styles}{xml}->root->first_child('office:font-decls')->insert_new('style:font-decl',$style,'#EMPTY');
}

sub add_pstyle {
	my ($self,$name,%props) = @_;
	$self->add_style('name'=>$name,'family'=>"paragraph",'parent-style-name'=>"Standard",'properties'=>\%props);
}
sub add_tstyle {
	my ($self,$name,%prop) = @_;
	$self->add_style('name'=>$name,'family'=>"text",'properties'=>\%prop);
}
sub add_fstyle {
	my ($self,$name,%prop) = @_;
	$self->add_style('name'=>$name,'family'=>"frame",'properties'=>\%prop);
}
sub add_style {my $self=shift();$self->add_to_styles("content",'office:automatic-styles',@_);}
sub add_sstyle {my $self=shift();$self->add_to_styles("styles",'office:styles',@_);}
sub add_to_styles {
	my ($self,$doc,$stylename,%prop) = @_;
	my $prop =  SXWWriter::Elt->new('style:properties'=>$prop{properties},'#EMPTY');
	delete $prop{properties};
	$self->{$doc}{xml}->root->first_child($stylename)->insert_new("style:style",make_style(%prop),$prop); 
}

###################################################
# Helpers
###################################################
sub make_style {
	my %opts = @_;
	foreach (keys %opts){
		$opts{(($_ eq 'font-family')?"fo":"style").":$_"}=$opts{$_};
		delete $opts{$_};
	}
	\%opts;
}

sub make_xml {
	my ($type) = @_;
	my $dtd = ($type =~ /manifest/) ? "Manifest" : "office";
	my $doc = ($dtd eq "Manifest")  ? $dtd : "Office Document";
	my $t  = XML::Twig->new(pretty_print => 'indented','output_encoding'=>'UTF-8');
	$t->set_xml_version("1.0");
	$t->set_doctype($type,$dtd.".dtd","-//OpenOffice.org//DTD $doc 1.0//EN");
	$t;
}

###################################################
# Document Properties
###################################################

sub set_page_margin {$_[0]->set_page_margins($_[1],$_[1],$_[1],$_[1]);}
sub set_page_margins {
	my ($self,$l,$r,$t,$b) = @_;
	$self->{pageprops}->set_att("fo:margin-left",$l/10 . "cm");
	$self->{pageprops}->set_att("fo:margin-right",$r/10 . "cm");
	$self->{pageprops}->set_att("fo:margin-top",$t/10 . "cm");
	$self->{pageprops}->set_att("fo:margin-bottom",$b/10 . "cm");
}

##########################################################
# Make Document Elements
##########################################################
sub make_span {
	my ($self,$text,$style) = @_;
	SXWWriter::Elt->new('text:span'=>{'text:style-name'=>$style},$text);
}

my %boxprops = ('style:vertical-pos'=>"from-top",'style:vertical-rel'=>"paragraph",
		'style:horizontal-pos'=>"from-left",'style:horizontal-rel'=>"paragraph",
		"fo:border"=>"none");

sub make_frame {
	my ($self,$x,$y,$w,$h,%prop) = @_;
	my $index = $self->{'index'}++;
	my %props = (%boxprops,%prop);
	$self->add_style('properties'=>\%props,"name"=>"fr$index","family"=>"graphics","parent-style-name"=>"Frame");
	SXWWriter::Elt->new("draw:text-box"=>{_box($x,$y,$w,$h,$index,"Frame")});
}

sub make_picture {
	my ($self,$filename,$x,$y,$w,$h,%prop) = @_;
	my %props = (%boxprops,'draw:luminance'=>"0%",'draw:contrast'=>"0%",
		'draw:red'=>"0%",'draw:green'=>"0%",'draw:blue'=>"0%",'draw:gamma'=>"1",
		'draw:color-inversion'=>"false",'draw:transparency'=>"-100%",
		'draw:color-mode'=>"standard",'fo:clip'=>"rect(0cm 0cm 0cm 0cm)",%prop);
	use File::MMagic;
	my $m = new File::MMagic;
	my $media = $m->checktype_filename($filename);
	$self->add_manifest($filename,$media);	#will replace pathname when saving
	$filename = basename($filename);
	my $index = $self->{'index'}++;
	$self->add_style('properties'=>\%props,"name"=>"fr$index","family"=>"graphics","parent-style-name"=>"Graphics");
	SXWWriter::Elt->new("draw:image"=>{_box($x,$y,$w,$h,$index,"Graphic"),
		'xlink:href'=>"#Pictures/$filename",'xlink:type'=>"simple",
		'xlink:show'=>"embed",'xlink:actuate'=>"onLoad"});
}

sub _box {
	my ($x,$y,$w,$h,$i,$n) = @_;
	return('svg:x'=>($x/10)."cm",'svg:y'=>($y/10) ."cm",
		'svg:width'=> ($w/10) ."cm",'svg:height' => ($h/10) ."cm",
		'draw:style-name'=>"fr$i",'draw:z-index'=>"1",
		'text:anchor-type'=>"page",'draw:name'=>"$n$i");
}

1;

__END__

=head1 NAME

	SXWWriter -- create simple Open Office .sxw files

=head1 SYNOPSIS

	use SXWWriter;

	my $doc = new SXWWriter();
	$doc->add_font('font-pitch'=>'variable',		# Arial & Thorndale predefined
		'name'=>'MyFont','font-family' => 'Courier New');
	$doc->add_pstyle('P1','style:font-name'=>"Arial",	# a paragraph style
		'fo:color'=>"#0000ff",'fo:font-size'=>"36pt");
	$doc->add_pstyle('P2','style:font-name'=>"MyFont",'fo:font-size'=>"11pt");
	$doc->add_tstyle('T1','fo:font-weight'=>"bold");	# inline text style
	$doc->add_dc('title',"My Document");				# dc:field=value
	$doc->add_meta('initial-creator',"Me");				# meta:field=value
	$doc->set_page_margin(10);	# ...or set_page_margins(l,r,t,b)

	my $body = $doc->{body};					# A subclass of XML::Twig::Elt
	my $frame = $doc->make_frame(136,10,57,50);	# x y width height in mm

	$body->add_p("A sentence in the default style");
	$body->add_p();								# blank paragraph
	$body->add_p("Some big text in style P1",'P1');
	
	my $frame = $doc->make_frame(122,0,57,33);	# x y width height
	$frame->add_p("Text inside the frame",'P2');
	$frame->add_p([$doc->make_span("embedded bold","T1")," Text"],'P2');
	$frame->add_p("Some text \t\twith tabs",'P2');
	$body->add_p($frame);

	my $picture = $doc->make_picture('picture.png',92,30,25,26); #name,x,y,w,h
	$body->add_p($picture);

	$s->save('mydocument.sxw');

=head1 DESCRIPTION

	This is about the bare minimum needed to write out Open Office Text files.
	All the 'public' methods are shown in the synopsis. Many style parameters
	are available, which can be found by downloading the definitive .sxw
	specification from http://xml.openoffice.org/xml_specification.pdf (1.4M),
	or more simply by having a look in an existing .sxw :)

	The body of the document, and all inserted elements, are a subclass of
	XML::Twig::Elt, so all its methods are available if needed. Frames and
	pictures need to be placed inside a paragraph to be displayed for reasons
	not yet clear to me (but may be once I finish reading the 1.4M spec :)) - 
	there *is* a simple 'add' method (which will paste() a Twig directly), but 
	for the moment, elements need to be add_p()'ed instead.
	
	Adding a picture will copy the file into the .sxw file on saving 
	(a zip file, but no compression is done on pictures - it seemed 
	unnecessary). It uses File::MMagic to autodetect the MIME type for 
	simplicity's sake, but it'd be simple to remove this and replace with
	a passed parameter if so wished.

=head1 TODO

	Lots. It works, but that's about it :) There's a couple of methods
	in there that are waiting for a use - add_h(),add_fstyle() etc. - they
	all work, but I haven't inserted all the right document headers yet to
	utilise them, simply because I didn't need them yet. Damm this laziness.
	It only does single pages too atm...
	Feel free to suggest improvements / send me bits of code / whatever.

=head1 LICENSE

Same terms as Perl itself yada yada yada

=head1 AUTHOR

Ben Daglish