/ Forside / Teknologi / Udvikling / Perl / Nyhedsindlæg
Login
Glemt dit kodeord?
Brugernavn

Kodeord


Reklame
Top 10 brugere
Perl
#NavnPoint
bjarneA 141
poul_from 50
soccer 30
Nicknack 14
Tmpj 0
Hjælp ønskes til redigering af perl-script
Fra : Chr. Reventlow


Dato : 31-10-02 22:07

Jeg er i den uheldige situation, at en lille exe-fil jeg bruger i
forbindelse med opdatering af min slægtsforskningshjemme side er ophørt med
at virke efter at jeg har installeret Dansk Windows XP-pro.

Hele min database vedligeholdes iøvrigt via forskellige perl-scripts og
fungerer udmærket.

Det .exe-filen gjorde var at indlæse min database (en gedcom-fil kaldet
database.ged dvs flad tekstdatabase specielt lavet til brug for udveksling
af data mellem slægtsforskningsprogrammer. Databasen rummer over 16.000
enkeltpersoner) - Desuden indlæste exe-filen en supplerende fil
(billeder.txt), hvor jeg havde angivet hvilke personer jeg havde et
fotografi af, hvorefter exe-filen skrev en ny version af databasen, hvor
fotografierne var inkluderet.

Alt sammen såre simpelt (vist nok)

I Perl kan jeg godt lave et script, der læser de enkelte poster (individer)
fra min database - kombinerer det med oplysningerne fra den supplerende fil
(billeder.txt) og udskriver resultatet på skærmen således at der kun
indlæses billeder på de relevante personer.

Det jeg ikke kan finde ud af er at skrive disse oplysninger ind i databasen.
Dette har jeg brug for - for at kunne lave lister over hvilke personer, hvor
jeg har et billede, ligesom jeg bruger oplysningerne i anden sammenhæng.

Jeg har imidlertid en anden funktion, hvor jeg - til de personer, der
skønnes endnu at være i live (altså hvor jeg ikke i databasen har opgivet
nogen dødsdato, og hvor alderen ikke er mere end +100 år) kan tilføje
følgende tekst til databasen: "Living individual - details withheld.".

Det jeg har brug for er at kombinere disse to funktioner - altså at filtrere
billede fra billede.txt og skrive dem til databasen på samme måde som ved
"Living individual - details withheld.".

Formentlig også såre simpelt, men jeg ved bare ikke hvordan.

Strukturen i gedcom-databasen er som følger:

0 @I226@ INDI
1 NAME Evert/van Koot/
1 SEX M
1 NOTE Occupation: shopkeeper.
1 BIRT
2 DATE ABT 1808
2 PLAC Nijkerk, Gelderland, Netherlands
1 DEAT
2 DATE 7 NOV 1889
2 PLAC Nijkerk, Gelderland, Netherlands
1 FAMS @F141@
1 FAMC @F63@
0 @I227@ INDI
1 NAME Aaltje/van Koot/
1 SEX F
1 BIRT
2 DATE 7 JUL 1811
2 PLAC Nijkerk, Gelderland, Netherlands
1 FAMC @F63@
0 @I228@ INDI
1 NAME Ulla/van Koot/
1 SEX F
1 BIRT
2 DATE 7 JUL 1851
2 PLAC Nijkerk, Gelderland, Netherlands
1 FAMC @F65@

Hvert individ - hver post i databasen adskilles af:
0 @Ixxxx@ INDI, hvor xxxx angiver personens nummer i databasen

Her er altså tale om 3 personer.

Hvis vi nu antager, at min supplerende billedefil indeholder følgende
oplysninger:
I226|billede1.jpg (eller.gif eller andet format)
I227|billede2.jgp
I227|billede 3.jpg

Så har jeg brug for at perl-scriptet laver følgende resultat:
0 @I226@ INDI
1 NAME Evert/van Koot/
1 PHOT billede1.jpg
1 SEX M
1 NOTE Occupation: shopkeeper.
1 BIRT
2 DATE ABT 1808
2 PLAC Nijkerk, Gelderland, Netherlands
1 DEAT
2 DATE 7 NOV 1889
2 PLAC Nijkerk, Gelderland, Netherlands
1 FAMS @F141@
1 FAMC @F63@
0 @I227@ INDI
1 NAME Aaltje/van Koot/
1 PHOT billede2.jpg
1 PHOT billede3.jpg
1 SEX F
1 BIRT
2 DATE 7 JUL 1811
2 PLAC Nijkerk, Gelderland, Netherlands
1 FAMC @F63@
0 @I228@ INDI
1 NAME Ulla/van Koot/
1 SEX F
1 BIRT
2 DATE 7 JUL 1851
2 PLAC Nijkerk, Gelderland, Netherlands
1 FAMC @F65@

