#!/usr/bin/perl #!c:\Perl\bin\perl.exe # fmp2perl.pm package FMPro::fmp2perl; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); require Exporter; @ISA = qw(Exporter AutoLoader); @EXPORT = qw(); @EXPORT_OK = qw(fmp2perl); $VERSION = '1.0.03'; ################################################################## # fmp2perl # # Parsing of FMPro XML output; only UTF-8 XML format # We convert to latin1. # # input: $string or # "http://www.domain.de/FMPro?-DB=Datenbank&-format=-dso_xml&-Find=" or # "http://www.domain.de/FMPro?-DB=Datenbank&-format=-fmp_xml&-Find=" or # "c:\\Inetpub\\wwwroot\\Baurat\\tmp\\Datei.xml" # # output:Referenz $xml oder "Error - Errortext" # e.g. # $xml->[3]{title}{Data}[0] ==> title of 3. Hit Data record # ################################################################## sub fmp2perl { use LWP::Simple; # get, getstore my ($input) = @_; 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"; } } ################################################################## ### check if $input file. If yes read. if (-f $input) { $string = &GET_DATEI_STRING($input); unless ($string =~ m,encoding="UTF-8",im) { return("Error - The specified file $input is not present in format Utf-8."); } unless($string =~ m,<\?xml version="[\d.]*?" encoding="[\w\d]*?"\?><(FMP[DX][SM][OL]RESULT) xmlns="http://www.filemaker.com/fmp[dx][sm][ol]result">,m && $input =~ m,,m) { return("Error - The specified file $input is not present FileMaker XML-format (-dso_xml oder -fmp_xml)."); } if($1 eq "FMPDSORESULT") { $xml->[0]{CurrentFormat} = "-dso_xml"; } else { $xml->[0]{CurrentFormat} = "-fmp_xml"; } } ### Check if is $input url. If yes: request!. # e.g. 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 - The indicated URL supplies no dso_xml or fmp_xml. Please use \"-format=-dso_xml\"!"); } $string = get("$input"); unless ($string =~ m,encoding="UTF-8",im) { return("Error - get($input) - XML no UTF-8 format."); } $xml->[0]{URL} = $input; $input =~ m,&-format=(-[fd][ms][po]_xml)&,im; $xml->[0]{CurrentFormat} = $1; if($input =~ m,&-skip=(\d*?)&,im){$xml->[0]{CurrentSkip} = $1;}else{$xml->[0]{CurrentSkip} = 0} if($input =~ m,&-max=(\d*?)&,im){$xml->[0]{CurrentMax} = $1;}else{$xml->[0]{CurrentMax} = 25;} if($input =~ m,&-lop=(\w*?)&,im){$xml->[0]{CurrentLOP} = $1;}else{$xml->[0]{CurrentLOP} = "and"} while($input =~ m,&,gm){$tmp = pos($input);} $xml->[0]{CurrentAction} = substr($input,$tmp); # Sortorder e.g.: &-SortField=News_Dat&-SortOrder=Descend&-SortField=News_Zei&-SortOrder=Descend& if($input =~ m,&(-sortfield=[\w\W\s\S\d\D]*&-sortorder=[ascend|descend|ascending|descending|custom=][\w\W\s\S\d\D]*?)&,im){$xml->[0]{CurrentSort} = $1;}else{$xml->[0]{CurrentSort} = ""} } ### If FMPro DSO_XML/FMP_XML, parsing $input itself elsif ($input =~ m,<\?xml version="[\d.]*?" encoding="[\w\d]*?"\?><(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 - XML is no UTF-8."); } if($1 eq "FMPDSORESULT") { $xml->[0]{CurrentFormat} = "-dso_xml"; } else { $xml->[0]{CurrentFormat} = "-fmp_xml"; } } ### Error message else { return("Error - string is path or url or FMPro DSO_XML."); } # Conversion from UTF-8 to Latin1 if($switch eq "okUnicode") { $string = new Unicode::String($string); $string = $string->latin1(); } else { $string = UTF8_LATIN1($string); } ### Parsing FMPDSORESULT if ($xml->[0]{CurrentFormat} eq "-dso_xml") { my (@tmp,@tmp1,@tmp2,$k); # values read values, inclusive: # CurrentRecID, CurrentModID, CurrentLayout, CurrentDatabase, CurrentError if($string =~ m,(\d*?),mg){$xml->[0]{CurrentError} = $1;} if($string =~ m,([\w\W\s\S\d\D]*?),mg){$xml->[0]{CurrentDatabase} = $1;} if($string =~ m,([\w\W\s\S\d\D]*?),mg){$xml->[0]{CurrentLayout} = $1;} @tmp = $string =~ m,([\w\W\s\S\d\D]*?),mg; $xml->[0]{CurrentOutCount} = (scalar @tmp)/3; for ($i=0; $i<@tmp; $i+=3) { $xml->[$i/3]{CurrentModID} = $tmp[$i]; $xml->[$i/3]{CurrentRecID} = $tmp[$i+1]; $xml->[$i/3]{CurrentRecordNumber} = $i/3+1; @tmp1 = $tmp[$i+2] =~ m,<(?:DATA){0}([\w\W\s\S\d\D]*?)>([\w\W\s\S\d\D]*?),mg; # \1 ist wie $1, kann aber schon wrend des Suchvorganges benutzt werden for ($j=0; $j<@tmp1; $j+=2) { if(@tmp2 = $tmp1[$j+1] =~ m,([\w\W\s\S\d\D]*?),mg) { # Wiederholfeld for($k=0;$k<@tmp2;$k++) { $xml->[$i/3]{$tmp1[$j]}{Data}[$k] = $tmp2[$k]; } } else { $xml->[$i/3]{$tmp1[$j]}{Data}[0] = $tmp1[$j+1]; } } } } ### Parsing FMPXMLRESULT elsif ($xml->[0]{CurrentFormat} eq "-fmp_xml") { my ($tmp,@tmp,@tmp1,@tmp2,$i,$j,$k,$m,@FeldName); # 0 if($string =~ m,(\d*?),mg) { $xml->[0]{CurrentError} = $1; } # if($string =~ m,,m) { $xml->[0]{ProductBuild} = $1; $xml->[0]{ProductName} = $2; $xml->[0]{ProductVersion} = $3; } if($string =~ m,,mg) { $xml->[0]{DateFormat} = $1; $xml->[0]{CurrentLayout} = $2; $xml->[0]{CurrentDatabase} = $3; $xml->[0]{CurrentRecordCount} = $4; $xml->[0]{TimeFormat} = $5; } 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]}{EmptyOk} = $tmp[$i]; $xml->[0]{$tmp[$i+2]}{MaxReapeat} = $tmp[$i+1]; $xml->[0]{$tmp[$i+2]}{Type} = $tmp[$i+3]; $fieldname[$i/4] = $tmp[$i+2]; # Feldnamen fr nchste Schleife } } if($string =~ m,([\w\W\s\S\d\D]*?),m) { $xml->[0]{CurrentFoundCount} = $1; @tmp = $2 =~ m,([\w\W\s\S\d\D]*?),mg; for ($j=0; $j<@tmp; $j+=3) { $xml->[$j/3]{CurrentModID} = $tmp[$j]; $xml->[$j/3]{CurrentRecID} = $tmp[$j+1]; $xml->[$j/3]{CurrentRecordNumber} = $j/3+1; 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) { # Repead fiels with at least 2 repetitions @tmp2 = split(/<\/DATA>/,$tmp1[$k]); for($m=0;$m<@tmp2;$m++) { $xml->[$j/3]{$fieldname[$k]}{Data}[$m] = $tmp2[$m]; } } else { $xml->[$j/3]{$fieldname[$k]}{Data}[0] = $tmp1[$k]; } } } } } } return($xml); } ################################################################## # GET_DATEI_STRING # Reads file as string # # input: absolute path to file # # output: file contents ################################################################## sub GET_DATEI_STRING { my $file=$_[0]; my $fileInhalt = ''; my $FH = "FILE".int(rand()*10000); if (-e $file) { open ($FH, "< $file") || die "Kann Datei $file nicht oeffen: $!\n"; local $/; # Schluerfmodus switch on while (<$FH>) { $fileInhalt = $_; # complete file! } close ($FH) || die "Can't close the text file: $!\n"; } else {die "Can't open file $file";} return ($fileInhalt); } ################################################################## # 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; $_[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; $_[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::fmp2perl - FMPro- XML-parsing and output of field names, field values and requestparameters as reference. =head1 SYNOPSIS use FMPro::fmp2perl qw(fmp2perl); $tmp = ; or ; $values = fmp2perl($tmp); $title = $values->[0]{title}{Data}[0]; $database = $values->[0]{CurrentDatabase}; $RecID = $values->[0]{CurrentRecID}; $type = $values->[0]{title}{Type}; # only for FMPXMLRESULT =head1 DESCRIPTION FMPro::fmp2perl - FMPro- XML-parsing and output of field names, field values and requestparameters as reference. XML can be given as FMPDSORESULT or FMPXMLRESULT. fmp2perl is executable on Unix, WINDOWS and MAC systems. Only tested under ActivePerl 5,8. =head2 Input =over 4 =item B contains a XML structure of the form FMPBRESULT or FMPBRESULT. It is considered Utf-8 encoding only. =item B file contains a XML structure of the form FMPBRESULT or FMPBRESULT. It is considered Utf-8 encoding only. =item B contains a FMPro database request. =back =head2 Output Explanations concerning the output-table: I<$v = fmp2perl($tmp)> X/U - $tmp is an url in FMPXMLRESULT format X/FS - $tmp is a path to a file or a string ~ D/U - $tmp is an url in FMPDSORESULT format D/FS - $tmp is a path to a file or a string ~ Value - e.g. {}{data}[0]......$v->[0]{}{data}[0] with $v ->[0]- First data record {}- Name of the field {Data}- Output of field value [0]- 0. Repetition of a repetition-field and/or a field without repetition B x x {}{CurrentFoundCount} x x x x {}{Data}[0..-1] x x {}{EmptyOk} x x {}{MaxReapeat} x x {}{Type} x x x x {CurrentFormat} x x {CurrentAction} x x x x {CurrentDatabase} x x x x {CurrentError} x x x x {CurrentLayout} x x {CurrentLOP} x x {CurrentMax} x x x x {CurrentModID} Z<> Z<> x x {CurrentOutCount} x x {CurrentRecordCount} x x {CurrentSkip} x x {CurrentSort} x x x x {CurrentRecID} x x x x {CurrentRecordNumber} x x {DateFormat} x x {ProductBuild} x x {ProductName} x x {ProductVersion} x x {TimeFormat} x x {URL} All variable names were assigned following the CDML syntax. Therefore the reading of the CDML reference is recommended for the meaning of the values. Only exception: value {CurrentOutCount} ( e.g. $v->[2]{CurrentOutCount} ). {CurrentOutCount} - Number of data records in the XML structure; only with FMPDSORESULT =head1 EXAMPLE use FMPro::fmp2perl qw(fmp2perl); #Example with url FMPDSORESULT $tmp = "http://www.domain.com/FMPro?-db=your-database.fp5"; $tmp .= "&-lay=your-layout&-Format=-dso_xml&-FindAll="; $values = fmp2perl($tmp); # Example with url FMPXMLRESULT $tmp = "http://www.domain.com/FMPro?-db=your-database.fp5"; $tmp .= "&-lay=your-layout&-Format=-fmp_xml&-FindAll="; $values = fmp2perl($tmp); # Example with path to file (UNIX) $tmp = "/xml_data/path/fmp_xml_file.xml"; $values = fmp2perl($tmp); # Example with path to file (WINDOWS) $tmp = "C:\\Inetpub\\wwwroot\\xml_data_path\\fmp_xml_file.xml"; $values = fmp2perl($tmp); # Example with FMPBRESULT XML structure $tmp =<<__XML__; 0 YOUR-DATABASE.FP5 your title __XML__ $values = fmp2perl($tmp); # Example with FMPBRESULT XML structur $tmp =<<__XML__; 0 your title __XML__ $values = fmp2perl($tmp); $title = $values->[0]{title}{Data}[0]; $database = $values->[0]{CurrentDatabase}; $RecID = $values->[0]{CurrentRecID}; $type = $values->[0]{title}{Type}; # only for FMPXMLRESULT =head1 BUGS =head1 AUTHOR Hans-Martin Aurich info@webconsultant.de technik@baurat.de =head1 COPYRIGHT Copyright 2004 Hans-Martin Aurich. All rights reserved. =head1 SEE ALSO =cut