#!c:\Perl\bin\perl.exe
#!/usr/bin/perl
# fmp2csv.pm
package FMPro::fmp2csv;
# use strict; # weglassen, da sonst $FH als Filehandle nicht mglich
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
@ISA = qw(Exporter AutoLoader);
@EXPORT = qw();
@EXPORT_OK = qw(fmp2csv);
$VERSION = '0.1';
##################################################################
# fmp2csv
#
# Parst FMPro-XML Datei und erzeugt
# CSV-Datei - kommasepariert, Text in Hochkomma
#
# input:$String oder
# "http://www.domain.de/FMPro?-DB=Datenbank&-format=-dso_xml&-Find=" oder
# "http://www.domain.de/FMPro?-DB=Datenbank&-format=-fmp_xml&-Find=" oder
# "c:\\Inetpub\\wwwroot\\Baurat\\tmp\\Datei.xml"
#
# und
#
# Dateiname + Pfad der zu erzeugenden Datei.csv
#
# z.B.:
# "c:\\tmp\\Datei.xml", "c:\\tmp\\CSV-Datei.csv"
#
# output:"OK" oder "Error - ..."
#
##################################################################
sub fmp2csv
{
use LWP::Simple; # get, getstore
my ($input,$output,$separator) = @_;
my ($tmp,$i,$j,$String,$xml,$switch);
BEGIN
{
unless (eval "use Unicode::String qw(latin1 utf8)")
{
$switch = "noUnicode";
}
else
{
Unicode::String->stringify_as('utf8');
$switch = "okUnicode";
}
}
##################################################################
### Prfen, ob $input Datei ist. Wenn ja auslesen.
if (-f $input)
{
$String = &GET_DATEI_STRING($input);
unless ($String =~ m,encoding="UTF-8",im)
{
return("Error - Die angegebene Datei $input liegt nicht im Format UTF-8 vor.");
}
unless($String =~ m,<\?xml version="[\d\.]*?" encoding=".*?"\?><(FMPXMLRESULT) xmlns="http://www.filemaker.com/fmpxmlresult">,m && $String =~ m,,m)
{
return("Error - Die angegebene Datei $input liegt nicht im FileMaker XML-Format \"-fmp_xml\" vor.");
}
if($1 eq "FMPDSORESULT")
{
$xml->[0]{CurrentFormat} = "-dso_xml";
}
else
{
$xml->[0]{CurrentFormat} = "-fmp_xml";
}
}
### Prfen, ob $input URL ist. Wenn ja anfordern.
# z.B. http://domain.de?-db=BauBuch.fp5&-lay=WWW_BR_NavRe&-Format=-dso_xml&-Skip=10&-Find=
elsif ($input =~ m,^http://,)
{
unless ($input =~ m,-format=-dso_xml,im | $input =~ m,-format=-fmp_xml,im)
{
return("Error - Die angegebene URL liefert kein dso_xml oder fmp_xml zurück. Bitte \"-format=-dso_xml\" angeben!");
}
$String = get("$input"); # ber String kann man den ordnungsgemen Ablauf kontrollieren
unless ($String =~ m,encoding="UTF-8",im)
{
return("Error - Das unter $input zurückgelieferte XML liegt nicht im Format UTF-8 vor.");
}
$input =~ m,&-format=(-[fd][ms][po]_xml)&,im;
$xml->[0]{CurrentFormat} = $1;
}
### Wenn FMPro DSO_XML/FMP_XML $input selbst parsen
elsif ($input =~ m,<\?xml version="[\d\.]*?" encoding=".*?"\?><(FMP[DX][SM][OL]RESULT) xmlns="http://www.filemaker.com/fmp[dx][sm][ol]result">,m && $input =~ m,,m)
{
$String = $input;
unless ($String =~ m,encoding="UTF-8",im)
{
return("Error - Das übergebene XML liegt nicht im Format UTF-8 vor.");
}
if($1 eq "FMPDSORESULT")
{
$xml->[0]{CurrentFormat} = "-dso_xml";
}
else
{
$xml->[0]{CurrentFormat} = "-fmp_xml";
}
}
### Fehlermeldung
else
{
return("Error - Der übergebene String ist weder eine Pfadangabe, noch eine URL oder FMPro DSO_XML.");
}
# Konvertierung von UTF-8 nach Latin1
if($switch eq "okUnicode")
{
$String = new Unicode::String($String);
$String = $String->latin1();
}
else
{
$String = UTF8_LATIN1($String);
}
$String =~ s/
/\n/mg;
# CSV-Datei anlegen
my $FHOUT = "OUTFILE".int(rand()*10000);
open ($FHOUT, "> $output") || return "Error - Kann Datei $output nicht zum schreiben oeffen: $!\n";
### Parsing FMPXMLRESULT
if ($xml->[0]{CurrentFormat} eq "-fmp_xml")
{
my ($tmp,@tmp,@tmp1,@tmp2,$i,$j,$k,$m,@FeldName);
if($String =~ m,([\w\W\s\S\d\D]*?),m)
{
# $tmp[0]=EmptyOk $tmp[1]=MaxReapeat $tmp[2]=Name $tmp[3]=Type $tmp[4]=EmptyOk ...
@tmp = $1 =~ m,,mg;
for ($i=0; $i<@tmp; $i+=4)
{
$xml->[0]{$tmp[$i+2]}{Type} = $tmp[$i+3];
$FeldName[$i/4] = $tmp[$i+2]; # Feldnamen fr nchste Schleife
}
### 1. Zeile mit Spaltennamen, 1. Spalte immer RecID ###
print $FHOUT "RecID"; # RecID ist immer 1. Spalte
for ($i=0; $i<@tmp; $i+=4)
{
print $FHOUT ",$tmp[$i+2]";
}
print $FHOUT "\n";
}
########################################################
if($String =~ m,([\w\W\s\S\d\D]*?),m)
{
@tmp = $2 =~ m,([\w\W\s\S\d\D]*?)
,mg;
### Alle weiteren Zeilen mit Spaltenwerten fllen ######
for ($j=0; $j<@tmp; $j+=3)
{
print $FHOUT "$tmp[$j+1]"; # RecID ist immer 1. Spalte
if(@tmp1 = $tmp[$j+2] =~ m,
([\w\W\s\S\d\D]*?),mg) # Kein Wiederholfeld
{
for($k=0;$k<@tmp1;$k++)
{
if($tmp1[$k] =~ m,,m)
{
# Wiederholfeld mit mindestens 2 Wiederholungen
@tmp2 = split(/<\/DATA>/,$tmp1[$k]);
$tmp = &CONVERT($xml->[0]{$FeldName[$k]}{Type},$tmp2[0]);
# Bei Textfeldern:
if($xml->[0]{$FeldName[$k]}{Type} =~ m/[Tt][Ee][Xx][Tt]/)
{
print $FHOUT ",\"$tmp";
}
else
{
print $FHOUT ",$tmp";
}
for($m=1;$m<@tmp2;$m++)
{
$tmp = &CONVERT($xml->[0]{$FeldName[$k]}{Type},$tmp2[$m]);
print $FHOUT "####$tmp"; # Wiederholfelder werden mit #### getrennt in eine Spalte geschrieben
}
if($xml->[0]{$FeldName[$k]}{Type} =~ m/[Tt][Ee][Xx][Tt]/)
{
print $FHOUT "\"";
}
}
else
{
$tmp = &CONVERT($xml->[0]{$FeldName[$k]}{Type},$tmp1[$k]);
# Bei Textfeldern:
if($xml->[0]{$FeldName[$k]}{Type} =~ m/[Tt][Ee][Xx][Tt]/)
{
print $FHOUT ",\"$tmp\"";
}
else
{
print $FHOUT ",$tmp";
}
}
}
}
print $FHOUT "\n";
}
}
}
else
{
close ($FHOUT) || return "Error - Can't close file $output: $!\n";
return "Error - XML liegt nicht im Format \"FMPXMLRESULT\" vor.";
}
close ($FHOUT) || return "Error - Can't close file $output: $!\n";
return("OK");
}
##################################################################
# CONVERT
# Konvertiert Feldwerte fr MySQL
#
# input: Feldwert
#
# output: Feldwert
##################################################################
sub CONVERT
{
my ($FeldTyp,$Feldwert)=@_;
# Bei Zahlen Komma in Punkt konvertieren
if($FeldTyp =~ m/[Nn][Uu][Mm][Bb][Ee][Rr]/)
{
$Feldwert =~ s/,/\./g;
}
# Bei Textfeldern:
if($FeldTyp =~ m/[Tt][Ee][Xx][Tt]/)
{
# Hochkomma " in \" konvertieren
$Feldwert =~ s/"/\\"/g;
# Zeilenumbruch konvertieren
$Feldwert =~ s/\r\n/\\n/g;
$Feldwert =~ s/\n/\\n/g;
$Feldwert =~ s/\r/\\n/g;
}
return ($Feldwert);
}
##################################################################
# GET_DATEI_STRING (siehe TEMPLATE_LESEN)
# Liest Datei als String ein (Schlrfmodus)
#
# input: absoluter Pfad zur Datei
#
# output: Inhalt der Datei
##################################################################
sub GET_DATEI_STRING
{
my $Datei=$_[0];
my $DateiInhalt = '';
my $FH = "FILE".int(rand()*10000);
if (-e $Datei)
{
open ($FH, "< $Datei") || die "Kann Datei $Datei nicht zum lesen oeffen: $!\n";
local $/; # Schlrfmodus einschlaten
while (<$FH>)
{
$DateiInhalt = $_; # gesamte Datei drin!
}
close ($FH) || die "Can't close the text file: $!\n";
}
else {die "Datei $Datei kann nicht geoeffnet werden";}
return ($DateiInhalt);
}
##################################################################
# UTF8_LATIN1
# Nicht schn und intelligent, dafr geht es auch ohne Modul
#
# input: $string utf8-codiert
#
# output: $string latin1-codiert
#
##################################################################
sub UTF8_LATIN1
{
#my $string = $_[0];
# Zerlegt einen String in einzelne Zeichen
#my @chars = unpack("U" x length($_[0]), $_[0]); # "U" unicode
#my @chars = unpack("a1" x length($_[0]), $_[0]);
#my ($char);
#$_[0] =~ tr/\0-\x{ff}//UC; # utf8 to latin1 char
# Fr Perl 5.8
#use Encode;
#$octets = encode("iso-8859-15", $utf8string);
$_[0] =~ s/“|”/"/mg; # bertragung von 3-Byte-Zeichen
$_[0] =~ s/([])/$1/mg;
$_[0] =~ s/Ñ//mg;
$_[0] =~ s/Ò//mg;
$_[0] =~ s/á//mg;
$_[0] =~ s/â//mg;
$_[0] =~ s/ã//mg;
$_[0] =~ s/ä//mg;
$_[0] =~ s/å//mg;
$_[0] =~ s/æ//mg;
$_[0] =~ s/ç//mg;
$_[0] =~ s/è//mg;
$_[0] =~ s/é//mg;
$_[0] =~ s/ê//mg;
$_[0] =~ s/ë//mg;
$_[0] =~ s/ì//mg;
$_[0] =~ s/í//mg;
$_[0] =~ s/î//mg;
$_[0] =~ s/ï//mg;
$_[0] =~ s/ð//mg;
$_[0] =~ s/ñ//mg;
$_[0] =~ s/ò//mg;
$_[0] =~ s/ó//mg;
$_[0] =~ s/ô//mg;
$_[0] =~ s/õ//mg;
$_[0] =~ s/ö//mg;
$_[0] =~ s/÷//mg;
$_[0] =~ s/ø//mg;
$_[0] =~ s/ù//mg;
$_[0] =~ s/ú//mg;
$_[0] =~ s/û//mg;
$_[0] =~ s/ü//mg;
$_[0] =~ s/ý//mg;
$_[0] =~ s/þ//mg;
$_[0] =~ s/ÿ//mg;
$_[0] =~ s/ //mg;
$_[0] =~ s/À//mg;
$_[0] =~ s/Á//mg;
$_[0] =~ s/Ä//mg;
$_[0] =~ s/Å//mg;
$_[0] =~ s/Æ//mg;
$_[0] =~ s/Ç//mg;
$_[0] =~ s/È//mg;
$_[0] =~ s/É//mg;
$_[0] =~ s/Ê//mg;
$_[0] =~ s/Ë//mg;
$_[0] =~ s/Ì//mg;
$_[0] =~ s/Í//mg;
$_[0] =~ s/Î//mg;
$_[0] =~ s/Ï//mg;
$_[0] =~ s/Ð//mg;
$_[0] =~ s/Ó//mg;
$_[0] =~ s/Ô//mg;
$_[0] =~ s/Õ//mg;
$_[0] =~ s/Ö//mg;
$_[0] =~ s/×//mg;
$_[0] =~ s/Ø//mg;
$_[0] =~ s/Ù//mg;
$_[0] =~ s/Ú//mg;
$_[0] =~ s/Û//mg;
$_[0] =~ s/Ü//mg;
$_[0] =~ s/Ý//mg;
$_[0] =~ s/Þ//mg;
$_[0] =~ s/ß//mg;
$_[0] =~ s/Ã//mg;
$_[0] =~ s/Â//mg;
return ($_[0]);
}
1;
__END__
=head1 NAME
FMPro::fmp2csv - Parst FMPro-XML und speichert CSV-Datei
=head1 SYNOPSIS
use FMPro::fmp2csv qw(fmp2csv);
$tmp = ; oder ;
$values = fmp2perl($tmp);
=head1 DESCRIPTION
=head2 Input
=head2 Output
=head1 EXAMPLE
=head1 BUGS
=head1 AUTHOR
Hans-Martin Aurich info@webconsultant.de technik@baurat.de
=head1 COPYRIGHT
Copyright 2006 Hans-Martin Aurich. All rights reserved.
=head1 SEE ALSO
=cut