head 1.16; access; symbols; locks PRawlins:1.16; strict; comment @# @; 1.16 date 99.10.13.03.46.26; author PRawlins; state Exp; branches; next 1.15; 1.15 date 99.10.11.02.37.19; author rawlins; state Exp; branches; next 1.14; 1.14 date 99.09.29.23.25.51; author rawlins; state Exp; branches; next 1.13; 1.13 date 99.09.20.03.08.07; author rawlins; state Exp; branches; next 1.12; 1.12 date 99.09.19.03.46.50; author rawlins; state Exp; branches; next 1.11; 1.11 date 99.09.12.18.49.13; author rawlins; state Exp; branches; next 1.10; 1.10 date 99.09.06.03.50.04; author rawlins; state Exp; branches; next 1.9; 1.9 date 99.09.06.01.57.11; author rawlins; state Exp; branches; next 1.8; 1.8 date 99.08.24.16.07.33; author rawlins; state Exp; branches; next 1.7; 1.7 date 99.08.18.12.05.23; author PRawlins; state Exp; branches; next 1.6; 1.6 date 99.08.13.04.20.21; author PRawlins; state Exp; branches; next 1.5; 1.5 date 99.08.11.04.34.56; author PRawlins; state Exp; branches; next 1.4; 1.4 date 99.08.07.00.06.45; author PRawlins; state Exp; branches; next 1.3; 1.3 date 99.07.26.01.27.41; author PRawlins; state Exp; branches; next 1.2; 1.2 date 99.07.25.21.01.22; author PRawlins; state Exp; branches; next 1.1; 1.1 date 99.07.25.20.23.42; author PRawlins; state Exp; branches; next ; desc @Local modifications to gedcomToHTML.pl 1.45. @ 1.16 log @Replaced hardcoded ../gif with $gif_path. Use " instead of ' in hotlinks in order to allow ' in text string. @ text @#!/usr/local/bin/perl $_ = '$Revision: 1.15 $'; ($version) = m#:\s*([\d.]*)#; ################################################################# # WebbedGed # Translates gedcom files to html based on the gedcom 5.5 standard. # This work was originated from Dan Pidcock's gedcomToHtml, v1.45. # Copyright (C) 1999 Paul Rawlins # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # The license may also be obtained online at # http://www.fsf.org/copyleft/gpl.html. ################################################################# # Configuration options. If you need to customize any of these options, # the preferred method is to copy the appropriate lines to the file # WebbedGed.cfg located in the current directory and make the modifications # there. This maintains your customizations when new versions of # the code are released. $family_table = 1; # print family tree type table $print_family = 0; # print detailed family info $print_notes = 1; # Print an individual's notes $hot_links = 1; # Convert URL's in notes to hot links $check_images = 1; # Check for images in $out_dir/$photo_dir $private = 1; # Make birth information private $lds_ord = 1; # Include LDS ordinances $ped_generations = 5; # Number of generations for pedigree chart $debug = 0; # Enable debug statements to print $out_dir = "html"; # Directory where the HTML files will be stored $photo_dir = "pics"; # Directory where the individual's picture files are $root_id = 1; # RIN ID of individual to be at root of ped chart $add_gedcom_link = 1; # Flag indicating whether to add link to gedcom data $gedcom_link_path = ".."; # Path to gedcom data (no trailing slash) $gedcom_link_ext = ".gz"; # Additional extention added to gedcom data file $create_gendex = 0; # Create GENDEX output file # The file names for the frame-related files $top_frame_name = "WebbedGed_frame.html"; $top_form_name = "form.html"; # the tree gifs. Note lack of trailing /. $treepic_path = "../gif"; $gif_path = "../gif"; # The strings that are printed into files - change for different # languages $str_birth="Birth:"; $str_death="Death:"; $str_burial="Burial:"; $str_occupation="Occupation:"; $str_private="(Private)"; $str_father="Father:"; $str_mother="Mother:"; $str_child="Child"; $str_notes="Notes:"; $str_bap="Baptism:"; $str_end="Endowment:"; $str_slgc="Seal Parents:"; $str_slgs="Sealed"; $str_all_surnames="All surnames in the tree"; $str_people="People"; $str_surnames="Surnames"; $str_married="Married"; $str_on="on "; $str_at="at "; $str_list_of="List of"; $str_lpeople="List of people"; $str_lsurnames="List of surnames"; $str_people_and="people and"; $str_unique_names="unique names"; $str_m="m."; ####################################################################### # Leave the rest alone unless you know what's happenin' print "WebbedGed $version (c) Paul Rawlins 1999\n"; #if ($#ARGV != 0) { # die "usage: gedcomToHTML.pl \n"; #} $gedfile = $ARGV[0]; print "Gedcom file $gedfile\n"; if (-e "WebbedGed.cfg") { if (open (CFG, ") { chomp; if (/^\s*\$([a-zA-Z0-9_]+)\s*=\s*\"*([^\";]+)\"*\s*;/) { ${$1} = $2; print "Using: $1 = $2\n"; } } } else { warn "Cannot open config file. Using defaults."; } } if ($debug) { open (DBUG_OUT, ">dbug.out");} $in = "nothing"; $in1 = "nothing"; # Get this year in 4 figure format $curr_year = 1900 + (localtime(time))[5]; ####################################################################### # Make the directory and chdir to it if (!-e $out_dir) { unless (mkdir($out_dir,0755)) { die "Couldn't create $out_dir directory\n"; } } ################################################################# # Read the gedcom file in and created the individual and family # data structures. print "Reading information\n"; $| = 1; # flushing for progress report. $num_indivs = 0; $num_families = 0; $no_br_cont = 0; while (<>) { # Remove newline chomp; if (/^\s*0.*/) { # a 0 line if ($in1 != 0) # reset in1 {$in1 = "nothing";} if (/^\s*0\s*HEAD/) { # header $in = "header"; #print "Header $_"; } elsif (/^\s*0\s@@(.*)@@\sFAM/) { # family record $in = "family_record"; $fam_id = $1; $fams{$fam_id}++; $famc_cnt = 1; $num_families++; &show_reading_status; #print "Family $_"; } elsif (/^\s*0\s@@(.*)@@\sINDI/) { # individual record $in = "individual_record"; ($indiv_id = $1) =~ tr/I/i/; $indivs{$indiv_id}++; $num_indivs++; $num_fams = 0; # number of spouses &show_reading_status; #print "Individual $_"; } elsif (/^\s*0\sTRLR/) { # end of file $in = "nothing"; } elsif (/^\s*0\s_EVENT_DEFN/) { # custom event $in = "nothing"; } elsif (/^\s*0\s@@(.*)@@\sSUBM/) { # submission record - just ignore $in = "nothing"; } elsif (/^\s*0\s@@(.*)@@\sSOUR/) { # source record - just ignore $in = "nothing"; } elsif (/^\s*0\s@@(.*)@@\sNOTE/) { # note record - linked to an indi $note_id = $1; # Separate notes in separate lines with line break. $note{$note_id} = $note{$note_id}."
"; $in = "note_record"; } else { $in = "nothing"; print "Don't understand this 0 line: $_"; } } elsif (/^\s*1\s(.*)/) { # a 1 line $rol = $1; $in1 = "nothing"; if ($in eq "header") { ; # ignore the header } elsif ($in eq "family_record") { #print "\tfamily $fam_id $rol\n"; if ($rol =~ /HUSB\s@@(.*)@@/) { ($fam_husb{$fam_id} = $1) =~ tr/I/i/; } if ($rol =~ /WIFE\s@@(.*)@@/) { ($fam_wife{$fam_id} = $1) =~ tr/I/i/; } if ($rol =~ /CHIL\s@@(.*)@@/) { #$key = $fam_id."@@".$famc_cnt."@@".$1; #$fam_chil{$key} = $1; ($tmp_id = $1) =~ tr/I/i/; if ($famc_cnt == 1) { # First one $fam_chil{$fam_id} = $tmp_id;} else { $fam_chil{$fam_id} = $fam_chil{$fam_id}."@@".$tmp_id;} $key = $fam_id; $famc_cnt++; } elsif ($rol =~ /MARR.*/) { $in1 = "marriage"; } elsif ($rol =~ /SLGS.*/) { $in1 = "seal spouse"; } } elsif ($in eq "individual_record") { #print "\tindividual $indiv_id $rol\n"; if ($rol =~ /NAME\s(.*)/) { # convert the surname to italics $name = $1; $name =~ /(.*)\/(.*)\/(.*)/; $indiv_surname{$indiv_id} = $2; $indiv_forname{$indiv_id} = $1." ".$3; $_ = $name; s/\// /; s/\//<\/i>/; $indiv_name{$indiv_id} = $_; $_ = $name; s/\// /g; $indiv_name_unformatted{$indiv_id} = $_; } elsif ($rol =~ /SEX\s(.)/) { $indiv_sex{$indiv_id} = $1; } elsif ($rol =~ /BIRT.*/) { $in1 = "birth"; } elsif ($rol =~ /DEAT.*/) { $in1 = "death"; } elsif ($rol =~ /BURI.*/) { $in1 = "burial"; } elsif ($rol =~ /BAPL.*/) { $in1 = "baptism"; } elsif ($rol =~ /ENDL.*/) { $in1 = "endowment"; } elsif ($rol =~ /SLGC.*/) { $in1 = "seal parents"; } elsif ($rol =~ /OCCU\s(.*)/) { $indiv_occu{$indiv_id} = $1; } elsif ($rol =~ /NOTE\s@@(.*)@@/) { # note with link to level 0 note record #$indiv_note_link{$indiv_id} = $1; ($tmp_id = $1) =~ tr/I/i/; $note_indiv_link{$tmp_id} = $indiv_id; $in1 = "notes"; } elsif ($rol =~ /NOTE\s(.*)\\$/) { $indiv_note{$indiv_id} = $indiv_note{$indiv_id}."
\n$1"; $no_br_cont = 1; } elsif ($rol =~ /NOTE\s(.*)/) { $indiv_note{$indiv_id} = $1 . "
\n"; $no_br_cont = 0; $in1 = "notes"; } elsif ($rol =~ /FAMC\s@@(.*)@@/) { # child to family link ($indiv_famc{$indiv_id} = $1) =~ tr/I/i/; } elsif ($rol =~ /FAMS\s@@(.*)@@/) { # spouse to family link ($tmp_id = $1) =~ tr/I/i/; if ($num_fams > 0) { $indiv_fams{$indiv_id} = $indiv_fams{$indiv_id}."@@".$tmp_id; } else { $indiv_fams{$indiv_id} = $tmp_id; } $num_fams++; } } elsif ($in eq "note_record") { # $note_id has the note link code if ($rol =~ /CONT\s?(.*)\\$/) { if ($no_br_cont) { $note{$note_id} = $note{$note_id}."$1"; } else { $note{$note_id} = $note{$note_id}."
\n$1"; } $no_br_cont = 1; } elsif ($rol =~ /CONC\s?(.*)/) { $note{$note_id} = $note{$note_id}."$1"; } elsif ($rol =~ /CONT\s?(.*)/) { if ($no_br_cont) { $note{$note_id} = $note{$note_id}."$1"; } else { $note{$note_id} = $note{$note_id}."
\n$1"; } $no_br_cont = 0; } } } # end if a 1 line elsif (/^\s*2\s(.*)/) { # a 2 line $rol = $1; if ($in1 eq "birth") { if ($rol =~ /DATE\s(.*)/) { $indiv_birt_date{$indiv_id} = $1; $indiv_birt{$indiv_id} = 1; } elsif ($rol =~ /PLAC\s(.*)/) { $indiv_birt_plac{$indiv_id} = $1; $indiv_birt{$indiv_id} = 1; } } elsif ($in1 eq "baptism") { if ($rol =~ /DATE\s(.*)/) { $indiv_bap_date{$indiv_id} = $1; $indiv_bap{$indiv_id} = 1; } elsif ($rol =~ /PLAC\s(.*)/) { $indiv_bap_plac{$indiv_id} = $1; $indiv_bap{$indiv_id} = 1; } } elsif ($in1 eq "endowment") { if ($rol =~ /DATE\s(.*)/) { $indiv_end_date{$indiv_id} = $1; $indiv_end{$indiv_id} = 1; } elsif ($rol =~ /STAT\s(.*)/) { $indiv_end_plac{$indiv_id} = $1; $indiv_end{$indiv_id} = 1; } elsif ($rol =~ /TEMP\s(.*)/) { $indiv_end_plac{$indiv_id} = $1; $indiv_end{$indiv_id} = 1; } elsif ($rol =~ /PLAC\s(.*)/) { $indiv_end_plac{$indiv_id} = $1; $indiv_end{$indiv_id} = 1; } } elsif ($in1 eq "seal parents") { if ($rol =~ /DATE\s(.*)/) { $indiv_slgc_date{$indiv_id} = $1; $indiv_slgc{$indiv_id} = 1; } elsif ($rol =~ /STAT\s(.*)/) { $indiv_slgc_plac{$indiv_id} = $1; $indiv_slgc{$indiv_id} = 1; } elsif ($rol =~ /TEMP\s(.*)/) { $indiv_slgc_plac{$indiv_id} = $1; $indiv_slgc{$indiv_id} = 1; } elsif ($rol =~ /PLAC\s(.*)/) { $indiv_slgc_plac{$indiv_id} = $1; $indiv_slgc{$indiv_id} = 1; } } elsif ($in1 eq "death") { if ($rol =~ /DATE\s(.*)/) { $indiv_deat_date{$indiv_id} = $1; $indiv_deat{$indiv_id} = 1; } elsif ($rol =~ /PLAC\s(.*)/) { $indiv_deat_plac{$indiv_id} = $1; $indiv_deat{$indiv_id} = 1; } } elsif ($in1 eq "burial") { if ($rol =~ /DATE\s(.*)/) { $indiv_buri_date{$indiv_id} = $1; $indiv_buri{$indiv_id} = 1; } elsif ($rol =~ /PLAC\s(.*)/) { $indiv_buri_plac{$indiv_id} = $1; $indiv_buri{$indiv_id} = 1; } } elsif ($in1 eq "notes") { if ($rol =~ /CONT\s?(.*)\\$/) { if ($no_br_cont) { $indiv_note{$indiv_id} = $indiv_note{$indiv_id}."$1"; } else { $indiv_note{$indiv_id} = $indiv_note{$indiv_id}."
\n$1"; } $no_br_cont = 1; } elsif ($rol =~ /CONC\s?(.*)/) { $indiv_note{$indiv_id} = $indiv_note{$indiv_id}."$1"; } elsif ($rol =~ /CONT\s?(.*)/) { if ($no_br_cont) { $indiv_note{$indiv_id} = $indiv_note{$indiv_id}."$1"; } else { $indiv_note{$indiv_id} = $indiv_note{$indiv_id}."
\n$1"; } $no_br_cont = 0; } } elsif ($in1 eq "marriage") { if ($rol =~ /DATE\s(.*)/) { $fam_marr_date{$fam_id} = $1; $fam_marr{$fam_id} = 1; } elsif ($rol =~ /PLAC\s(.*)/) { $fam_marr_plac{$fam_id} = $1; $fam_marr{$fam_id} = 1; } } elsif ($in1 eq "seal spouse") { if ($rol =~ /DATE\s(.*)/) { $fam_slgs_date{$fam_id} = $1; $fam_slgs{$fam_id} = 1; } elsif ($rol =~ /STAT\s(.*)/) { $indiv_slgs_plac{$indiv_id} = $1; $indiv_slgs{$indiv_id} = 1; } elsif ($rol =~ /TEMP\s(.*)/) { $indiv_slgs_plac{$indiv_id} = $1; $indiv_slgs{$indiv_id} = 1; } elsif ($rol =~ /PLAC\s(.*)/) { $fam_slgs_plac{$fam_id} = $1; $fam_slgs{$fam_id} = 1; } } } # end if a 2 line } ################################################################# # Link note data to individual records foreach $note_id (keys %note) { $indiv_note{$note_indiv_link{$note_id}} = $indiv_note{$note_indiv_link{$note_id}}.$note{$note_id}; } ################################################################# # Set up the HTML for the top and bottom of individual's files if (open(IN_FILE, "tpl_ind_top.html")) { $i = 0; while () { $html_ind_top[$i] = $_; $i++; } } else { # use defaults $html_ind_top[0] = "\n"; $html_ind_top[1] = "
\n"; $html_ind_top[2] = button_bar("grp", $indiv_id, 0); $html_ind_top[3] = "
\n"; $html_ind_top[4] = "

