#!/usr/bin/perl
# Filename:	gedcom2xml
# Author:	Thorsten Riemer
  my $VERSION=  1.00;
# See License:	Freeware
# Description:	converts a gedcom file to xml
use strict;

##################################################
# Setup the variables
##################################################
my $PROGNAME = $0;
$PROGNAME =~ s|.*/||;

##################################################
# Usage
##################################################
sub usage {
  foreach my $msg (@_) { print STDERR "ERROR:  $msg\n"; }

print STDERR <<USAGE;

Usage:	
converts a gedcom file to xml

$PROGNAME <gedcomfile>

Examples:
% $PROGNAME gedcom.txt		

Author:      
Thorsten Riemer, http://www.riemerundco.de


USAGE

  exit -1;
}

sub version {
  print "\n";
  printf "This is $PROGNAME version %4.2f\n",$VERSION;
  print "\n";
  print "Copyright (c) 2004 Thorsten Riemer <riemerundco.de>\n";
  print "\n";
  exit -1;
}

sub parse_args {
  my $gedcom;
  while (my $arg=shift(@ARGV)) {
    if ($arg =~ /^-h$/) { usage(); }
    if ($arg =~ /^-v$/) { version(); }
    if ($arg =~ /^-d$/) { $MAIN::DEBUG=1; next; }
    if ($arg =~ /^-.+/) { usage("Unknown option: $arg"); }
    usage("Too many files specified [$arg and $gedcom]") if defined $gedcom;
    $gedcom=$arg;
  }
  usage("No gedcom file specified!") unless $gedcom;

  ($gedcom);
}

sub debug {
  return unless $MAIN::DEBUG;
  foreach my $msg (@_) { print STDERR "[$PROGNAME] $msg\n"; }
}

##################################################
# Main code
##################################################
sub load {
  my ($gedcom) = @_;
  debug($gedcom);
  open(FH, $gedcom) || die "file not found: $gedcom, ";;
  my @lines = <FH>;
  close(FH);
  my @tags;
  my $lidx = -1;
  
  print "<GEDCOM>";
  foreach(@lines) 
  {
    my $line = $_;
    if (length($line) > 5) {
      $line =~ /\s*([0-9]*)\s([0-9A-Z_@]*)\s(.*)/;
      my $idx = $1;
      my $cmt = $2;
      my $val = $3;
      my $ptr = "";
      
      if ($cmt =~ /^CONT|^CONC/) { 
     	print "$val"; 
     	next;
      }
      
      if ($cmt =~ /^@/) { 
     	$ptr = $cmt;
     	$cmt = $val;
     	$ptr =~ s/@//g; 
      }

      print "\n";
      for (my $i=$lidx; $i>=$idx; $i--) {
      	space($i);
      	print "</$tags[$#tags]>\n";
      	pop(@tags);
      }

      push(@tags, $cmt);
      space($idx);
      
      if (length($ptr) > 0) {
        print "<$cmt Id=\"$ptr\">";
      }
      else {
        print "<$cmt>";
        if (length($val) > 0) {
          if ($val =~ /^@/) { 
     	    $val =~ s/@//g; 
     	    print "<LINK Id=\"$val\"/>"
          }
          else {
      	   print " $val";
      	  }
        }
      }

      $lidx = $idx;
    }
  }
  for (my $i=$lidx; $i>=0; $i--) {
    space($i);
    print "</$tags[$#tags]>\n";
    pop(@tags);
  }
  print "</GEDCOM>";
}

sub space {
  my $cnt = shift;

  for (my $i=0; $i<$cnt; $i++){
   print "  ";	
  }
}
  
  

sub main {
  my $gedcom = parse_args();
  load($gedcom);
}

main();