hvor der på linjen umiddelbart efter 1 NAME tilføjes en ny linje for hvert
billede vedr. den enkelte person:
1 PHOT billede1.jpg osv.

Jeg har følgende stumper kode i eet perlscript, som jeg mener er relevante:

$tmp = $ENV{'QUERY_STRING'};
( ($key) = ( $tmp =~ /(\w+)/ ) ) || &IGMDie("QUERY_STRING \"$tmp\" not in
correct format.");
$focus = $key; #Her får jeg defineret, at ID-nummeret på den person jeg
søger i databasen placeres i $focus

sub DoBillede {
open( BILLEDE, "billede.txt" );
@pic = <BILLEDE>;
close(BILLEDE);

foreach $i(@pic) {
( $id, $pic ) = split ( /\|/, $i );
if ( $id eq $focus ) { #her får jeg "fanget" de personer i filen
billede.txt med identifikationen $id som er identisk med $focus
push ( @matcher, $pic );
}
}
if (@matcher){
print "\n<br><IMG height=$height src=\"images\/$matcher[0]\">\n"; #her
sender jeg billede1.jpg til skærmen. Der kan tilføjes matcher[1..n]
}
}

Alt dette virker helt OK - og fungerer i praksis.

Jeg har i et andet perlscript følgende stump kode, som jeg tilsvarende mener
er relevant - og som skriver sætningen "Living Individual..." til databasen:

while (<GEDCOM>) {
($lvl,$tag,$rest)=/^(\d+)\s+(\S+) ?(.*)$/; #her får jeg "inddelt" den
grundlæggende databasestruktur i $lvl = 0,1,2 osv i $tag = fx NAME eller
PHOT og i $rest fx personens navn.

(....)

if ($tag=~/^@(.*)\@$/) {
$id=$1; #her finder jeg databasens poster.

(....)
og så følger den funktion der skriver "Living Individual..." til
databasen:

open(NEWGED,">database.ged");
$fixing='';
$count=0;
$lastrest='';
seek(GEDCOM,0,0);
while (<GEDCOM>) {
print "$count\r" unless ($count % 1000);
($lvl,$tag,$rest)=/^(\d+)\s+(\S+) ?(.*)$/;
if ($lvl eq '0') {
if (($fixing) && ($message) && ($lastrest eq 'INDI') && (!$opt_b)) {
$count++;
print NEWGED "1 NOTE $message\n" unless ($opt_b);
}
$fixing=$Living{$1} if ($tag=~/^@(.*)\@$/);
$lastrest=$rest;
$count++;
print NEWGED $_;
next;
}
if ($fixing) {
if ($opt_y) {
if ($tag eq 'DATE') {
($rest)=($rest=~/(\d\d\d\d)$/);
$count++;
print NEWGED "$lvl $tag $rest\n";
} else {
$count++;
print NEWGED $_;
}
} elsif ($keep{$tag}) {
$count++;
print NEWGED $_;
} elsif (($tag eq 'BIRT') && ($message) && ($lastrest eq 'INDI') &&
($opt_b)) {
$count+=2;
print NEWGED "1 BIRT\n";
print NEWGED "2 DATE $message\n"
}
} else {
$count++;
print NEWGED $_;
}
}
close(GEDCOM);
close(NEWGED);

Denne funktion skriver "Living individual..." til slutningen af den
enekelte post i databasen dvs som den allersidste linje

fx:
0 @I228@ INDI
1 NAME Ulla/van Koot/
1 SEX F
1 BIRT
2 DATE 7 JUL 1951
2 PLAC Nijkerk, Gelderland, Netherlands
1 FAMC @F65@
1 NOTE Living individual, details withheld

men jeg ville meget gerne have at den samtidig, såfremt der var et billede
knyttet til Ulla, at den istedet kunne skrive dette:

0 @I228@ INDI
1 NAME Ulla/van Koot/
1 PHOT ulla.jpg # hvor jeg så har defineret navnet ulla.jpg i filen
billede.txt
1 SEX F
1 BIRT
2 DATE 7 JUL 1951
2 PLAC Nijkerk, Gelderland, Netherlands
1 FAMC @F65@
1 NOTE Living individual, details withheld


Jeg håber alt dette giver mening og at der er en behjertet sjæl, der vil
hjælpe mig.

med venlig hilsen


Chr. Reventlow
web: www.reventlow.dk
email: cd@reventlow.dk





 
 
Lars Balker Rasmusse~ (31-10-2002)
Kommentar
Fra : Lars Balker Rasmusse~


Dato : 31-10-02 23:33

"Chr. Reventlow" <cd@reventlow.dk> writes:
[lang smøre]

Du kan starte med at hente indholdet af billede.txt ind i en hash:

my %pics;
open( BILLEDE, "billede.txt" );
my @pic = <BILLEDE>;
close(BILLEDE);

foreach my $line (@pic) {
my ( $id, $pic ) = split /\|/, $line;
push @{$pics{$id}}, $pic;
}

Jeg aner ikke præcis hvad strukturen i dit program er - der er for
mange $opt_'s og flag i sving til at jeg kan gætte præcis hvilken af
dine print's der printer "1 NAME " linien, hvorfor jeg har puttet PHOT
linien allersidst i while'n. Bemærk mine ændringer i linier uden "> "

> open(NEWGED,">database.ged");
> $fixing='';
> $count=0;
> $lastrest='';
> seek(GEDCOM,0,0);
> while (<GEDCOM>) {
> print "$count\r" unless ($count % 1000);
> ($lvl,$tag,$rest)=/^(\d+)\s+(\S+) ?(.*)$/;
> if ($lvl eq '0') {
> if (($fixing) && ($message) && ($lastrest eq 'INDI') && (!$opt_b)) {
> $count++;
> print NEWGED "1 NOTE $message\n" unless ($opt_b);
> }
if ($tag=~/^@(.*)\@$/) {
$current_id = $1;
$fixing=$Living{$1};
}
> $lastrest=$rest;
> $count++;
> print NEWGED $_;
> next;
> }
> if ($fixing) {
> if ($opt_y) {
> if ($tag eq 'DATE') {
> ($rest)=($rest=~/(\d\d\d\d)$/);
> $count++;
> print NEWGED "$lvl $tag $rest\n";
> } else {
> $count++;
> print NEWGED $_;
> }
> } elsif ($keep{$tag}) {
> $count++;
> print NEWGED $_;
> } elsif (($tag eq 'BIRT') && ($message) && ($lastrest eq 'INDI') &&
> ($opt_b)) {
> $count+=2;
> print NEWGED "1 BIRT\n";
> print NEWGED "2 DATE $message\n"
> }
> } else {
> $count++;
> print NEWGED $_;
> }

if ($lvl == 1 && $tag eq 'NAME') {
my @photos = @{$pics{$current_id}};
foreach (@photos) {
print "1 PHOT $_\n";
}
}
> }
> close(GEDCOM);
> close(NEWGED);

Ikke testet, men jeg tror det virker ;)
--
Lars Balker Rasmussen                  "S.M.R.T."

Kim Hansen (01-11-2002)
Kommentar
Fra : Kim Hansen


Dato : 01-11-02 01:34

"Chr. Reventlow" <cd@reventlow.dk> writes:

> Hele min database vedligeholdes iøvrigt via forskellige perl-scripts og
> fungerer udmærket.
[snip]
> Strukturen i gedcom-databasen er som følger:
[snip]

Det er ikke en løsning på dit spørgsmål, men har du prøvet at kigge på
de eksiterende Gedcom-moduler?
http://search.cpan.org/dist/Gedcom/

--
Kim Hansen | |\ _,,,---,,_ | Det er ikke
Dalslandsgade 8, A708 | /,`.-'`' -. ;-;;,_ | Jeopardy.
2300 København S | |,4- ) )-,_. ,\ ( `'-' | Svar _efter_
Phone: 32 88 60 86 | '---''(_/--' `-'\_) | spørgsmålet.

Søg
Reklame
Statistik
Spørgsmål : 177558
Tips : 31968
Nyheder : 719565
Indlæg : 6408914
Brugere : 218888

Månedens bedste
Årets bedste
Sidste års bedste