#ind_name

\n"; } close(IN_FILE); if (open(IN_FILE, "tpl_ind_bot.html")) { $i = 0; while () { $html_ind_bot[$i] = $_; $i++; } } else { # use defaults $html_ind_bot[0] = "
\n"; $html_ind_bot[1] = button_bar("grp", $indiv_id, 2); $html_ind_bot[2] = "
\n"; } close(IN_FILE); ################################################################# # show results print "\nCreating individual files\n"; $ind_cnt = 0; # make a file for each individual foreach $indiv_id (keys %indivs) { $ind_cnt++; if ($debug) { print DBUG_OUT "$ind_cnt\n"; } print "$ind_cnt\r"; # Clear out $div_str and $grp_out_str $div_str = ""; $grp_out_str = ""; $switch_str = ""; # open an output file unless (open(GRP_OUT, ">$out_dir/$indiv_id.html")) { die "\nCouldn't open output file $out_dir/$indiv_id.html\n"; } # Split the list of spouse families into @@fams. # Need to clear the array for some versions of perl. @@fams = (); @@fams = split(/@@/, $indiv_fams{$indiv_id}); #print "Fams:@@fams\n"; $famc = $indiv_famc{$indiv_id}; ############################################################## # print the information to file # Make birth info private if required and person alive if ($private && $indiv_deat{$indiv_id} == 0) { # No death record - check if born too long ago if ($indiv_birt_date{$indiv_id} =~ /([0-9][0-9][0-9][0-9])/) { $year = $1; if ($year > $curr_year) { print "Individual $indiv_id has birth date ($1) after this year ($curr_year)\n"; } elsif ($year+120 > $curr_year) { # May be alive &make_birt_private($indiv_id); } } else { # Couldn't find a birth year - make private &make_birt_private($indiv_id); } } # Check if there is a phot for the individual # Thanks to Bob Minteer for the code this is based on if ($check_images) { if (-r "$out_dir/$photo_dir/$indiv_id.jpg") { $imgpath{$indiv_id}="$photo_dir/$indiv_id.jpg"; } elsif (-r "$out_dir/$photo_dir/$indiv_id.gif") { $imgpath{$indiv_id}="$photo_dir/$indiv_id.gif"; } else { $imgpath{$indiv_id}=""; } } # print HTML at top of page # $html_ind_top_l = @@html_ind_top; # for ($i = 0; $i < $html_ind_top_l; $i++) { # $_ = $html_ind_top[$i]; # s/\#ind_name/$indiv_name{$indiv_id}/ei; # $grp_out_str .= $_; # if (($check_images) && ($imgpath{$indiv_id} ne "") && (/\n"; # } # } $grp_out_str .= "\n"; $grp_out_str .= "
\n"; $grp_out_str .= button_bar("grp", $indiv_id, 0); $grp_out_str .= "
\n"; $grp_out_str .= "

$indiv_name{$indiv_id}

\n"; $grp_out_str .= &create_vital_info($indiv_id); # print marriage info if more than just spouse name is known if (!$print_family) { &print_marriages; } if ($family_table || $print_family) { &get_parent_data; &get_child_data; } # If $family_table then print the ancestors chart (needs $father, # $mother, $pgfather etc., $famc. if ($family_table) { &get_gparent_data; # family chart $grp_out_str .= "

\n\n"; if (($father ne "") || ($mother ne "")) { # Ancestors $grp_out_str .= "\n

\n"; } # end if has a parent $fams_len = @@fams; if ($fams_len != 0) { # Spouse(s) and their children for ($fams_num=0; $fams_num < $fams_len; $fams_num++) { &get_spouse_data($fams[$fams_num]); &get_child_data($fams[$fams_num]); if ($num_children > 0) { $grp_out_str .= "\n

\n"; } # end if has children else { #no children so just put marriage for consistency $grp_out_str .= "\n"; $grp_out_str .= "\n"; add_div($spouse_id); add_switch($spouse_id); } } # end for each family } # end if has spouses $grp_out_str .= "
\n"; $grp_out_str .= "\n"; # Paternal Grandfather if ($pgfather_id ne "") { $grp_out_str .= "\n"; add_div($pgfather_id); add_switch($pgfather_id); } else { $grp_out_str .= "\n"; } # Paternal Grandmother if ($pgmother_id ne "") { $grp_out_str .= "\n"; add_div($pgmother_id); add_switch($pgmother_id); } else { $grp_out_str .= "\n"; } # Maternal Grandfather if ($mgfather_id ne "") { $grp_out_str .= "\n"; add_div($mgfather_id); add_switch($mgfather_id); } else { $grp_out_str .= "\n"; } # Maternal Grandmother if ($mgmother_id ne "") { $grp_out_str .= "\n"; add_div($mgmother_id); add_switch($mgmother_id); } else { $grp_out_str .= "\n"; } $grp_out_str .= "\n\n"; if (($pgfather ne "") || ($pgmother ne "")) {$grp_out_str .= "\n";} else {$grp_out_str .= "\n";} if (($mgfather ne "") || ($mgmother ne "")) {$grp_out_str .= "\n";} else {$grp_out_str .= "\n";} $grp_out_str .= "\n"; $grp_out_str .= "\n"; # Father $grp_out_str .= "\n"; add_div($father_id); add_switch($father_id); # Mother $grp_out_str .= "\n"; add_div($mother_id); add_switch($mother_id); $grp_out_str .= "\n"; $grp_out_str .= "\n"; if (($father ne "") || ($mother ne "")) {$grp_out_str .= "\n";} else {$grp_out_str .= "\n";} $grp_out_str .= "\n"; $grp_out_str .= "\n"; $grp_out_str .= "\n"; $grp_out_str .= "
$pgfather$pgmother$mgfather$mgmother
$father$mother
$indiv_name{$indiv_id}
\n
\n\n"; $grp_out_str .= "\n"; if ($num_children > 8) { $cwidth=9; } else { $cwidth = $num_children; } $grp_out_str .= "\n"; add_div($spouse_id); add_switch($spouse_id); # the children $start_child = 0; while (($num_children - $start_child) > 8) { # print the 8 child tree with extra leg coming down $grp_out_str .= "\n"; # print the first 8 children $cell_width = 600/9; $grp_out_str .= ""; for ($i = $start_child; $i < $start_child+4; $i++) { $grp_out_str .= "\n"; add_div($child[$i]); add_switch($child[$i]); } $grp_out_str .= "\n"; for ($i = $start_child+4; $i < $start_child+8; $i++) { $grp_out_str .= "\n"; add_div($child[$i]); add_switch($child[$i]); } $grp_out_str .= "\n"; $start_child += 8; } # print the rest of the children $num_left = $num_children-$start_child; $grp_out_str .= "\n"; $grp_out_str .= "
"; $grp_out_str .= $str_m; if ($fams_len > 1) { $i = $fams_num+1; $grp_out_str .= "($i) "; } # Spouse $grp_out_str .= "$spouse
"; $grp_out_str .= "
"; $grp_out_str .= "$indiv_name{$child[$i]}
"; $grp_out_str .= "
"; $grp_out_str .= "$indiv_name{$child[$i]}
\n"; $grp_out_str .= ""; $grp_out_str .= "\n"; $cell_width = int(600/$num_left); $grp_out_str .= ""; for ($i = $start_child; $i < $num_children; $i++) { $grp_out_str .= "\n"; add_div($child[$i]); add_switch($child[$i]); } $grp_out_str .= "
"; $grp_out_str .= "
"; $grp_out_str .= "$indiv_name{$child[$i]}

\n
"; $grp_out_str .= $str_m; if ($fams_len > 1) { $i = $fams_num+1; $grp_out_str .= "($i) "; } $grp_out_str .= "$spouse

\n

\n"; } # end if family_table # If $print_family then print parents, marriage(s), children. # Uses $father, $mother, @@child, $famc, $fams. if ($print_family) { # parents if ($father ne "") { $grp_out_str .= "$str_father $father
\n"; add_div($father_id); add_switch($father_id); } if ($mother ne "") { $grp_out_str .= "$str_mother $mother

\n"; add_div($mother_id); add_switch($mother_id); } $grp_out_str .= "

\n"; # spouse, marriage date and place and children &print_marriages(1); } # end if print_family $grp_out_str .= "

\n"; # notes if ($print_notes && $indiv_note{$indiv_id}) { $grp_out_str .= "


\n"; $grp_out_str .= button_bar("grp", $indiv_id, 1); $grp_out_str .= "
\n"; $grp_out_str .= "

$str_notes

\n"; @@note_lines = split (/\n/, $indiv_note{$indiv_id}); foreach $note_line (@@note_lines) { $grp_out_str .= get_note_link($note_line) . "\n"; } $grp_out_str .= "

\n"; } # Print out Div constructs $grp_out_str .= $div_str; print GRP_OUT "\n"; print GRP_OUT "\n"; print GRP_OUT "\n"; print GRP_OUT "$indiv_name_unformatted{$indiv_id} \n"; print GRP_OUT "($indiv_birt_date{$indiv_id} - \n"; print GRP_OUT "$indiv_deat_date{$indiv_id})\n"; print GRP_OUT "\n"; print GRP_OUT "\n"; print GRP_OUT "\n\n"; print GRP_OUT $grp_out_str; # print HTML at bottom of page # print GRP_OUT @@html_ind_bot; print GRP_OUT "


\n"; print GRP_OUT button_bar("grp", $indiv_id, 2); print GRP_OUT "
\n"; # print GRP_OUT "\n"; print GRP_OUT &print_footer; close(GRP_OUT); # Create Pedigree Chart # Clear out $div_str and $ped_out_str $div_str = ""; $ped_out_str = ""; $switch_str = ""; unless (open(PED_OUT, ">$out_dir/p$indiv_id.html")) { die "\nCouldn't open output file $out_dir/p$indiv_id.html\n"; } ($bogus, $ped_depth) = ped_parse ($indiv_id, 1, 1); # Print Generation Header $ped_out_str .= ""; if ($debug) { print DBUG_OUT "ped_depth = $ped_depth\n"; } for ($cnt = 1; $cnt <= $ped_depth; $cnt++) { $ped_out_str .= "$cnt"; } $ped_out_str .= "\n"; ped_print (1, 1, 0, 0, 1); $ped_out_str .= "\n"; $ped_out_str .= "\n"; $ped_out_str .= "
\n"; $ped_out_str .= button_bar("ped", $indiv_id, 1); $ped_out_str .= "
\n"; # Print out Div constructs $ped_out_str .= $div_str; $ped_out_str .= "

\n"; # Print to file print PED_OUT "\n"; print PED_OUT "\n"; print PED_OUT "$indiv_name_unformatted{$indiv_id} \n"; print PED_OUT "($indiv_birt_date{$indiv_id} - \n"; print PED_OUT "$indiv_deat_date{$indiv_id})\n"; print PED_OUT "\n"; print PED_OUT "\n"; print PED_OUT "\n\n"; print PED_OUT "\n"; print PED_OUT "


\n"; print PED_OUT button_bar("ped", $indiv_id, 0); print PED_OUT "
\n"; print PED_OUT "\n"; print PED_OUT "
\n"; print PED_OUT "\n"; print PED_OUT $ped_out_str; print PED_OUT "
\n"; print PED_OUT "
\n"; # print PED_OUT "\n"; print PED_OUT &print_footer; close PED_OUT; } # end foreach $indiv_id (keys %indivs) ############################################# # make a list of people file # open an output file print "\rCreating people file\n"; unless (open(PPL_OUT, ">$out_dir/people.html")) { die "Couldn't open output file $out_dir/people.html\n"; } if ($create_gendex) { unless (open(GENDEX, ">gendex.txt")) { die "Couldn't open output file gendex.txt\n"; } } if (open(TPL_FILE, "tpl_people.html")) { print "Using people template file\n"; $i = 0; while () { $fline[$i] = $_; $i++; } # while close(TPL_FILE); } else { # use defaults @@fline = ( "$str_people\n\n\n", "
\n", button_bar("ppl", 0, 0), "
\n", "

