#!/usr/local/bin/perl # famchart.cgi # Displays and records a database of relatives. # # Copyright Travis Finucane in 2005 # You may do with this software what you will. Please send me your # suggestions for improvement, which I am sure are numerous and # fervently believed. # use strict; use Fcntl ":flock"; use CGI; my $cgi = new CGI; # # Database is a flatfile. Entries look like this: # id|name|nee|birthday|deathday|father id|mother id|c:s:spouse:ids|c:s:child:ids # for example: # 1|Abigail Grace Finucane||July 7, 2004||2|3|| # my $G_ID = 0; my $G_NAME = 1; my $G_NEE = 2; my $G_BIRTHDAY = 3; my $G_DEATHDAY = 4; my $G_PARENTS = 5; my $G_HAREM = 6; my $G_CHILDREN = 7; my $G_HEADSHOT = 8; my $G_NUMFIELDS = 9; my $G_TRUE = 1; my $G_FALSE = 0; my @fam_data; my $data_file = "../../famchart/finucane.txt"; my $pics_dir = "../../famchart/pics"; print "Content-type:text/html\n\n"; print < Finucane Family Tree

Descendents and Ancestors

Finucane.org Home.
Recenter on Thomas.

EndOfHTML if ($cgi->request_method() eq "GET") { build_data($data_file); my $action = $cgi->param('action'); my $prinid = $cgi->param('prinid'); my $partid = $cgi->param('partid'); if ($prinid) { if ( $action eq "edit") { make_editform($prinid); } elsif ( $action eq "addspouse") { my $spouse_prinid = create_new_prin($data_file); marry($data_file, $spouse_prinid, $prinid); make_editform($spouse_prinid); } elsif ( $action eq "addparents") { my $paren1 = create_new_prin($data_file); my $paren2 = create_new_prin($data_file); marry($data_file, $paren1, $paren2); spawn($data_file, $prinid, $paren1, $paren2); make_editform($paren1); } elsif ( $action eq "addchild" && $partid ) { my $childid = create_new_prin($data_file); spawn($data_file, $childid, $prinid, $partid); make_editform($childid); } elsif ( $action eq "roots" ) { make_tree($prinid, $G_TRUE); } else { make_tree($prinid, $G_FALSE); } } else { make_tree(9, $G_FALSE); } exit; } elsif ($cgi->request_method() eq "POST") { build_data($data_file); my $action = $cgi->param('action'); my $prinid = $cgi->param('prinid'); if ($prinid) { if ( $action eq "edit") { update_prin($prinid); } write_prindata(getprin($prinid)); } exit; } sub build_data { my($source_file) = @_; open FILE, "$source_file" or die "Could not open $source_file!\n"; until ( flock FILE, LOCK_EX ) { sleep 1; } @fam_data = ; close FILE; return; } sub write_data { my($source_file) = @_; open FILE, ">$source_file" or die "Could not open $source_file for writing!\n"; until ( flock FILE, LOCK_EX ) { sleep 1; } my $i; foreach $i (@fam_data) { chomp($i); print FILE "$i\n"; } close FILE; return; } sub make_editform { my($edit_id) = @_; my(@prin) = getprin($edit_id); print("

"); print("Name:
"); print("Birth Name:
"); print("Date of Birth:
"); if (@prin[$G_DEATHDAY] ne "x") { print("Died:
"); }else { print(""); } if (@prin[$G_HEADSHOT] eq "x") { print "

Put a .jpg image here:
"; print "

"; } print("
"); print("
"); print("
"); print("

"); print("Add Spouse
"); print("Add Parent Pair

"); my(@harem) = getharem(@prin); if (@harem[0] != "x") { opentags(); my $spouse; my @partner; foreach $spouse(@harem) { middletags(); @partner = getprin($spouse); write_prindata(@partner); print(" \; \; \; \;"); print("Add a Child with this spouse"); } closetags(); } print("
\n\n\n"); return; } sub update_prin { my($prinid) = @_; my(@principal) = getprin($prinid); if ($cgi->param("name")) { @principal[$G_NAME] = $cgi->param("name"); } else { @principal[$G_NAME] = "x"; } if ($cgi->param("nee")) { @principal[$G_NEE] = $cgi->param("nee"); } else { @principal[$G_NEE] = "x"; } if ($cgi->param("birth")) { @principal[$G_BIRTHDAY] = $cgi->param("birth"); } else { @principal[$G_BIRTHDAY] = "x"; } if ($cgi->param("death")) { @principal[$G_DEATHDAY] = $cgi->param("death"); } else { @principal[$G_DEATHDAY] = "x"; } if ($cgi->param("image")) { my $image = $cgi->upload("image"); my $bytesread; my $buffer; my $imagename = lc($image); my $thumb = substr($imagename, 0, - 3) . "gif"; print("update_prin: $thumb
"); # Copy a binary file to somewhere safe if (-e "$pics_dir/$imagename") { print ("File $imagename already exists!\n"); } else { open (OUTFILE,">>$pics_dir/$imagename"); while ($bytesread=read($image,$buffer,1024)) { print OUTFILE $buffer; } } # makethumb.pl is just a wrapper for the Linux utility "convert" system("./mkthumb.pl", "$pics_dir/$imagename"); print ("update_prin: $imagename
"); @principal[$G_HEADSHOT] = substr($imagename, 0, - 3); } my($prinstring)=stringify_prin(@principal); @fam_data[$prinid] = "$prinstring"; write_data($data_file); return; } sub create_new_prin { my ($file) = @_; my $new_id = @fam_data; my @principal; @principal[$G_ID] = "$new_id"; for ( my $i = 1; $i < $G_NUMFIELDS; $i++ ) { @principal[$i] = "x"; } my($prinstring)=stringify_prin(@principal); @fam_data[$new_id] = "$prinstring"; write_data($file); return $new_id; } sub marry { my($file, $spouse_prinid, $prinid) = @_; my @principal = getprin(@fam_data[$spouse_prinid]); if ( @principal[$G_HAREM] ne "x" ) { @principal[$G_HAREM] = @principal[$G_HAREM] . ":$prinid"; } else { @principal[$G_HAREM] = "$prinid"; } my($prinstring) = stringify_prin(@principal); @fam_data[$spouse_prinid] = "$prinstring"; @principal = getprin(@fam_data[$prinid]); if ( @principal[$G_HAREM] ne "x" ) { @principal[$G_HAREM] = @principal[$G_HAREM] . ":$spouse_prinid"; } else { @principal[$G_HAREM] = "$spouse_prinid"; } $prinstring = stringify_prin(@principal); @fam_data[$prinid] = "$prinstring"; write_data($file); } sub spawn { my($file, $childid, $prinid, $partid) = @_; my @principal = getprin(@fam_data[$prinid]); if ( @principal[$G_CHILDREN] ne "x" ) { @principal[$G_CHILDREN] = @principal[$G_CHILDREN] . ":$childid"; } else { @principal[$G_CHILDREN] = "$childid"; } my($prinstring)=stringify_prin(@principal); @fam_data[$prinid] = "$prinstring"; my @principal = getprin(@fam_data[$partid]); if ( @principal[$G_CHILDREN] ne "x" ) { @principal[$G_CHILDREN] = @principal[$G_CHILDREN] . ":$childid"; } else { @principal[$G_CHILDREN] = "$childid"; } my($prinstring)=stringify_prin(@principal); @fam_data[$partid] = "$prinstring"; my @principal = getprin(@fam_data[$childid]); if ( @principal[$G_PARENTS] ne "x" ) { @principal[$G_PARENTS] = @principal[$G_CHILDREN] . ":$prinid:$partid"; } else { @principal[$G_PARENTS] = "$prinid:$partid"; } my($prinstring)=stringify_prin(@principal); @fam_data[$childid] = "$prinstring"; write_data($file); } sub make_tree { my($top_id, $doroots ) = @_; my(@principal) = getprin($top_id); opentags(); print("

"); write_prindata(@principal); if ( !$doroots ) { my(@harem) = getharem(@principal); if (@harem[0] != "x") { my $spouse; foreach $spouse(@harem) { write_prindata(getprin($spouse)); } } } middletags(); if ( $doroots ) { my(@parents) = getparents(@principal); if (@parents[0] != "x") { my $parent; foreach $parent(@parents) { make_tree($parent, $G_TRUE); } } }else { my(@children) = getchildren(@principal); if (@children[0] != "x") { my $child; foreach $child(@children) { make_tree($child); } } } closetags(); return; } sub getprin { my($id) = @_; return split(/\|/, @fam_data[$id]); } sub stringify_prin { my(@principal) = @_; my $prinstr; for ( my $i = 0; $i < $G_NUMFIELDS; $i++ ) { $prinstr = $prinstr . "@principal[$i]|"; } return $prinstr; } sub getchildren { my(@prin) = @_; return split(/\:/, @prin[$G_CHILDREN]); } sub getparents { my(@prin) = @_; if (@prin[$G_PARENTS] ne "x") { return split(/\:/, @prin[$G_PARENTS]); } } sub getharem { my(@prin) = @_; if (@prin[$G_HAREM] ne "x") { return split(/\:/, @prin[$G_HAREM]); } } sub opentags { print("\n"); print("\n"); print(""); print("\n"); print("

\n"); return; } sub middletags { print("\n"); print("

\n"); return; } sub write_prindata { my(@prin) = @_; print(" \; \; \; \;"); print(""); print("@prin[$G_NAME] \; \; \; \;
"); if (@prin[$G_NEE] ne "x") { print(" \; \; \; \;"); print("née: @prin[$G_NEE]
\n"); } if (@prin[$G_BIRTHDAY] ne "x") { print(" \; \; \; \;"); print("Born: @prin[$G_BIRTHDAY]
"); } if (@prin[$G_DEATHDAY] ne "x") { print(" \; \; \; \;"); print(", Died: @prin[$G_DEATHDAY]
"); } print(" \; \; \; \;"); if ( @prin[$G_PARENTS] ne "x" ) { my @parents = getparents( @prin ); print("<- "); print("<< "); } print("edit"); if (@prin[$G_HEADSHOT] ne "x") { print(" \;"); print(""); print("

\;"); } print(" \; \; \; \;"); print("
\n\n\n"); return; } sub closetags { print("

\n"); print("

\n\n"); return; }