#!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