http://qs321.pair.com?node_id=476398
Category: Text Processing
Author/Contact Info Richard Still http://www.oakbox.com
Description: I use OpenOffice a lot in my work. Generating XML files is, if not a snap, at least not too difficult, and from those XML files I get a whole universe of file types to export to.

This bit of code is useful for two reasons: 1) It does something useful. 2) If you have not fiddled around with OO, this is a chance to see how easy it is.

One issue I run into regularly is "What fonts can I use here?" You see, while OpenOffice might render something beautifully to the screen, it's pretty much a crap shoot on how those fonts will look in a PDF export, or how MS Word will render things on screen. For the *most* part, everything works just fine, but errors do creep in.

So, with this in mind, I wrote a little test script. This program:

  1. Looks in your OpenOffice settings (we have to assume you have OO installed)
  2. Opens up the pspfontcache file, this file holds all of the fonts that OO has found on your system
  3. Parses pspfontcache, grab the names of the fonts.
  4. Generate a simple content.xml file showing each font in action.
  5. zip's the results into a .sxw file called 'fonttest.sxw'

You can open fonttest.sxw in OpenOffice and print, exporttoPDF, email a copy of it to your designer and say "You can only use these fonts", etc.

This code has been tested only in Linux.

UPDATE: add comments, add code that searches for most recent version of OO.

#!/usr/bin/perl


# OpenOffice Font Printer
#
# Every time OpenOffice runs, it looks through paths on your
# system for possible fonts.  The found fonts are stored (with
# formatting information) to the pspfontcache file in your
# home directory.
#
# This script parses the pspfontcache file and creates a very
# basic oowriter file (.sxw) that displays all of the fonts
# in a single document.
#
# See http://www.openoffice.org/FAQs/fontguide.html for
# helpful information about font handling in OO.
#
# Usage: (in Linux)
# Run from command line under your own account
# perl gen.pl
#
# Written by Richard Still http://www.oakbox.com
# Discuss on PerlMonks.org http://www.perlmonks.org/?node_id=476398
# (c) Perl Artistic License

my $homedir = $ENV{'HOME'};
my $outfile = "fonttest.sxw";
my $psp =".openoffice"; # this is the standard location

# find the user directory, or the highest OO version
# user directory
my $seek_user = $homedir . "/" . $psp;
   opendir DIR, $seek_user || die $!;
my @directories = readdir DIR;
my $pspfonts;

my @possibilities;
foreach my $listing (@directories){
  if($listing eq "." || $listing eq ".."){ next; }
  if($listing eq "user"){ $pspfonts = "$psp/user/psprint/pspfontcache"
+; last;}
  push(@possibilities, $listing);
}

if($pspfonts eq ""){
  my @sorted = reverse sort @possibilities;
  $pspfonts = "$psp/$sorted[0]/user/psprint/pspfontcache";
}

# Attempt to open pspfontcache file
open(READ,"<$homedir/$pspfonts") || die "$homedir/$pspfonts $!\n";
my @READ = <READ>;
close(READ);

print "Using configuration file $pspfonts\n";

# Parse pspfontcache file
my $fontlist;

while(@READ){
  my $var = shift @READ;
  chomp $var;
  # many simple regex's
  if($var =~ /File/  ){ next; }
  if($var =~ /Font/  ){ next; }
  if($var =~ /Empty/ ){ next; }
  if($var =~ /[0-3]\;/ ){ next; }
  if($var eq "" ){ next; }
  $fontlist->{$var} = 1;
}

# This is the opening stuff in content.xml
my $data = q|<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE office:document-content PUBLIC "-//OpenOffice.org//DTD Offic
+eDocument 1.0//EN" "office.dtd">
<office:document-content 
xmlns:office="http://openoffice.org/2000/office" 
xmlns:style="http://openoffice.org/2000/style" 
xmlns:text="http://openoffice.org/2000/text" 
xmlns:table="http://openoffice.org/2000/table" 
xmlns:draw="http://openoffice.org/2000/drawing" 
xmlns:fo="http://www.w3.org/1999/XSL/Format" 
xmlns:xlink="http://www.w3.org/1999/xlink" 
xmlns:number="http://openoffice.org/2000/datastyle" 
xmlns:svg="http://www.w3.org/2000/svg" 
xmlns:chart="http://openoffice.org/2000/chart" 
xmlns:dr3d="http://openoffice.org/2000/dr3d" 
xmlns:math="http://www.w3.org/1998/Math/MathML" 
xmlns:form="http://openoffice.org/2000/form" 
xmlns:script="http://openoffice.org/2000/script" 
office:class="text" office:version="1.0">
<office:script/>
<office:font-decls>|;

# fonts are defined here.  I'm lying to OO, 
# I don't know what 'font-family-generic' *really* should be
# and the 'font-pitch' setting is iffy.  Well, it's not 
# perfect, but you have to make some compromises

foreach my $fontname (sort keys %{$fontlist}){
   $data .= qq|<style:font-decl style:name="$fontname" 
fo:font-family="$fontname" 
style:font-family-generic="swiss" style:font-pitch="variable"/>|;
}

$data .= qq|</office:font-decls>
<office:automatic-styles>|;

# Make a definition for different paragraph types.  
# Each paragraph style gets a different font.

my $pnum;
foreach my $fontname (sort keys %{$fontlist}){
   $pnum++;
   $fontlist->{$fontname} = $pnum;
   $data .= qq|<style:style style:name="P$pnum" style:family="paragrap
+h" style:parent-style-name="Standard">
<style:properties style:font-name="$fontname"/>
</style:style>|;
} 

   $data .= qq|</office:automatic-styles>
<office:body>
<text:sequence-decls>
<text:sequence-decl text:display-outline-level="0" text:name="Illustra
+tion"/>
<text:sequence-decl text:display-outline-level="0" text:name="Table"/>
<text:sequence-decl text:display-outline-level="0" text:name="Text"/>
<text:sequence-decl text:display-outline-level="0" text:name="Drawing"
+/>
</text:sequence-decls>|;

# Actually insert the text with the different 
# definitions driving the formatting
foreach my $fontname (sort keys %{$fontlist}){
   $data .= qq|<text:p text:style-name="P$fontlist->{$fontname}">$font
+name 
ABCDEFGHIJKLMNOPQRSTUVWXYZ 
abcdefghijklmnopqrstuvwxyz 
0123456789,.:;/?"'!#$%
</text:p>
<text:p text:style-name="P$fontlist->{$fontname}" />
|;
 } 

# close it all up
   $data .= qq|
</office:body>
</office:document-content>
|;

open(WRT,">content.xml");
print WRT $data;
close (WRT);

# Yes, you can have a complete .sxw file using
# ONLY the content.xml file.  Cool!

my @args = ("zip", "$outfile", "content.xml");
   system(@args) == 0
        or die "Boom!  Zip operation failed : $?";

print "'oowriter $outfile' should bring up the file\n";

1;