$str_lpeople

($num_indivs $str_people_and $num_families $str_unique_names)

\n", "#main", # "#ns ", "#ind_surname, #ind_forname (#ind_birt_date - #ind_deat_date) #photo
", "#end", "


\n", button_bar("ppl", 0, 1), "
\n", "#footer" ); } $fline = @@fline; for ($j = 0; $j < $fline; $j++) { $_ = $fline[$j]; if (/#main/) { # do the main loop of all people # read in the format $i = 0; $nsi = 0; until ($line =~ /#end/) { $j++; $line = $fline[$j]; $ns[$i] = 0; if ($line =~ /#ns(.*\n)/) { # if ($line =~ /#ns(.*)/) { $line = $1; $ns[$i] = 1; } $out_fmt[$i] = $line; $i++; } $out_fmt[$i-1]=""; # get rid of #end $len = @@out_fmt; $old_surname = "-o-o-"; foreach $indiv_id (sort by_surname keys %indivs) { $ns_this = (($indiv_surname{$indiv_id} ne $old_surname) && ($indiv_surname{$indiv_id} ne "")); if ($ns_this) {$old_surname = $indiv_surname{$indiv_id};} for ($i = 0; $i < $len; $i++) { if ($ns_this || !$ns[$i]) { # print new sentence lines only when this is $line = $out_fmt[$i]; $line =~ s/#ind_id/$indiv_id/gei; $line =~ s/#ind_forname/$indiv_forname{$indiv_id}/gei; $line =~ s/#ind_surname/$indiv_surname{$indiv_id}/gei; $line =~ s/#ind_birt_date/$indiv_birt_date{$indiv_id}/gei; $line =~ s/#ind_deat_date/$indiv_deat_date{$indiv_id}/gei; if (($check_images) && ($imgpath{$indiv_id} ne "")) { $line =~ s/#photo/\\(photo available\)\<\/em\>/gi; } else { $line =~ s/#photo//gei; } # get rid of private birth date $line =~ s/\(\($str_private\) - \)/$str_private/; print PPL_OUT $line; } } if ($create_gendex) { print GENDEX "$indiv_id.html|"; print GENDEX "$indiv_surname{$indiv_id}|"; print GENDEX "$indiv_forname{$indiv_id}\/$indiv_surname{$indiv_id}\/|"; print GENDEX "$indiv_birt_date{$indiv_id}|"; print GENDEX "$indiv_birt_plac{$indiv_id}|"; print GENDEX "$indiv_deat_date{$indiv_id}|"; print GENDEX "$indiv_deat_plac{$indiv_id}|\n"; } } # end for each individual @@out_fmt = (); } elsif (/#footer/) { print PPL_OUT &print_footer; } else { print PPL_OUT $_; } } # for i=0 to $fline close(PPL_OUT); close(GENDEX) if ($create_gendex); ############################################# # make a surname file unless (open(SUR_OUT, ">$out_dir/surnames.html")) { die "Couldn't open output file $out_dir/surnames.html\n"; } print "Creating surnames file\n"; if (open(TPL_FILE, "tpl_surnames.html")) { print "Using surnames template file\n"; while () { if (/#main/) { # do the main loop of all surnames # read in the format $i = 0; until ($line =~ /#end/) { $line = ; $out_fmt[$i] = $line; $i++; } $out_fmt[$i-1]=""; # get rid of #end $len = @@out_fmt; $old_surname="-o-o-"; # so that empty surnames show up foreach $indiv_id (sort by_surname keys %indiv_surname) { if (lc($indiv_surname{$indiv_id}) ne $old_surname) { for ($i = 0; $i < $len; $i++) { $line = $out_fmt[$i]; $line =~ s/#ind_surname/$indiv_surname{$indiv_id}/gei; print SUR_OUT $line; } $old_surname = lc($indiv_surname{$indiv_id}); } } # end for each individual @@out_fmt = (); } elsif (/#footer/) { print SUR_OUT &print_footer; } else { print SUR_OUT $_; } } # while close(TPL_FILE); } else { # use the default layout print SUR_OUT "Surnames\n\n"; print SUR_OUT "\n"; print SUR_OUT "
\n"; print SUR_OUT button_bar("sur", 0, 0); print SUR_OUT "
\n"; print SUR_OUT "

$str_all_surnames

\n"; print SUR_OUT "$str_list_of $num_indivs $str_people_and $num_families $str_unique_names

\n"; $old_surname="-o-o-"; # so that empty surnames show up foreach $indiv_id (sort by_surname keys %indiv_surname) { if (lc($indiv_surname{$indiv_id}) ne $old_surname) { print SUR_OUT ""; print SUR_OUT "$indiv_surname{$indiv_id}
\n"; $old_surname = lc($indiv_surname{$indiv_id}); } } print SUR_OUT "


\n"; print SUR_OUT button_bar("sur", 0, 1); print SUR_OUT "
\n"; print SUR_OUT &print_footer; } close(SUR_OUT); ############################################# # make toplevel frame file unless (open(FRAME_OUT, ">$out_dir/$top_frame_name")) { die "Couldn't open output file $out_dir/$top_frame_name\n"; } print "Creating toplevel frame file, $top_frame_name\n"; print FRAME_OUT "\n"; print FRAME_OUT "\n"; print FRAME_OUT "\n"; print FRAME_OUT "\n"; close(FRAME_OUT); ############################################# # make toplevel form file unless (open(FORM_OUT, ">$out_dir/$top_form_name")) { die "Couldn't open output file $out_dir/$top_form_name\n"; } print "Creating toplevel form file, $top_form_name\n"; print FORM_OUT "
\n"; print FORM_OUT "Birth:
\n"; print FORM_OUT "
\n"; print FORM_OUT "
\n"; print FORM_OUT "

\n"; print FORM_OUT "

\n"; print FORM_OUT "Death:
\n"; print FORM_OUT "
\n"; print FORM_OUT "
\n"; print FORM_OUT "

\n"; print FORM_OUT "

\n"; print FORM_OUT "Burial:
\n"; print FORM_OUT "
\n"; print FORM_OUT "
\n"; print FORM_OUT "

\n"; print FORM_OUT "

\n"; if ($lds_ord) { print FORM_OUT "Baptism:
\n"; print FORM_OUT "
\n"; print FORM_OUT "
\n"; print FORM_OUT "

\n"; print FORM_OUT "

\n"; print FORM_OUT "Endowment:
\n"; print FORM_OUT "
\n"; print FORM_OUT "
\n"; print FORM_OUT "

\n"; print FORM_OUT "

\n"; print FORM_OUT "Sealing Parents:
\n"; print FORM_OUT "
\n"; print FORM_OUT "
\n"; print FORM_OUT "

\n"; } print FORM_OUT "
\n"; close(FORM_OUT); ############################################# # sort by surname sub by_surname { $lca = lc($indiv_surname{$a}); $lcb = lc($indiv_surname{$b}); $lca cmp $lcb || $indiv_forname{$a} cmp $indiv_forname{$b} || $indiv_birt_date{$a} cmp $indiv_birt_date{$b} || $a cmp $b; } ############################################# # Show the status of reading the file # In: $num_indivs, $num_families sub show_reading_status { print "$num_indivs individuals, $num_families families\r"; } ############################################# # Uses OUT_FILE. sub print_footer { my $ft_str = "Created by Paul Rawlins' "; my $gmtime = gmtime; $ft_str .= ""; $ft_str .= "WebbedGed Gedcom to HTML converter \n"; $ft_str .= "v$version.
\n"; $ft_str .= "Generated from "; if ($add_gedcom_link) { $ft_str .= "\n"; $ft_str .= "$gedfile$gedcom_link_ext "; } else { $ft_str .= "$gedfile$gedcom_link_ext "; } $ft_str .= "at $gmtime GMT
\n"; $ft_str .= "\n"; return $ft_str; } ############################################# # Uses OUT_FILE, $spouse, $spouse_id, $fams. sub print_marriages { $long = $_[0]; # if set then print children too $fams_len = @@fams; for ($fams_num=0; $fams_num < $fams_len; $fams_num++) { &get_spouse_data($fams[$fams_num]); if (($spouse ne "") || $fam_marr{$fams[$fams_num]}) { $grp_out_str .= "
$str_married "; if ($fams_len > 1) { $i = $fams_num+1; $grp_out_str .= "($i) "; } } if ($spouse ne "") { # Spouse $grp_out_str .= "$spouse"; } if ($fam_marr{$fams[$fams_num]}) { if ($fam_marr_date{$fams[$fams_num]}) { $grp_out_str .= " $str_on$fam_marr_date{$fams[$fams_num]}"; } if ($fam_marr_plac{$fams[$fams_num]}) { $grp_out_str .= " $str_at$fam_marr_plac{$fams[$fams_num]}"; } } $grp_out_str .= "\n"; if ($lds_ord && $fam_slgs{$fams[$fams_num]}) { $grp_out_str .= "
$str_slgs "; if ($fam_slgs_date{$fams[$fams_num]}) { $grp_out_str .= " $str_on$fam_slgs_date{$fams[$fams_num]}"; } if ($fam_slgs_plac{$fams[$fams_num]}) { $grp_out_str .= " $str_at$fam_slgs_plac{$fams[$fams_num]}"; } $grp_out_str .= "\n"; } if ($long) { &get_child_data($fams[$fams_num]); # children (in order of fam entry) for ($i = 0; $i < $num_children; $i++) { # Child $child_num = $i+1; $grp_out_str .= "
$str_child $child_num: $indiv_name{$child[$i]}
\n"; add_div($child[$i]); add_switch($child[$i]); } } $grp_out_str .= "

