#------------------------------------------------------------------------------
#   $Date: 2000/12/03 17:16:34 $
#   RCS: $Id: bbdb.pm,v 1.11 2000/12/03 17:16:34 tdeweese Exp $
#------------------------------------------------------------------------------

package bbdb;

use strict;
use FileHandle;
use bbdb::bbdbRecord;

$bbdb::DEFAULT_VERSION = "6";

sub new {
    my $type = shift;
    my $self = {};
    my $file = shift;

     # database file
    $self->{'file'} = $file || $ENV{BBDB} || "$ENV{HOME}/.bbdb";
    $self->{'callback'} = shift;
    $self->{'version'} = ${bbdb::DEFAULT_VERSION};
    $self->{'records'} = [];
    bless ($self, $type);

    $self->read();
    
    $self;
}

sub read
{
    my $self = shift;
    my $file = shift || $self->{'file'};

    #############################
    #
    # Open bbdb file or STDIN
    my $BBDB;
    if($file eq "-") {
      $BBDB = "STDIN";
    } else {
      $BBDB = new FileHandle($file);
    }

    return if (!$BBDB);

    my $ltime = 0;
    my $ver = 0;
    while(<$BBDB>)
    {
	chop;
	if (/^\s*;/) #comment
	{
	    if (/file-version: */)
	    { 
		$ver = $';
		die "Unknown BBDB version: $ver\n" 
		    if (($ver lt "3") || ($ver gt $bbdb::DEFAULT_VERSION));
		    
		$self->{'version'} = $ver; 
	    }
	    next;
	}

	my $rec = new bbdbRecord($_, $ver);
	push(@{$self->{'records'}}, $rec);
	if ($self->{'callback'}) {
	  my $ctime = time();
	  if ($ctime != $ltime) {
	    $self->{'callback'}->update();
	  }
	}
    }
}

sub print
{
  my $self = shift;
  
  my $rec;
  foreach $rec (@{$self->{'records'}}) {
    next if (! defined $rec);
    $rec->print();
    print "\n";
  }
}

sub eprint
{
  my $self = shift;
  my $file = shift || \*STDOUT;

  print $file ";;; file-version: $self->{'version'}\n";

  my %fields;
  my $rec;
  foreach $rec (@{$self->{'records'}}) {
    next if (! defined $rec);
    my @flst = keys(%{$rec->{'notes'}});
    my $f;
    foreach $f (@flst) {
      $fields{$f} = 1;
    }
  }

  # 'notes' is always assumed and it confuses bbdb if it's listed... :(
  delete $fields{'notes'};

  print $file ";;; user-fields: (" . join(' ', keys(%fields)) . ")\n";

  foreach $rec (@{$self->{'records'}}) {
    next if (! defined $rec);
    $rec->eprint($self->{'version'}, $file);
    print $file "\n";
  }
  
}

sub eStr
{
    my $str = shift;
    if (!$str) { return "\"\"" }
    $str =~ s/\\/\\\\/g;
    $str =~ s/\"/\\\"/g;
    $str =~ s/\n/\\n/g;
    $str =~ s/([\x80-\xFF])/"\\" . sprintf("%o", vec($1,0,8))/eg;
    return '"' . $str . '"';
}

sub mkStr
{
    my $str = shift;
    return "" if (not defined $str);
    return "" if ($str eq "nil");
    return $str;
}

sub get_fields 
{
  my $str = shift;
  my @field=();    

  return @field if (not defined $str);
  # print "In: $str\n";

  while ($str =~ m/[^ ]/) {
    # string
    if ($& eq '"') {
      $' =~ m/((?:[^\\\"]|\\.)*)\"/;
      $str = $';
      my $f = $1;
      $f =~ s/\\n/\n/g;
      $f =~ s/\\(\d\d\d)/sprintf("%c", oct($1))/eg;
      $f =~ s/\\(.)/$1/g;
      push(@field, $f); 
    }
    elsif ($& eq '(') {
      my ($f,$s) = match_parent($');
      # print "Paren: \"$f\" \"$s\"\n";
      push(@field, $f);
      $str = $s;
    }
    elsif ($& ne ' ') {
      ($& . $') =~ m/([^ \[\]\(\)]*).?/;
      # print "Wrd: \"$&\" \"$'\"\n";
      $str  = $';
      my $f = $1;
      $f = "" if ($f eq "nil");
      push(@field, $f);
    }
  }

  return @field;
}

sub match_parent 
{
  my $str   = shift;
  my $ret   = "";
  my $stack = 1;
  
  while ($str =~ m/[\]\[()\"]/ ) {
    $ret .= $`;
    if ($& eq '"') {
      $ret .= $&;
      $' =~ m/(?:[^\\\"]|\\.)*\"/;
      $ret .= $&;
      $str = $';
    }
    elsif (($& eq '(') || ($& eq '[')) {
      $ret .= $&;
      $str  = $';
      $stack++;
    }
    elsif (($& eq ')') || ($& eq ']')) {
      $stack--;
      $str = $';
      if ($stack == 0) {
	return ($ret, $str);
      }
      $ret .= $&;
    }
  }

  return ($ret, "");
}

1;