\n"; } } ############################################# # Sets $father_id, $father, $mother_id, $mother. # Uses $famc. sub get_parent_data { # get parents $father = ""; $mother = ""; $father_id = $fam_husb{$famc}; $mother_id = $fam_wife{$famc}; $father = $indiv_name{$father_id}; $mother = $indiv_name{$mother_id}; } ############################################# # Sets $pgfather_id, $pgfather, $pgmother_id, $pgmother etc. # Uses $father_id, $mother_id. sub get_gparent_data { $pgfather = ""; $pgmother = ""; $mgfather = ""; $mgmother = ""; if ($father ne "") { $pgfather_id = $fam_husb{$indiv_famc{$father_id}}; $pgfather = $indiv_name{$pgfather_id}; $pgmother_id = $fam_wife{$indiv_famc{$father_id}}; $pgmother = $indiv_name{$pgmother_id}; } if ($mother ne "") { $mgfather_id = $fam_husb{$indiv_famc{$mother_id}}; $mgfather = $indiv_name{$mgfather_id}; $mgmother_id = $fam_wife{$indiv_famc{$mother_id}}; $mgmother = $indiv_name{$mgmother_id}; } } ############################################# # Put in subroutine by Dale dePriest # Sets $spouse_id, $spouse. # Uses $indiv_id.. # Parameter family that spouse is in. sub get_spouse_data { $this_fam = $_[0]; # get spouse (assume opposite sex) if ($indiv_sex{$indiv_id} eq "M") { $spouse_id = $fam_wife{$this_fam}; } elsif ($indiv_sex{$indiv_id} eq "F") { $spouse_id = $fam_husb{$this_fam}; } $spouse = $indiv_name{$spouse_id}; } ############################################# # Put in subroutine by Dale dePriest # Sets @@child. # Uses %fam_chil. # Parameter family that children are in. sub get_child_data { $this_fam = $_[0]; # get children (in order of fam entry) if ($this_fam) { # Split the children list into @@child @@child = split(/@@/, $fam_chil{$this_fam}); $num_children = @@child; } } ############################################# # Make birth information of an individual private # Parameter individual ID number sub make_birt_private { $indiv_birt_date{$_[0]} = "$str_private"; $indiv_birt_plac{$_[0]} = ""; } ############################################# # Make a string lower case sub lc { $s = pop(@@_); tr/A-Z/a-z/; } sub get_note_link { my $parse_string = shift; if ($parse_string =~ /(http:.*)
/) { return "$`
"; } else { return $parse_string; } } sub add_switch { my $id = pop(@@_); $switch_str .= "case \"$id\":\n"; # birth date if ($indiv_birt_date{$id}) { $switch_str .= "top.fframe.document.vform.birthd.value = \"$indiv_birt_date{$id}\"\n"; } # birth place if ($indiv_birt_plac{$id}) { $switch_str .= "top.fframe.document.vform.birthp.value = \"$indiv_birt_plac{$id}\"\n"; } # death date if ($indiv_deat_date{$id}) { $switch_str .= "top.fframe.document.vform.deathd.value = \"$indiv_deat_date{$id}\"\n"; } # death place if ($indiv_deat_plac{$id}) { $switch_str .= "top.fframe.document.vform.deathp.value = \"$indiv_deat_plac{$id}\"\n"; } # burial date if ($indiv_buri_date{$id}) { $switch_str .= "top.fframe.document.vform.buriald.value = \"$indiv_buri_date{$id}\"\n"; } # burial place if ($indiv_buri_plac{$id}) { $switch_str .= "top.fframe.document.vform.burialp.value = \"$indiv_buri_plac{$id}\"\n"; } if ($lds_ord) { # baptism date if ($indiv_bap_date{$id}) { $switch_str .= "top.fframe.document.vform.bapd.value = \"$indiv_bap_date{$id}\"\n"; } # baptism place if ($indiv_bap_plac{$id}) { $switch_str .= "top.fframe.document.vform.bapp.value = \"$indiv_bap_plac{$id}\"\n"; } # endowment date if ($indiv_end_date{$id}) { $switch_str .= "top.fframe.document.vform.endd.value = \"$indiv_end_date{$id}\"\n"; } # endowment place if ($indiv_end_plac{$id}) { $switch_str .= "top.fframe.document.vform.endp.value = \"$indiv_end_plac{$id}\"\n"; } # sealing of child to parents date if ($indiv_slgc_date{$id}) { $switch_str .= "top.fframe.document.vform.slgcd.value = \"$indiv_slgc_date{$id}\"\n"; } # sealing of child to parents place if ($indiv_slgc_plac{$id}) { $switch_str .= "top.fframe.document.vform.slgcp.value = \"$indiv_slgc_plac{$id}\"\n"; } } $switch_str .= "break\n"; } sub add_div { my $id = pop(@@_); $div_str = $div_str . "

\n"; $div_str = $div_str . "\n"; $div_str = $div_str . "
\n"; $div_str = $div_str . &create_vital_info($id); $div_str = $div_str . "
"; $div_str = $div_str . "
\n"; } sub create_vital_info { my $id = pop(@@_); my $vital_str = ""; # birth date and place if ($indiv_birt{$id}) { $vital_str = "$str_birth "; if ($indiv_birt_date{$id}) { $vital_str = $vital_str . "$indiv_birt_date{$id}"; if ($indiv_birt_plac{$id}) {$vital_str = $vital_str . ", ";} } if ($indiv_birt_plac{$id}) { $vital_str = $vital_str . "$indiv_birt_plac{$id}"; } $vital_str = $vital_str . "
\n"; } # death date and place if ($indiv_deat{$id}) { $vital_str = $vital_str . "$str_death "; if ($indiv_deat_date{$id}) { $vital_str = $vital_str . "$indiv_deat_date{$id}"; if ($indiv_deat_plac{$id}) {$vital_str = $vital_str . ", ";} } if ($indiv_deat_plac{$id}) { $vital_str = $vital_str . "$indiv_deat_plac{$id}"; } $vital_str = $vital_str . "
\n"; } # burial date and place if ($indiv_buri{$id}) { $vital_str = $vital_str . "$str_burial "; if ($indiv_buri_date{$id}) { $vital_str = $vital_str . "$indiv_buri_date{$id}"; if ($indiv_buri_plac{$id}) {$vital_str = $vital_str . ", ";} } if ($indiv_buri_plac{$id}) { $vital_str = $vital_str . "$indiv_buri_plac{$id}"; } $vital_str = $vital_str . "
\n"; } # LDS Ordinances if ($lds_ord) { if ($indiv_bap{$id}) { $vital_str = $vital_str . "$str_bap "; if ($indiv_bap_date{$id}) { $vital_str = $vital_str . "$indiv_bap_date{$id}"; if ($indiv_bap_plac{$id}) { $vital_str = $vital_str . ", "; } } if ($indiv_bap_plac{$id}) { $vital_str = $vital_str . "$indiv_bap_plac{$id}"; } $vital_str = $vital_str . "
\n"; } if ($indiv_end{$id}) { $vital_str = $vital_str . "$str_end "; if ($indiv_end_date{$id}) { $vital_str = $vital_str . "$indiv_end_date{$id}"; if ($indiv_end_plac{$id}) { $vital_str = $vital_str . ", "; } } if ($indiv_end_plac{$id}) { $vital_str = $vital_str . "$indiv_end_plac{$id}"; } $vital_str = $vital_str . "
\n"; } if ($indiv_slgc{$id}) { $vital_str = $vital_str . "$str_slgc "; if ($indiv_slgc_date{$id}) { $vital_str = $vital_str . "$indiv_slgc_date{$id}"; if ($indiv_slgc_plac{$id}) { $vital_str = $vital_str . ", "; } } if ($indiv_slgc_plac{$id}) { $vital_str = $vital_str . "$indiv_slgc_plac{$id}"; } $vital_str = $vital_str . "
\n"; } } # occupation if ($indiv_occu{$id}) { $vital_str = $vital_str . "$str_occupation $indiv_occu{$id}\n"; } return ($vital_str); } sub ped_print { my $node = @@_[0]; my $level = @@_[1]; my $add_td = @@_[2]; my $end_add_td = @@_[3]; my $print_tr = @@_[4]; my $f_rowspan = $ped_father_level[$node] +1; my $m_rowspan = $ped_mother_level[$node] +1; if ($debug) { print DBUG_OUT "I:" . $node . " " . $level . " " . "\n"; } # Follow father path if ($ped_father_level[$node] > 0) { if (($level > 1) && ($node % 2)) { # If odd going up, need to print image if ($print_tr) {$ped_out_str .= "";} for ($col = 1; $col < $add_td; $col++) { $ped_out_str .= ""; } $ped_out_str .= " 0) || ($node % 2)) { for ($col = 1; $col < $add_td; $col++) { $ped_out_str .= ""; } } else { for ($col = 1; $col < $end_add_td; $col++) { $ped_out_str .= ""; } } # If even, print image now if (($level > 1) && !($node % 2)) { $ped_out_str .= ""; $ped_out_str .= ""; } # If odd and at final level, print image now if (($level > 1) && ($node % 2)&& ($ped_father_level[$node] == 0) && ($ped_mother_level[$node] == 0)) { $ped_out_str .= ""; $ped_out_str .= ""; } $ped_out_str .= ""; $ped_out_str .= "\n"; $ped_out_str .= "$indiv_name{$ped_indiv_id[$node]}\n"; # Indicate End of Line if ($ped_eol[$node]) { $ped_out_str .= "\n"; } $ped_out_str .= "\n"; add_div($ped_indiv_id[$node]); add_switch($ped_indiv_id[$node]); if ($ped_mother_level[$node] > 0) { if (($node % 2)) { # If odd going down, bump $add_td ped_print ($node*2+1, $level+1, $add_td+1, $end_add_td+1, 1); } else { # Even going down ped_print ($node*2+1, $level+1, $add_td, $end_add_td, 1); } } } sub ped_parse { my $my_indiv_id = @@_[0]; my $node = @@_[1]; my $level = @@_[2]; my $ped_famc = $indiv_famc{$my_indiv_id}; my $ped_father_id = $fam_husb{$ped_famc}; my $ped_mother_id = $fam_wife{$ped_famc}; my $father_return_level = 0; my $mother_return_level = 0; my $father_return_depth = 0; my $mother_return_depth = 0; my $my_depth; if ($debug) { print DBUG_OUT "I:" . $my_indiv_id . " F:" . $ped_father_id . " M:" . $ped_mother_id . " " . $node . " " . $level . " " . "\n"; } # Follow father path if (($ped_father_id ne "") && ($level < $ped_generations)) { ($father_return_level, $father_return_depth) = ped_parse ($ped_father_id, $node*2, $level+1); } # Follow mother path if (($ped_mother_id ne "") && ($level < $ped_generations)) { ($mother_return_level, $mother_return_depth) = ped_parse ($ped_mother_id, $node*2+1, $level+1); } $ped_indiv_id[$node] = $my_indiv_id; $ped_father_level[$node] = $father_return_level; $ped_mother_level[$node] = $mother_return_level; # End of the line $ped_eol[$node] = ($ped_father_id eq "") && ($ped_mother_id eq ""); if ($father_return_depth > $mother_return_depth) { $my_depth = $father_return_depth +1; } else { $my_depth = $mother_return_depth +1; } return ($father_return_level + $mother_return_level +1, $my_depth); } sub button_bar { my $my_bar_type = @@_[0]; my $my_id = @@_[1]; my $my_row = @@_[2]; my $bstr .= ""; if ($my_bar_type eq 'ped') { $bstr .= "\n"; $bstr .= ";
        $bstr .= \n"; $bstr .= "\n"; $bstr .= ";
        $bstr .= \n"; $bstr .= "\n"; $bstr .= ";
        $bstr .= \n"; $bstr .= "\n"; $bstr .= ";
        $bstr .= \n"; } elsif ($my_bar_type eq 'grp') { $bstr .= "\n"; $bstr .= ";
        $bstr .= \n"; $bstr .= "\n"; $bstr .= ";
        $bstr .= \n"; $bstr .= "\n"; $bstr .= ";
        $bstr .= \n"; $bstr .= "\n"; $bstr .= ";
        $bstr .= \n"; } elsif ($my_bar_type eq 'sur') { $bstr .= "\n"; $bstr .= ";
        $bstr .= \n"; $bstr .= "\n"; $bstr .= ";
        $bstr .= \n"; $bstr .= "\n"; $bstr .= ";
        $bstr .= \n"; $bstr .= "\n"; $bstr .= ";
        $bstr .= \n"; } elsif ($my_bar_type eq 'ppl') { $bstr .= "\n"; $bstr .= ";
        $bstr .= \n"; $bstr .= "\n"; $bstr .= ";
        $bstr .= \n"; $bstr .= "\n"; $bstr .= ";
        $bstr .= \n"; $bstr .= "\n"; $bstr .= ";
        $bstr .= \n"; } return $bstr; } @ 1.15 log @Added support for WebbedGed.cfg file for overriding default options. Made all output files lowercase to support a wider variety of web servers. Correctly qualified output date with $lds_ord option. Generate WebbedGed_frame.html and form.html on fly. Added option to create gendex.txt file in support of the Gendex database. Removed references to www.rawlins.org -- Gedcom file location configurable. @ text @d3 1 a3 1 $_ = '$Revision: 1.14 $'; d470 1 a470 1 $html_ind_top[2] = button_bar('grp', $indiv_id, 0); d485 1 a485 1 $html_ind_bot[1] = button_bar('grp', $indiv_id, 2); d567 1 a567 1 $grp_out_str .= button_bar('grp', $indiv_id, 0); d783 1 a783 1 $grp_out_str .= button_bar('grp', $indiv_id, 1); d825 1 a825 1 print GRP_OUT "arImageList[counter].src = \"../gif/\" + \n"; d839 6 a844 6 print GRP_OUT "top.fframe.document.vform.birthd.value = ''\n"; print GRP_OUT "top.fframe.document.vform.birthp.value = ''\n"; print GRP_OUT "top.fframe.document.vform.deathd.value = ''\n"; print GRP_OUT "top.fframe.document.vform.deathp.value = ''\n"; print GRP_OUT "top.fframe.document.vform.buriald.value = ''\n"; print GRP_OUT "top.fframe.document.vform.burialp.value = ''\n"; d847 6 a852 6 print GRP_OUT "top.fframe.document.vform.bapd.value = ''\n"; print GRP_OUT "top.fframe.document.vform.bapp.value = ''\n"; print GRP_OUT "top.fframe.document.vform.endd.value = ''\n"; print GRP_OUT "top.fframe.document.vform.endp.value = ''\n"; print GRP_OUT "top.fframe.document.vform.slgcd.value = ''\n"; print GRP_OUT "top.fframe.document.vform.slgcp.value = ''\n"; d861 6 a866 6 print GRP_OUT "top.fframe.document.vform.birthd.value = ''\n"; print GRP_OUT "top.fframe.document.vform.birthp.value = ''\n"; print GRP_OUT "top.fframe.document.vform.deathd.value = ''\n"; print GRP_OUT "top.fframe.document.vform.deathp.value = ''\n"; print GRP_OUT "top.fframe.document.vform.buriald.value = ''\n"; print GRP_OUT "top.fframe.document.vform.burialp.value = ''\n"; d869 6 a874 6 print GRP_OUT "top.fframe.document.vform.bapd.value = ''\n"; print GRP_OUT "top.fframe.document.vform.bapp.value = ''\n"; print GRP_OUT "top.fframe.document.vform.endd.value = ''\n"; print GRP_OUT "top.fframe.document.vform.endp.value = ''\n"; print GRP_OUT "top.fframe.document.vform.slgcd.value = ''\n"; print GRP_OUT "top.fframe.document.vform.slgcp.value = ''\n"; d888 1 a888 1 print GRP_OUT button_bar('grp', $indiv_id, 2); d926 1 a926 1 $ped_out_str .= button_bar('ped', $indiv_id, 1); d961 1 a961 1 print PED_OUT "arImageList[counter].src = \"../gif/\" + \n"; d975 6 a980 6 print PED_OUT "top.fframe.document.vform.birthd.value = ''\n"; print PED_OUT "top.fframe.document.vform.birthp.value = ''\n"; print PED_OUT "top.fframe.document.vform.deathd.value = ''\n"; print PED_OUT "top.fframe.document.vform.deathp.value = ''\n"; print PED_OUT "top.fframe.document.vform.buriald.value = ''\n"; print PED_OUT "top.fframe.document.vform.burialp.value = ''\n"; d983 6 a988 6 print PED_OUT "top.fframe.document.vform.bapd.value = ''\n"; print PED_OUT "top.fframe.document.vform.bapp.value = ''\n"; print PED_OUT "top.fframe.document.vform.endd.value = ''\n"; print PED_OUT "top.fframe.document.vform.endp.value = ''\n"; print PED_OUT "top.fframe.document.vform.slgcd.value = ''\n"; print PED_OUT "top.fframe.document.vform.slgcp.value = ''\n"; d997 6 a1002 6 print PED_OUT "top.fframe.document.vform.birthd.value = ''\n"; print PED_OUT "top.fframe.document.vform.birthp.value = ''\n"; print PED_OUT "top.fframe.document.vform.deathd.value = ''\n"; print PED_OUT "top.fframe.document.vform.deathp.value = ''\n"; print PED_OUT "top.fframe.document.vform.buriald.value = ''\n"; print PED_OUT "top.fframe.document.vform.burialp.value = ''\n"; d1005 6 a1010 6 print PED_OUT "top.fframe.document.vform.bapd.value = ''\n"; print PED_OUT "top.fframe.document.vform.bapp.value = ''\n"; print PED_OUT "top.fframe.document.vform.endd.value = ''\n"; print PED_OUT "top.fframe.document.vform.endp.value = ''\n"; print PED_OUT "top.fframe.document.vform.slgcd.value = ''\n"; print PED_OUT "top.fframe.document.vform.slgcp.value = ''\n"; d1021 1 a1021 1 print PED_OUT button_bar('ped', $indiv_id, 0); d1069 1 a1069 1 button_bar('ppl', 0, 0), d1077 1 a1077 1 button_bar('ppl', 0, 1), d1196 1 a1196 1 print SUR_OUT button_bar('sur', 0, 0); d1210 1 a1210 1 print SUR_OUT button_bar('sur', 0, 1); d1470 1 a1470 1 "case '$id':\n"; d1475 1 a1475 1 "top.fframe.document.vform.birthd.value = '$indiv_birt_date{$id}'\n"; d1481 1 a1481 1 "top.fframe.document.vform.birthp.value = '$indiv_birt_plac{$id}'\n"; d1487 1 a1487 1 "top.fframe.document.vform.deathd.value = '$indiv_deat_date{$id}'\n"; d1493 1 a1493 1 "top.fframe.document.vform.deathp.value = '$indiv_deat_plac{$id}'\n"; d1499 1 a1499 1 "top.fframe.document.vform.buriald.value = '$indiv_buri_date{$id}'\n"; d1505 1 a1505 1 "top.fframe.document.vform.burialp.value = '$indiv_buri_plac{$id}'\n"; d1513 1 a1513 1 "top.fframe.document.vform.bapd.value = '$indiv_bap_date{$id}'\n"; d1519 1 a1519 1 "top.fframe.document.vform.bapp.value = '$indiv_bap_plac{$id}'\n"; d1525 1 a1525 1 "top.fframe.document.vform.endd.value = '$indiv_end_date{$id}'\n"; d1531 1 a1531 1 "top.fframe.document.vform.endp.value = '$indiv_end_plac{$id}'\n"; d1537 1 a1537 1 "top.fframe.document.vform.slgcd.value = '$indiv_slgc_date{$id}'\n"; d1543 1 a1543 1 "top.fframe.document.vform.slgcp.value = '$indiv_slgc_plac{$id}'\n"; d1818 1 a1818 1 $bstr .= "'../gif/group_dn.gif'\"\n"; d1820 1 a1820 1 $bstr .= "'../gif/group_up.gif'\"\n"; d1822 2 a1823 2 $bstr .= "'../gif/group_act.gif'\">\n"; $bstr .= ";
d1827 1
a1827 1
        $bstr .= \n"; $bstr .= ";
d1842 1
a1842 1
        $bstr .= \n"; $bstr .= ";
d1852 1
a1852 1
        $bstr .= \n"; $bstr .= ";
d1867 1
a1867 1
        $bstr .= \n"; $bstr .= ";
d1877 1
a1877 1
        $bstr .= \n"; $bstr .= ";
d1887 1
a1887 1
        $bstr .= \n"; $bstr .= ";
d1905 1
a1905 1
        $bstr .= \n"; $bstr .= ";
@



1.14
log
@Added Gnu Public License.
Changed name from g2h to WebbedGed.
@
text
@d3 1
a3 1
$_ = '$Revision: 1.13 $';
d26 2
a27 1
# or obtain online at http://www.fsf.org/copyleft/gpl.html.
d32 26
a57 1
# Change these variables if you like
d59 1
a59 14
$family_table = 1;  # print family tree type table
$print_family = 1;  # print detailed family info
$print_notes = 1;   # Print an individual's notes
$hot_links = 1;     # Convert URL's in notes to hot links
$check_images = 1;  # Check for images in the $out_dir/$photo_dir directory
$private = 1;       # Make birth information private
$lds_ord = 1;       # Include LDS ordinances
$ped_generations = 5; # Number of generations for pedigree chart
$debug = 0;         # Enable debug statements to print
$out_dir = dbug.out");} $in = "nothing"; $in1 = "nothing"; d105 20 d149 2 a150 2 if (/^\s*0.*/) { # a 0 line if ($in1 != 0) # reset in1 d152 1 a152 1 if (/^\s*0\s*HEAD/) { # header d167 1 a167 1 $indiv_id = $1; d170 1 a170 1 $num_fams = 0; # number of spouses d174 1 a174 1 elsif (/^\s*0\sTRLR/) { # end of file d197 1 a197 1 elsif (/^\s*1\s(.*)/) { # a 1 line d201 1 a201 1 ; # ignore the header d206 1 a206 1 $fam_husb{$fam_id} = $1; d209 1 a209 1 $fam_wife{$fam_id} = $1; d212 9 a220 8 #$key = $fam_id."@@".$famc_cnt."@@".$1; #$fam_chil{$key} = $1; if ($famc_cnt == 1) { # First one $fam_chil{$fam_id} = $1;} else { $fam_chil{$fam_id} = $fam_chil{$fam_id}."@@".$1;} $key = $fam_id; $famc_cnt++; d223 1 a223 1 $in1 = "marriage"; d226 1 a226 1 $in1 = "seal spouse"; d232 12 a243 12 # convert the surname to italics $name = $1; $name =~ /(.*)\/(.*)\/(.*)/; $indiv_surname{$indiv_id} = $2; $indiv_forname{$indiv_id} = $1." ".$3; $_ = $name; s/\// /; s/\//<\/i>/; $indiv_name{$indiv_id} = $_; $_ = $name; s/\// /g; $indiv_name_unformatted{$indiv_id} = $_; d246 1 a246 1 $indiv_sex{$indiv_id} = $1; d249 1 a249 1 $in1 = "birth"; d252 1 a252 1 $in1 = "death"; d255 1 a255 1 $in1 = "burial"; d258 1 a258 1 $in1 = "baptism"; d261 1 a261 1 $in1 = "endowment"; d264 1 a264 1 $in1 = "seal parents"; d267 1 a267 1 $indiv_occu{$indiv_id} = $1; d270 5 a274 4 # note with link to level 0 note record #$indiv_note_link{$indiv_id} = $1; $note_indiv_link{$1} = $indiv_id; $in1 = "notes"; d277 2 a278 2 $indiv_note{$indiv_id} = $indiv_note{$indiv_id}."
\n$1"; $no_br_cont = 1; d281 3 a283 3 $indiv_note{$indiv_id} = $1 . "
\n"; $no_br_cont = 0; $in1 = "notes"; d286 1 a286 1 $indiv_famc{$indiv_id} = $1; d289 8 a296 7 if ($num_fams > 0) { $indiv_fams{$indiv_id} = $indiv_fams{$indiv_id}."@@".$1; } else { $indiv_fams{$indiv_id} = $1; } $num_fams++; d302 6 a307 6 if ($no_br_cont) { $note{$note_id} = $note{$note_id}."$1"; } else { $note{$note_id} = $note{$note_id}."
\n$1"; } $no_br_cont = 1; d310 1 a310 1 $note{$note_id} = $note{$note_id}."$1"; d313 6 a318 6 if ($no_br_cont) { $note{$note_id} = $note{$note_id}."$1"; } else { $note{$note_id} = $note{$note_id}."
\n$1"; } $no_br_cont = 0; d321 2 a322 2 } # end if a 1 line elsif (/^\s*2\s(.*)/) { # a 2 line d326 2 a327 2 $indiv_birt_date{$indiv_id} = $1; $indiv_birt{$indiv_id} = 1; d330 2 a331 2 $indiv_birt_plac{$indiv_id} = $1; $indiv_birt{$indiv_id} = 1; d336 2 a337 2 $indiv_bap_date{$indiv_id} = $1; $indiv_bap{$indiv_id} = 1; d340 2 a341 2 $indiv_bap_plac{$indiv_id} = $1; $indiv_bap{$indiv_id} = 1; d346 2 a347 2 $indiv_end_date{$indiv_id} = $1; $indiv_end{$indiv_id} = 1; d350 2 a351 2 $indiv_end_plac{$indiv_id} = $1; $indiv_end{$indiv_id} = 1; d354 2 a355 2 $indiv_end_plac{$indiv_id} = $1; $indiv_end{$indiv_id} = 1; d358 2 a359 2 $indiv_end_plac{$indiv_id} = $1; $indiv_end{$indiv_id} = 1; d364 2 a365 2 $indiv_slgc_date{$indiv_id} = $1; $indiv_slgc{$indiv_id} = 1; d368 2 a369 2 $indiv_slgc_plac{$indiv_id} = $1; $indiv_slgc{$indiv_id} = 1; d372 2 a373 2 $indiv_slgc_plac{$indiv_id} = $1; $indiv_slgc{$indiv_id} = 1; d376 2 a377 2 $indiv_slgc_plac{$indiv_id} = $1; $indiv_slgc{$indiv_id} = 1; d382 2 a383 2 $indiv_deat_date{$indiv_id} = $1; $indiv_deat{$indiv_id} = 1; d386 2 a387 2 $indiv_deat_plac{$indiv_id} = $1; $indiv_deat{$indiv_id} = 1; d392 2 a393 2 $indiv_buri_date{$indiv_id} = $1; $indiv_buri{$indiv_id} = 1; d396 2 a397 2 $indiv_buri_plac{$indiv_id} = $1; $indiv_buri{$indiv_id} = 1; d402 6 a407 6 if ($no_br_cont) { $indiv_note{$indiv_id} = $indiv_note{$indiv_id}."$1"; } else { $indiv_note{$indiv_id} = $indiv_note{$indiv_id}."
\n$1"; } $no_br_cont = 1; d410 1 a410 1 $indiv_note{$indiv_id} = $indiv_note{$indiv_id}."$1"; d413 6 a418 6 if ($no_br_cont) { $indiv_note{$indiv_id} = $indiv_note{$indiv_id}."$1"; } else { $indiv_note{$indiv_id} = $indiv_note{$indiv_id}."
\n$1"; } $no_br_cont = 0; d423 2 a424 2 $fam_marr_date{$fam_id} = $1; $fam_marr{$fam_id} = 1; d427 2 a428 2 $fam_marr_plac{$fam_id} = $1; $fam_marr{$fam_id} = 1; d433 2 a434 2 $fam_slgs_date{$fam_id} = $1; $fam_slgs{$fam_id} = 1; d437 2 a438 2 $indiv_slgs_plac{$indiv_id} = $1; $indiv_slgs{$indiv_id} = 1; d441 2 a442 2 $indiv_slgs_plac{$indiv_id} = $1; $indiv_slgs{$indiv_id} = 1; d445 2 a446 2 $fam_slgs_plac{$fam_id} = $1; $fam_slgs{$fam_id} = 1; d449 1 a449 1 } # end if a 2 line d529 1 a529 1 print "Individual $indiv_id has birth date ($1) after this year ($curr_year)\n"; d532 1 a532 1 &make_birt_private($indiv_id); d535 1 a535 1 else { # Couldn't find a birth year - make private d597 3 a599 3 $grp_out_str .= "$pgfather\n"; add_div($pgfather_id); add_switch($pgfather_id); d601 1 a601 1 $grp_out_str .= "\n"; d606 3 a608 3 $grp_out_str .= "$pgmother\n"; add_div($pgmother_id); add_switch($pgmother_id); d610 1 a610 1 $grp_out_str .= "\n"; d615 3 a617 3 $grp_out_str .= "$mgfather\n"; add_div($mgfather_id); add_switch($mgfather_id); d619 1 a619 1 $grp_out_str .= "\n"; d624 3 a626 3 $grp_out_str .= "$mgmother\n"; add_div($mgmother_id); add_switch($mgmother_id); d628 1 a628 1 $grp_out_str .= "\n"; d633 1 a633 1 {$grp_out_str .= "\n";} d635 1 a635 1 {$grp_out_str .= "\n";} d637 1 a637 1 {$grp_out_str .= "\n";} d639 1 a639 1 {$grp_out_str .= "\n";} d656 1 a656 1 {$grp_out_str .= "\n";} d658 1 a658 1 {$grp_out_str .= "\n";} d663 1 a663 1 } # end if has a parent d669 81 a749 81 &get_spouse_data($fams[$fams_num]); &get_child_data($fams[$fams_num]); if ($num_children > 0) { $grp_out_str .= "\n\n\n"; $grp_out_str .= "\n"; if ($num_children > 8) { $cwidth=9; } else { $cwidth = $num_children; } $grp_out_str .= "\n"; add_div($spouse_id); add_switch($spouse_id); # the children $start_child = 0; while (($num_children - $start_child) > 8) { # print the 8 child tree with extra leg coming down $grp_out_str .= "\n"; # print the first 8 children $cell_width = 600/9; $grp_out_str .= ""; for ($i = $start_child; $i < $start_child+4; $i++) { $grp_out_str .= "\n"; add_div($child[$i]); add_switch($child[$i]); } $grp_out_str .= "\n"; for ($i = $start_child+4; $i < $start_child+8; $i++) { $grp_out_str .= "\n"; add_div($child[$i]); add_switch($child[$i]); } $grp_out_str .= "\n"; $start_child += 8; } # print the rest of the children $num_left = $num_children-$start_child; $grp_out_str .= "\n"; $grp_out_str .= "
"; $grp_out_str .= $str_m; if ($fams_len > 1) { $i = $fams_num+1; $grp_out_str .= "($i) "; } # Spouse $grp_out_str .= "$spouse
"; $grp_out_str .= "
"; $grp_out_str .= "$indiv_name{$child[$i]}
"; $grp_out_str .= "
"; $grp_out_str .= "$indiv_name{$child[$i]}
\n"; $grp_out_str .= ""; $grp_out_str .= "\n"; $cell_width = int(600/$num_left); $grp_out_str .= ""; for ($i = $start_child; $i < $num_children; $i++) { $grp_out_str .= "\n"; add_div($child[$i]); add_switch($child[$i]); } $grp_out_str .= "
"; $grp_out_str .= "
"; $grp_out_str .= "$indiv_name{$child[$i]}

\n\n"; } # end if has children else { #no children so just put marriage for consistency $grp_out_str .= "\n"; $grp_out_str .= ""; $grp_out_str .= $str_m; if ($fams_len > 1) { $i = $fams_num+1; $grp_out_str .= "($i) "; } $grp_out_str .= "$spouse

\n"; add_div($spouse_id); add_switch($spouse_id); } } # end for each family } # end if has spouses d752 1 a752 1 } # end if family_table d775 1 a775 1 } # end if print_family d789 1 a789 1 $grp_out_str .= get_note_link($note_line) . "\n"; d845 10 a854 6 print GRP_OUT "top.fframe.document.vform.bapd.value = ''\n"; print GRP_OUT "top.fframe.document.vform.bapp.value = ''\n"; print GRP_OUT "top.fframe.document.vform.endd.value = ''\n"; print GRP_OUT "top.fframe.document.vform.endp.value = ''\n"; print GRP_OUT "top.fframe.document.vform.slgcd.value = ''\n"; print GRP_OUT "top.fframe.document.vform.slgcp.value = ''\n"; d867 10 a876 6 print GRP_OUT "top.fframe.document.vform.bapd.value = ''\n"; print GRP_OUT "top.fframe.document.vform.bapp.value = ''\n"; print GRP_OUT "top.fframe.document.vform.endd.value = ''\n"; print GRP_OUT "top.fframe.document.vform.endp.value = ''\n"; print GRP_OUT "top.fframe.document.vform.slgcd.value = ''\n"; print GRP_OUT "top.fframe.document.vform.slgcp.value = ''\n"; d901 2 a902 2 unless (open(PED_OUT, ">$out_dir/P$indiv_id.html")) { die "\nCouldn't open output file $out_dir/P$indiv_id.html\n"; d935 1 a935 1 print PED_OUT "\n"; d981 10 a990 6 print PED_OUT "top.fframe.document.vform.bapd.value = ''\n"; print PED_OUT "top.fframe.document.vform.bapp.value = ''\n"; print PED_OUT "top.fframe.document.vform.endd.value = ''\n"; print PED_OUT "top.fframe.document.vform.endp.value = ''\n"; print PED_OUT "top.fframe.document.vform.slgcd.value = ''\n"; print PED_OUT "top.fframe.document.vform.slgcp.value = ''\n"; d1003 10 a1012 6 print PED_OUT "top.fframe.document.vform.bapd.value = ''\n"; print PED_OUT "top.fframe.document.vform.bapp.value = ''\n"; print PED_OUT "top.fframe.document.vform.endd.value = ''\n"; print PED_OUT "top.fframe.document.vform.endp.value = ''\n"; print PED_OUT "top.fframe.document.vform.slgcd.value = ''\n"; print PED_OUT "top.fframe.document.vform.slgcp.value = ''\n"; d1038 1 a1038 1 } # end foreach $indiv_id (keys %indivs) d1048 7 d1067 14 a1080 14 "$str_people\n\n\n", "


\n", button_bar('ppl', 0, 0), "
\n", "

$str_lpeople

($num_indivs $str_people_and $num_families $str_unique_names)

\n", "#main", # "#ns ", "#ind_surname, #ind_forname (#ind_birt_date - #ind_deat_date) #photo
", "#end", "


\n", button_bar('ppl', 0, 1), "
\n", "#footer" ); d1089 10 a1098 10 $j++; $line = $fline[$j]; $ns[$i] = 0; if ($line =~ /#ns(.*\n)/) { # if ($line =~ /#ns(.*)/) { $line = $1; $ns[$i] = 1; } $out_fmt[$i] = $line; $i++; d1122 1 a1122 1 $line =~ s/\(\($str_private\) - \)/$str_private/; d1126 10 d1147 1 d1217 62 d1305 4 a1308 3 $ft_str .= ""; $ft_str .= "Gedcom to HTML converter v$version.
\n"; d1310 8 a1317 2 $ft_str .= "\n"; $ft_str .= "$gedfile.gz at $gmtime GMT
\n"; d1337 1 a1337 1 # Spouse d1349 1 a1349 1 if ($lds_ord && $fam_slgs{$fams[$fams_num]}) { d1357 2 a1358 2 $grp_out_str .= "\n"; } d1364 1 a1364 1 # Child d1367 2 a1368 2 add_div($child[$i]); add_switch($child[$i]); d1460 1 a1460 1 return "$`
"; d1462 1 a1462 1 return $parse_string; d1475 1 a1475 1 "top.fframe.document.vform.birthd.value = '$indiv_birt_date{$id}'\n"; d1481 1 a1481 1 "top.fframe.document.vform.birthp.value = '$indiv_birt_plac{$id}'\n"; d1487 1 a1487 1 "top.fframe.document.vform.deathd.value = '$indiv_deat_date{$id}'\n"; d1493 1 a1493 1 "top.fframe.document.vform.deathp.value = '$indiv_deat_plac{$id}'\n"; d1499 1 a1499 1 "top.fframe.document.vform.buriald.value = '$indiv_buri_date{$id}'\n"; d1505 1 a1505 1 "top.fframe.document.vform.burialp.value = '$indiv_buri_plac{$id}'\n"; d1508 7 a1514 5 # baptism date if ($indiv_bap_date{$id}) { $switch_str .= "top.fframe.document.vform.bapd.value = '$indiv_bap_date{$id}'\n"; } d1516 5 a1520 5 # baptism place if ($indiv_bap_plac{$id}) { $switch_str .= "top.fframe.document.vform.bapp.value = '$indiv_bap_plac{$id}'\n"; } d1522 5 a1526 5 # endowment date if ($indiv_end_date{$id}) { $switch_str .= "top.fframe.document.vform.endd.value = '$indiv_end_date{$id}'\n"; } d1528 5 a1532 5 # endowment place if ($indiv_end_plac{$id}) { $switch_str .= "top.fframe.document.vform.endp.value = '$indiv_end_plac{$id}'\n"; } d1534 5 a1538 5 # sealing of child to parents date if ($indiv_slgc_date{$id}) { $switch_str .= "top.fframe.document.vform.slgcd.value = '$indiv_slgc_date{$id}'\n"; } d1540 5 a1544 4 # sealing of child to parents place if ($indiv_slgc_plac{$id}) { $switch_str .= "top.fframe.document.vform.slgcp.value = '$indiv_slgc_plac{$id}'\n"; d1612 39 a1650 39 if ($indiv_bap{$id}) { $vital_str = $vital_str . "$str_bap "; if ($indiv_bap_date{$id}) { $vital_str = $vital_str . "$indiv_bap_date{$id}"; if ($indiv_bap_plac{$id}) { $vital_str = $vital_str . ", "; } } if ($indiv_bap_plac{$id}) { $vital_str = $vital_str . "$indiv_bap_plac{$id}"; } $vital_str = $vital_str . "
\n"; } if ($indiv_end{$id}) { $vital_str = $vital_str . "$str_end "; if ($indiv_end_date{$id}) { $vital_str = $vital_str . "$indiv_end_date{$id}"; if ($indiv_end_plac{$id}) { $vital_str = $vital_str . ", "; } } if ($indiv_end_plac{$id}) { $vital_str = $vital_str . "$indiv_end_plac{$id}"; } $vital_str = $vital_str . "
\n"; } if ($indiv_slgc{$id}) { $vital_str = $vital_str . "$str_slgc "; if ($indiv_slgc_date{$id}) { $vital_str = $vital_str . "$indiv_slgc_date{$id}"; if ($indiv_slgc_plac{$id}) { $vital_str = $vital_str . ", "; } } if ($indiv_slgc_plac{$id}) { $vital_str = $vital_str . "$indiv_slgc_plac{$id}"; } $vital_str = $vital_str . "
\n"; } d1672 1 a1672 1 print DBUG_OUT "I:" . $node . " " . $level . " " . "\n"; d1678 2 a1679 2 if (($level > 1) && ($node % 2)) { # If odd going up, need to print image d1681 19 a1699 19 if ($print_tr) {$ped_out_str .= "";} for ($col = 1; $col < $add_td; $col++) { $ped_out_str .= ""; } $ped_out_str .= "\n"; $bstr .= ";
	$bstr .= \n"; $bstr .= "\n"; $bstr .= ";
	$bstr .= \n"; $bstr .= "\n"; $bstr .= ";
	$bstr .= \n"; $bstr .= "\n"; $bstr .= ";
	$bstr .= \n"; d1851 33 a1883 33 $bstr .= "\n"; $bstr .= ";
	$bstr .= \n"; $bstr .= "\n"; $bstr .= ";
	$bstr .= \n"; $bstr .= "\n"; $bstr .= ";
	$bstr .= \n"; $bstr .= "\n"; $bstr .= ";
	$bstr .= \n"; d1886 21 a1906 21 $bstr .= "\n"; $bstr .= ";
	$bstr .= \n"; $bstr .= "\n"; $bstr .= ";
	$bstr .= \n"; $bstr .= "\n"; $bstr .= ";
	$bstr .= \n"; $bstr .= "\n"; $bstr .= ";
	$bstr .= \n"; d1909 21 a1929 21 $bstr .= "\n"; $bstr .= ";
	$bstr .= \n"; $bstr .= "\n"; $bstr .= ";
	$bstr .= \n"; $bstr .= "\n"; $bstr .= ";
	$bstr .= \n"; $bstr .= "\n"; $bstr .= ";
	$bstr .= \n"; @ 1.13 log @Added timestamp at bottom of generated files. Fixed Netscape bug for using frame option. Pre-load images for button bar to improve performance. @ text @d3 1 a3 1 $_ = '$Revision: 1.12 $'; d6 21 a26 1 # D.Pidcock@@bath.ac.uk - http://www.bath.ac.uk/~enpdp a27 1 # Copyright (c) Dan Pidcock, 1997-1998. a28 15 # This program is freely distributable without licensing fees # and is provided without guarantee or warrantee expressed or # implied. This program is not in the public domain. # translate gedcom files to html # based on the gedcom 5.5 standard and a sample gedcom 5.3 file # doesn't handle all gedcom elements # Feel free to use this program, but please keep the authorship the # same. If you have any changes you have made, I would be happy to # incorporate them and put your name on the credits. - Dan # Improvements proposed by Graham Lawrence 18 Nov 1997 changes and # incorporated in v1.2. # Multiple marriage code of 1.22b based on that by Dale DePriest d30 1 d34 1 a34 1 $print_family = 0; # print detailed family info d85 1 a85 1 print "g2h $version (c) Dan Pidcock 1997-1998\n"; d1176 2 a1177 1 $ft_str .= ""; @ 1.12 log @Caused note link destinations to not use frame. @ text @d3 1 a3 1 $_ = '$Revision: 1.11 $'; d85 4 a88 1 print "Gedcom file @@ARGV\n"; d771 20 d801 12 a812 12 print GRP_OUT "top.fframe.vform.birthd.value = ''\n"; print GRP_OUT "top.fframe.vform.birthp.value = ''\n"; print GRP_OUT "top.fframe.vform.deathd.value = ''\n"; print GRP_OUT "top.fframe.vform.deathp.value = ''\n"; print GRP_OUT "top.fframe.vform.buriald.value = ''\n"; print GRP_OUT "top.fframe.vform.burialp.value = ''\n"; print GRP_OUT "top.fframe.vform.bapd.value = ''\n"; print GRP_OUT "top.fframe.vform.bapp.value = ''\n"; print GRP_OUT "top.fframe.vform.endd.value = ''\n"; print GRP_OUT "top.fframe.vform.endp.value = ''\n"; print GRP_OUT "top.fframe.vform.slgcd.value = ''\n"; print GRP_OUT "top.fframe.vform.slgcp.value = ''\n"; d819 12 a830 12 print GRP_OUT "top.fframe.vform.birthd.value = ''\n"; print GRP_OUT "top.fframe.vform.birthp.value = ''\n"; print GRP_OUT "top.fframe.vform.deathd.value = ''\n"; print GRP_OUT "top.fframe.vform.deathp.value = ''\n"; print GRP_OUT "top.fframe.vform.buriald.value = ''\n"; print GRP_OUT "top.fframe.vform.burialp.value = ''\n"; print GRP_OUT "top.fframe.vform.bapd.value = ''\n"; print GRP_OUT "top.fframe.vform.bapp.value = ''\n"; print GRP_OUT "top.fframe.vform.endd.value = ''\n"; print GRP_OUT "top.fframe.vform.endp.value = ''\n"; print GRP_OUT "top.fframe.vform.slgcd.value = ''\n"; print GRP_OUT "top.fframe.vform.slgcp.value = ''\n"; d900 19 d929 12 a940 12 print PED_OUT "top.fframe.vform.birthd.value = ''\n"; print PED_OUT "top.fframe.vform.birthp.value = ''\n"; print PED_OUT "top.fframe.vform.deathd.value = ''\n"; print PED_OUT "top.fframe.vform.deathp.value = ''\n"; print PED_OUT "top.fframe.vform.buriald.value = ''\n"; print PED_OUT "top.fframe.vform.burialp.value = ''\n"; print PED_OUT "top.fframe.vform.bapd.value = ''\n"; print PED_OUT "top.fframe.vform.bapp.value = ''\n"; print PED_OUT "top.fframe.vform.endd.value = ''\n"; print PED_OUT "top.fframe.vform.endp.value = ''\n"; print PED_OUT "top.fframe.vform.slgcd.value = ''\n"; print PED_OUT "top.fframe.vform.slgcp.value = ''\n"; d947 12 a958 12 print PED_OUT "top.fframe.vform.birthd.value = ''\n"; print PED_OUT "top.fframe.vform.birthp.value = ''\n"; print PED_OUT "top.fframe.vform.deathd.value = ''\n"; print PED_OUT "top.fframe.vform.deathp.value = ''\n"; print PED_OUT "top.fframe.vform.buriald.value = ''\n"; print PED_OUT "top.fframe.vform.burialp.value = ''\n"; print PED_OUT "top.fframe.vform.bapd.value = ''\n"; print PED_OUT "top.fframe.vform.bapp.value = ''\n"; print PED_OUT "top.fframe.vform.endd.value = ''\n"; print PED_OUT "top.fframe.vform.endp.value = ''\n"; print PED_OUT "top.fframe.vform.slgcd.value = ''\n"; print PED_OUT "top.fframe.vform.slgcp.value = ''\n"; d1169 2 d1172 4 a1175 1 $ft_str .= "Gedcom to HTML converter v$version.

\n"; d1333 1 a1333 1 "top.fframe.vform.birthd.value = '$indiv_birt_date{$id}'\n"; d1339 1 a1339 1 "top.fframe.vform.birthp.value = '$indiv_birt_plac{$id}'\n"; d1345 1 a1345 1 "top.fframe.vform.deathd.value = '$indiv_deat_date{$id}'\n"; d1351 1 a1351 1 "top.fframe.vform.deathp.value = '$indiv_deat_plac{$id}'\n"; d1357 1 a1357 1 "top.fframe.vform.buriald.value = '$indiv_buri_date{$id}'\n"; d1363 1 a1363 1 "top.fframe.vform.burialp.value = '$indiv_buri_plac{$id}'\n"; d1369 1 a1369 1 "top.fframe.vform.bapd.value = '$indiv_bap_date{$id}'\n"; d1375 1 a1375 1 "top.fframe.vform.bapp.value = '$indiv_bap_plac{$id}'\n"; d1381 1 a1381 1 "top.fframe.vform.endd.value = '$indiv_end_date{$id}'\n"; d1387 1 a1387 1 "top.fframe.vform.endp.value = '$indiv_end_plac{$id}'\n"; d1393 1 a1393 1 "top.fframe.vform.slgcd.value = '$indiv_slgc_date{$id}'\n"; d1399 1 a1399 1 "top.fframe.vform.slgcp.value = '$indiv_slgc_plac{$id}'\n"; @ 1.11 log @Added button_bar for transitioning among pages. @ text @d3 1 a3 1 $_ = '$Revision: 1.10 $'; d1271 1 a1271 1 return "$`
"; @ 1.10 log @Allow HTML references in notes to span multiple lines. Notes with a trailing backslash are continued on next line. @ text @d3 1 a3 1 $_ = '$Revision: 1.9 $'; d428 4 a431 1 $html_ind_top[1] = "

#ind_name

\n"; d443 3 a445 3 $html_ind_bot[0] = "
\n"; $html_ind_bot[1] = "
$str_lpeople "; $html_ind_bot[2] = "| $str_lsurnames

\n"; d514 15 a528 9 $html_ind_top_l = @@html_ind_top; for ($i = 0; $i < $html_ind_top_l; $i++) { $_ = $html_ind_top[$i]; s/\#ind_name/$indiv_name{$indiv_id}/ei; $grp_out_str .= $_; if (($check_images) && ($imgpath{$indiv_id} ne "") && (/\n"; } } d740 11 a750 6 $grp_out_str .= "

$str_notes

\n"; @@note_lines = split (/\n/, $indiv_note{$indiv_id}); foreach $note_line (@@note_lines) { $grp_out_str .= get_note_link($note_line) . "\n"; } $grp_out_str .= "

\n"; a752 2 $grp_out_str .= "Pedigree Chart\n"; d817 4 a820 1 print GRP_OUT @@html_ind_bot; d856 3 a858 1 $ped_out_str .= "Family Group Sheet\n"; d923 5 d962 16 a977 11 # use defaults @@fline = ( "$str_people\n\n\n", "

$str_lpeople

($num_indivs $str_people_and $num_families $str_unique_names)

\n", "#main", # "#ns ", "#ind_surname, #ind_forname (#ind_birt_date - #ind_deat_date) #photo
", "#end", "\n

\n
$str_lsurnames

\n", "#footer" ); d979 1 a979 1 $fline = @@fline; d1081 3 d1095 3 a1097 2 print SUR_OUT "


\n"; print SUR_OUT "
$str_lpeople

\n"; d1616 123 d1740 2 @ 1.9 log @Changed printing of data to files to first print to temp string. @ text @d3 1 a3 1 $_ = '$Revision: 1.8 $'; d42 2 a43 1 $treepic_path = "."; d106 1 d109 1 a109 2 chop; chop; d236 4 d241 2 a242 1 $indiv_note{$indiv_id} = get_note_link($1) . "
\n"; d260 10 a269 2 if ($rol =~ /CONC\s?(.*)/) { $note{$note_id} = $note{$note_id}." $1"; d272 6 a277 1 $note{$note_id} = $note{$note_id} . "

\n$1" ; d360 10 a369 3 if ($rol =~ /CONC\s?(.*)/) { $indiv_note{$indiv_id} = $indiv_note{$indiv_id} . get_note_link($1) . "
\n"; d372 6 a377 2 $indiv_note{$indiv_id} = $indiv_note{$indiv_id} . get_note_link($1) . "
\n"; d732 4 a735 1 $grp_out_str .= "$indiv_note{$indiv_id}\n"; d1239 2 a1240 2 if ($parse_string =~ /(http:.*)/) { return "$`"; d1466 1 a1466 1 $ped_out_str .= ""; d1495 1 a1495 1 $ped_out_str .= ""; d1503 1 a1503 1 $ped_out_str .= ""; d1514 1 a1514 1 $ped_out_str .= "\n"; @ 1.8 log @Implemented support for use of forms for displaying vital info. @ text @d3 1 a3 1 $_ = '$Revision: 1.7 $'; d36 1 a36 1 $debug = 1; # Enable debug statements to print d422 66 a487 16 $ind_cnt++; if ($debug) { print DBUG_OUT "$ind_cnt\n"; } print "$ind_cnt\r"; # Clear out $div_str and $grp_out_str $div_str = ""; $grp_out_str = ""; $switch_str = ""; # open an output file unless (open(GRP_OUT, ">$out_dir/$indiv_id.html")) { die "\nCouldn't open output file $out_dir/$indiv_id.html\n"; d489 96 d586 40 a625 81 # Split the list of spouse families into @@fams. # Need to clear the array for some versions of perl. @@fams = (); @@fams = split(/@@/, $indiv_fams{$indiv_id}); #print "Fams:@@fams\n"; $famc = $indiv_famc{$indiv_id}; ############################################################## # print the information to file # Make birth info private if required and person alive if ($private && $indiv_deat{$indiv_id} == 0) { # No death record - check if born too long ago if ($indiv_birt_date{$indiv_id} =~ /([0-9][0-9][0-9][0-9])/) { $year = $1; if ($year > $curr_year) { print "Individual $indiv_id has birth date ($1) after this year ($curr_year)\n"; } elsif ($year+120 > $curr_year) { # May be alive &make_birt_private($indiv_id); } } else { # Couldn't find a birth year - make private &make_birt_private($indiv_id); } } # Check if there is a phot for the individual # Thanks to Bob Minteer for the code this is based on if ($check_images) { if (-r "$out_dir/$photo_dir/$indiv_id.jpg") { $imgpath{$indiv_id}="$photo_dir/$indiv_id.jpg"; } elsif (-r "$out_dir/$photo_dir/$indiv_id.gif") { $imgpath{$indiv_id}="$photo_dir/$indiv_id.gif"; } else { $imgpath{$indiv_id}=""; } } # print HTML at top of page $html_ind_top_l = @@html_ind_top; for ($i = 0; $i < $html_ind_top_l; $i++) { $_ = $html_ind_top[$i]; s/\#ind_name/$indiv_name{$indiv_id}/ei; $grp_out_str .= $_; if (($check_images) && ($imgpath{$indiv_id} ne "") && (/\n"; } } $grp_out_str .= &create_vital_info($indiv_id); # print marriage info if more than just spouse name is known if (!$print_family) { &print_marriages; } if ($family_table || $print_family) { &get_parent_data; &get_child_data; } # If $family_table then print the ancestors chart (needs $father, # $mother, $pgfather etc., $famc. if ($family_table) { &get_gparent_data; # family chart $grp_out_str .= "

\n\n"; if (($father ne "") || ($mother ne "")) { # Ancestors $grp_out_str .= "\n

\n"; } # end if has a parent $fams_len = @@fams; if ($fams_len != 0) { # Spouse(s) and their children for ($fams_num=0; $fams_num < $fams_len; $fams_num++) { &get_spouse_data($fams[$fams_num]); &get_child_data($fams[$fams_num]); if ($num_children > 0) { $grp_out_str .= "\n

\n"; } # end if has children else { #no children so just put marriage for consistency $grp_out_str .= "\n"; $grp_out_str .= "\n"; add_div($spouse_id); add_switch($spouse_id); } } # end for each family } # end if has spouses $grp_out_str .= "
\n"; $grp_out_str .= "\n"; # Paternal Grandfather if ($pgfather_id ne "") { $grp_out_str .= "\n"; add_div($pgfather_id); add_switch($pgfather_id); } else { $grp_out_str .= "\n"; d627 7 a633 8 # Paternal Grandmother if ($pgmother_id ne "") { $grp_out_str .= "\n"; add_div($pgmother_id); add_switch($pgmother_id); } else { $grp_out_str .= "\n"; d635 36 a670 141 # Maternal Grandfather if ($mgfather_id ne "") { $grp_out_str .= "\n"; add_div($mgfather_id); add_switch($mgfather_id); } else { $grp_out_str .= "\n"; } # Maternal Grandmother if ($mgmother_id ne "") { $grp_out_str .= "\n"; add_div($mgmother_id); add_switch($mgmother_id); } else { $grp_out_str .= "\n"; } $grp_out_str .= "\n\n"; if (($pgfather ne "") || ($pgmother ne "")) {$grp_out_str .= "\n";} else {$grp_out_str .= "\n";} if (($mgfather ne "") || ($mgmother ne "")) {$grp_out_str .= "\n";} else {$grp_out_str .= "\n";} $grp_out_str .= "\n"; $grp_out_str .= "\n"; # Father $grp_out_str .= "\n"; add_div($father_id); add_switch($father_id); # Mother $grp_out_str .= "\n"; add_div($mother_id); add_switch($mother_id); $grp_out_str .= "\n"; $grp_out_str .= "\n"; if (($father ne "") || ($mother ne "")) {$grp_out_str .= "\n";} else {$grp_out_str .= "\n";} $grp_out_str .= "\n"; $grp_out_str .= "\n"; $grp_out_str .= "\n"; $grp_out_str .= "
$pgfather$pgmother$mgfather$mgmother
$father$mother
$indiv_name{$indiv_id}
\n
\n\n"; $grp_out_str .= "\n"; if ($num_children > 8) { $cwidth=9; } else { $cwidth = $num_children; } $grp_out_str .= "\n"; add_div($spouse_id); add_switch($spouse_id); # the children $start_child = 0; while (($num_children - $start_child) > 8) { # print the 8 child tree with extra leg coming down $grp_out_str .= "\n"; # print the first 8 children $cell_width = 600/9; $grp_out_str .= ""; for ($i = $start_child; $i < $start_child+4; $i++) { $grp_out_str .= "\n"; add_div($child[$i]); add_switch($child[$i]); } $grp_out_str .= "\n"; for ($i = $start_child+4; $i < $start_child+8; $i++) { $grp_out_str .= "\n"; add_div($child[$i]); add_switch($child[$i]); } $grp_out_str .= "\n"; $start_child += 8; } # print the rest of the children $num_left = $num_children-$start_child; $grp_out_str .= "\n"; $grp_out_str .= "
"; $grp_out_str .= $str_m; if ($fams_len > 1) { $i = $fams_num+1; $grp_out_str .= "($i) "; } # Spouse $grp_out_str .= "$spouse
"; $grp_out_str .= "
"; $grp_out_str .= "$indiv_name{$child[$i]}
"; $grp_out_str .= "
"; $grp_out_str .= "$indiv_name{$child[$i]}
\n"; $grp_out_str .= ""; $grp_out_str .= "\n"; $cell_width = int(600/$num_left); $grp_out_str .= ""; for ($i = $start_child; $i < $num_children; $i++) { $grp_out_str .= "\n"; add_div($child[$i]); add_switch($child[$i]); } $grp_out_str .= "
"; $grp_out_str .= "
"; $grp_out_str .= "$indiv_name{$child[$i]}

\n
"; $grp_out_str .= $str_m; if ($fams_len > 1) { $i = $fams_num+1; $grp_out_str .= "($i) "; } $grp_out_str .= "$spouse

\n

\n"; } # end if family_table d672 6 a677 2 # If $print_family then print parents, marriage(s), children. # Uses $father, $mother, @@child, $famc, $fams. d679 12 a690 1 if ($print_family) { d692 2 a693 17 # parents if ($father ne "") { $grp_out_str .= "$str_father $father
\n"; add_div($father_id); add_switch($father_id); } if ($mother ne "") { $grp_out_str .= "$str_mother $mother

\n"; add_div($mother_id); add_switch($mother_id); } $grp_out_str .= "

\n"; # spouse, marriage date and place and children &print_marriages(1); } # end if print_family d695 8 d704 184 a887 190 # notes if ($print_notes && $indiv_note{$indiv_id}) { $grp_out_str .= "

$str_notes

\n"; $grp_out_str .= "$indiv_note{$indiv_id}\n"; $grp_out_str .= "

\n"; } $grp_out_str .= "Pedigree Chart\n"; # Print out Div constructs $grp_out_str .= $div_str; print GRP_OUT "\n"; print GRP_OUT "\n"; print GRP_OUT "\n"; print GRP_OUT "$indiv_name_unformatted{$indiv_id} \n"; print GRP_OUT "($indiv_birt_date{$indiv_id} - \n"; print GRP_OUT "$indiv_deat_date{$indiv_id})\n"; print GRP_OUT "\n"; print GRP_OUT "\n"; print GRP_OUT "\n\n"; print GRP_OUT $grp_out_str; # print HTML at bottom of page print GRP_OUT @@html_ind_bot; # print GRP_OUT "\n"; print GRP_OUT &print_footer; close(GRP_OUT); # Create Pedigree Chart # Clear out $div_str and $ped_out_str $div_str = ""; $ped_out_str = ""; $switch_str = ""; unless (open(PED_OUT, ">$out_dir/P$indiv_id.html")) { die "\nCouldn't open output file $out_dir/P$indiv_id.html\n"; } ($bogus, $ped_depth) = ped_parse ($indiv_id, 1, 1); # Print Generation Header $ped_out_str .= ""; if ($debug) { print DBUG_OUT "ped_depth = $ped_depth\n"; } for ($cnt = 1; $cnt <= $ped_depth; $cnt++) { $ped_out_str .= "$cnt"; } $ped_out_str .= "\n"; ped_print (1, 1, 0, 0, 1); $ped_out_str .= "\n"; $ped_out_str .= "\n"; $ped_out_str .= "Family Group Sheet\n"; # Print out Div constructs $ped_out_str .= $div_str; $ped_out_str .= "

\n"; # Print to file print PED_OUT "\n"; print PED_OUT "\n"; print PED_OUT "$indiv_name_unformatted{$indiv_id} \n"; print PED_OUT "($indiv_birt_date{$indiv_id} - \n"; print PED_OUT "$indiv_deat_date{$indiv_id})\n"; print PED_OUT "\n"; print PED_OUT "\n"; print PED_OUT "\n\n"; print PED_OUT "\n"; print PED_OUT "\n"; print PED_OUT "
\n"; print PED_OUT "\n"; print PED_OUT $ped_out_str; print PED_OUT "
\n"; print PED_OUT "
\n"; # print PED_OUT "\n"; print PED_OUT &print_footer; close PED_OUT; } # end foreach $indiv_id (keys %indivs) @ 1.7 log @Implemented recursion algorithm for generating 5 generation pedigree charts. @ text @d3 1 a3 1 $_ = '$Revision: 1.6 $'; d41 2 a42 1 $treepic_path = "http://www.rawlins.org/Pedigree/gif"; d106 271 a376 47 if (/^\s*0.*/) { # a 0 line if ($in1 != 0) # reset in1 {$in1 = "nothing";} if (/^\s*0\s*HEAD/) { # header $in = "header"; #print "Header $_"; } elsif (/^\s*0\s@@(.*)@@\sFAM/) { # family record $in = "family_record"; $fam_id = $1; $fams{$fam_id}++; $famc_cnt = 1; $num_families++; &show_reading_status; #print "Family $_"; } elsif (/^\s*0\s@@(.*)@@\sINDI/) { # individual record $in = "individual_record"; $indiv_id = $1; $indivs{$indiv_id}++; $num_indivs++; $num_fams = 0; # number of spouses &show_reading_status; #print "Individual $_"; } elsif (/^\s*0\sTRLR/) { # end of file $in = "nothing"; } elsif (/^\s*0\s_EVENT_DEFN/) { # custom event $in = "nothing"; } elsif (/^\s*0\s@@(.*)@@\sSUBM/) { # submission record - just ignore $in = "nothing"; } elsif (/^\s*0\s@@(.*)@@\sSOUR/) { # source record - just ignore $in = "nothing"; } elsif (/^\s*0\s@@(.*)@@\sNOTE/) { # note record - linked to an indi $note_id = $1; # Separate notes in separate lines with line break. $note{$note_id} = $note{$note_id}."
"; $in = "note_record"; } else { $in = "nothing"; print "Don't understand this 0 line: $_"; } d378 1 a378 221 elsif (/^\s*1\s(.*)/) { # a 1 line $rol = $1; $in1 = "nothing"; if ($in eq "header") { ; # ignore the header } elsif ($in eq "family_record") { #print "\tfamily $fam_id $rol\n"; if ($rol =~ /HUSB\s@@(.*)@@/) { $fam_husb{$fam_id} = $1; } if ($rol =~ /WIFE\s@@(.*)@@/) { $fam_wife{$fam_id} = $1; } if ($rol =~ /CHIL\s@@(.*)@@/) { #$key = $fam_id."@@".$famc_cnt."@@".$1; #$fam_chil{$key} = $1; if ($famc_cnt == 1) { # First one $fam_chil{$fam_id} = $1;} else { $fam_chil{$fam_id} = $fam_chil{$fam_id}."@@".$1;} $key = $fam_id; $famc_cnt++; } elsif ($rol =~ /MARR.*/) { $in1 = "marriage"; } elsif ($rol =~ /SLGS.*/) { $in1 = "seal spouse"; } } elsif ($in eq "individual_record") { #print "\tindividual $indiv_id $rol\n"; if ($rol =~ /NAME\s(.*)/) { # convert the surname to italics $name = $1; $name =~ /(.*)\/(.*)\/(.*)/; $indiv_surname{$indiv_id} = $2; $indiv_forname{$indiv_id} = $1." ".$3; $_ = $name; s/\// /; s/\//<\/i>/; $indiv_name{$indiv_id} = $_; $_ = $name; s/\// /g; $indiv_name_unformatted{$indiv_id} = $_; } elsif ($rol =~ /SEX\s(.)/) { $indiv_sex{$indiv_id} = $1; } elsif ($rol =~ /BIRT.*/) { $in1 = "birth"; } elsif ($rol =~ /DEAT.*/) { $in1 = "death"; } elsif ($rol =~ /BURI.*/) { $in1 = "burial"; } elsif ($rol =~ /BAPL.*/) { $in1 = "baptism"; } elsif ($rol =~ /ENDL.*/) { $in1 = "endowment"; } elsif ($rol =~ /SLGC.*/) { $in1 = "seal parents"; } elsif ($rol =~ /OCCU\s(.*)/) { $indiv_occu{$indiv_id} = $1; } elsif ($rol =~ /NOTE\s@@(.*)@@/) { # note with link to level 0 note record #$indiv_note_link{$indiv_id} = $1; $note_indiv_link{$1} = $indiv_id; $in1 = "notes"; } elsif ($rol =~ /NOTE\s(.*)/) { $indiv_note{$indiv_id} = get_note_link($1) . "
\n"; $in1 = "notes"; } elsif ($rol =~ /FAMC\s@@(.*)@@/) { # child to family link $indiv_famc{$indiv_id} = $1; } elsif ($rol =~ /FAMS\s@@(.*)@@/) { # spouse to family link if ($num_fams > 0) { $indiv_fams{$indiv_id} = $indiv_fams{$indiv_id}."@@".$1; } else { $indiv_fams{$indiv_id} = $1; } $num_fams++; } } elsif ($in eq "note_record") { # $note_id has the note link code if ($rol =~ /CONC\s?(.*)/) { $note{$note_id} = $note{$note_id}." $1"; } elsif ($rol =~ /CONT\s?(.*)/) { $note{$note_id} = $note{$note_id} . "

\n$1" ; } } } # end if a 1 line elsif (/^\s*2\s(.*)/) { # a 2 line $rol = $1; if ($in1 eq "birth") { if ($rol =~ /DATE\s(.*)/) { $indiv_birt_date{$indiv_id} = $1; $indiv_birt{$indiv_id} = 1; } elsif ($rol =~ /PLAC\s(.*)/) { $indiv_birt_plac{$indiv_id} = $1; $indiv_birt{$indiv_id} = 1; } } elsif ($in1 eq "baptism") { if ($rol =~ /DATE\s(.*)/) { $indiv_bap_date{$indiv_id} = $1; $indiv_bap{$indiv_id} = 1; } elsif ($rol =~ /PLAC\s(.*)/) { $indiv_bap_plac{$indiv_id} = $1; $indiv_bap{$indiv_id} = 1; } } elsif ($in1 eq "endowment") { if ($rol =~ /DATE\s(.*)/) { $indiv_end_date{$indiv_id} = $1; $indiv_end{$indiv_id} = 1; } elsif ($rol =~ /STAT\s(.*)/) { $indiv_end_plac{$indiv_id} = $1; $indiv_end{$indiv_id} = 1; } elsif ($rol =~ /TEMP\s(.*)/) { $indiv_end_plac{$indiv_id} = $1; $indiv_end{$indiv_id} = 1; } elsif ($rol =~ /PLAC\s(.*)/) { $indiv_end_plac{$indiv_id} = $1; $indiv_end{$indiv_id} = 1; } } elsif ($in1 eq "seal parents") { if ($rol =~ /DATE\s(.*)/) { $indiv_slgc_date{$indiv_id} = $1; $indiv_slgc{$indiv_id} = 1; } elsif ($rol =~ /STAT\s(.*)/) { $indiv_slgc_plac{$indiv_id} = $1; $indiv_slgc{$indiv_id} = 1; } elsif ($rol =~ /TEMP\s(.*)/) { $indiv_slgc_plac{$indiv_id} = $1; $indiv_slgc{$indiv_id} = 1; } elsif ($rol =~ /PLAC\s(.*)/) { $indiv_slgc_plac{$indiv_id} = $1; $indiv_slgc{$indiv_id} = 1; } } elsif ($in1 eq "death") { if ($rol =~ /DATE\s(.*)/) { $indiv_deat_date{$indiv_id} = $1; $indiv_deat{$indiv_id} = 1; } elsif ($rol =~ /PLAC\s(.*)/) { $indiv_deat_plac{$indiv_id} = $1; $indiv_deat{$indiv_id} = 1; } } elsif ($in1 eq "burial") { if ($rol =~ /DATE\s(.*)/) { $indiv_buri_date{$indiv_id} = $1; $indiv_buri{$indiv_id} = 1; } elsif ($rol =~ /PLAC\s(.*)/) { $indiv_buri_plac{$indiv_id} = $1; $indiv_buri{$indiv_id} = 1; } } elsif ($in1 eq "notes") { if ($rol =~ /CONC\s?(.*)/) { $indiv_note{$indiv_id} = $indiv_note{$indiv_id} . get_note_link($1) . "
\n"; } elsif ($rol =~ /CONT\s?(.*)/) { $indiv_note{$indiv_id} = $indiv_note{$indiv_id} . get_note_link($1) . "
\n"; } } elsif ($in1 eq "marriage") { if ($rol =~ /DATE\s(.*)/) { $fam_marr_date{$fam_id} = $1; $fam_marr{$fam_id} = 1; } elsif ($rol =~ /PLAC\s(.*)/) { $fam_marr_plac{$fam_id} = $1; $fam_marr{$fam_id} = 1; } } elsif ($in1 eq "seal spouse") { if ($rol =~ /DATE\s(.*)/) { $fam_slgs_date{$fam_id} = $1; $fam_slgs{$fam_id} = 1; } elsif ($rol =~ /STAT\s(.*)/) { $indiv_slgs_plac{$indiv_id} = $1; $indiv_slgs{$indiv_id} = 1; } elsif ($rol =~ /TEMP\s(.*)/) { $indiv_slgs_plac{$indiv_id} = $1; $indiv_slgs{$indiv_id} = 1; } elsif ($rol =~ /PLAC\s(.*)/) { $fam_slgs_plac{$fam_id} = $1; $fam_slgs{$fam_id} = 1; } } } # end if a 2 line d397 1 a397 1 $html_ind_top[0] = "\n"; d430 1 a430 1 # Clear out $div_str d432 2 d436 1 a436 1 unless (open(OUT_FILE, ">$out_dir/$indiv_id.html")) { a479 23 print OUT_FILE "\n"; print OUT_FILE "\n"; print OUT_FILE "\n"; print OUT_FILE "$indiv_name_unformatted{$indiv_id} \n"; print OUT_FILE "($indiv_birt_date{$indiv_id} - \n"; print OUT_FILE "$indiv_deat_date{$indiv_id})\n"; print OUT_FILE "\n"; print OUT_FILE "\n"; print OUT_FILE "\n\n"; d485 1 a485 1 print OUT_FILE $_; d487 1 a487 1 print OUT_FILE "\n"; d491 1 a491 1 print OUT_FILE &create_vital_info($indiv_id); d509 1 a509 1 print OUT_FILE "

\n\n"; d511 2 a512 3 # Ancestors print OUT_FILE "\n

\n"; d591 2 a592 2 print OUT_FILE "\n

\n"; d656 3 a658 3 print OUT_FILE "\n"; print OUT_FILE "\n"; d665 1 d669 1 a669 1 print OUT_FILE "
\n\n"; print OUT_FILE "\n"; d515 7 a521 2 print OUT_FILE "\n"; add_div($pgfather_id); d524 7 a530 2 print OUT_FILE "\n"; add_div($pgmother_id); d533 7 a539 2 print OUT_FILE "\n"; add_div($mgfather_id); d542 7 a548 2 print OUT_FILE "\n"; add_div($mgmother_id); d550 1 a550 1 print OUT_FILE "\n\n"; d552 1 a552 1 {print OUT_FILE "\n";} d554 1 a554 1 {print OUT_FILE "\n";} d556 1 a556 1 {print OUT_FILE "\n";} d558 3 a560 3 {print OUT_FILE "\n";} print OUT_FILE "\n"; print OUT_FILE "\n"; d563 1 a563 1 print OUT_FILE "\n"; d565 1 d568 1 a568 1 print OUT_FILE "\n"; d570 1 d572 2 a573 2 print OUT_FILE "\n"; print OUT_FILE "\n"; d575 1 a575 1 {print OUT_FILE "\n";} d577 5 a581 5 {print OUT_FILE "\n";} print OUT_FILE "\n"; print OUT_FILE "\n"; print OUT_FILE "\n"; print OUT_FILE "
$pgfather$pgmother$mgfather$mgmother
$father$mother
$indiv_name{$indiv_id}
\n
\n\n"; print OUT_FILE "\n"; d599 2 a600 2 print OUT_FILE "\n"; d609 1 d615 1 a615 1 print OUT_FILE "\n"; d618 1 a618 1 print OUT_FILE ""; d620 3 a622 3 print OUT_FILE "\n"; d624 1 d626 1 a626 1 print OUT_FILE "\n"; d628 3 a630 3 print OUT_FILE "\n"; d632 1 d634 1 a634 1 print OUT_FILE "\n"; d639 3 a641 3 print OUT_FILE "\n"; d653 1 a653 1 print OUT_FILE "
"; print OUT_FILE $str_m; d603 1 a603 1 print OUT_FILE "($i) "; d607 1 a607 1 print OUT_FILE "$spouse
"; print OUT_FILE "
"; print OUT_FILE "$indiv_name{$child[$i]}
"; print OUT_FILE "
"; print OUT_FILE "$indiv_name{$child[$i]}
\n"; print OUT_FILE ""; print OUT_FILE "\n"; d643 1 a643 1 print OUT_FILE ""; d645 3 a647 3 print OUT_FILE "\n"; d649 1 d651 1 a651 1 print OUT_FILE "
"; print OUT_FILE "
"; print OUT_FILE "$indiv_name{$child[$i]}

\n
"; print OUT_FILE $str_m; d661 1 a661 1 print OUT_FILE "($i) "; d663 1 a663 1 print OUT_FILE "$spouse

\n

\n"; d680 1 a680 1 print OUT_FILE "$str_father $father
\n"; d682 1 d685 1 a685 1 print OUT_FILE "$str_mother $mother

\n"; d687 1 d689 1 a689 1 print OUT_FILE "

\n"; d696 1 a696 1 print OUT_FILE "

\n"; d700 3 a702 3 print OUT_FILE "

$str_notes

\n"; print OUT_FILE "$indiv_note{$indiv_id}\n"; print OUT_FILE "

\n"; d705 1 a705 1 print OUT_FILE "Pedigree Chart\n"; d708 61 a768 1 print OUT_FILE $div_str; d771 4 a774 3 print OUT_FILE @@html_ind_bot; &print_footer; close(OUT_FILE); d778 1 a778 1 # Clear out $div_str d780 2 d787 35 a821 2 print PED_OUT "Recurse Table\n"; print PED_OUT "