view release on metacpan or  search on metacpan

lib/AddressBook/DB/PDB.pm  view on Meta::CPAN

  my %reverse_category_hash = reverse %{$self->{category_hash}};
  my ($i,%attr,$found);
  if ($self->{index} < $self->{pdb}->getRecords) {
    my $record = PDA::Pilot::Address::Unpack($self->{pdb}->getRecord($self->{index}++));
    if ($record->{deleted}) {
      $self->{pdb}->deleteRecord($record->{id});
      return ($self->read);
    }
    my %labels = %{$self->_insert_phone_labels($record->{phoneLabel})};
    for ($i=0;$i<=$#{$record->{entry}};$i++) {
      if (defined $record->{entry}->[$i]) {
	@{$attr{$labels{$i}}} = split /$self->{intra_attr_sep_char}/ ,$record->{entry}->[$i];
      }
    }
    my $entry = AddressBook::Entry->new(config=>$self->{config},
				        db=>$self->{db_name},
				        attr=>\%attr);
    $entry->add(db=>$self->{db_name},
		attr=>{category=>$reverse_category_hash{$record->{category}}});
    if ($record->{modified}) {$entry->{timestamp} = ParseDate("Today")}
    else {$entry->{timestamp} = 0}
    return $entry;
  } else {
    return undef;
  }
}

sub _insert_phone_labels {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  my ($phoneLayout) = @_;
  my $i;
  my %labels = reverse %{$self->{field_labels}};
  my %phone_labels = reverse %{$self->{phone_labels}};
  for ($i=0;$i<=4;$i++) {
    $labels{$i+3} = $phone_labels{$phoneLayout->[$i]};
  }
  return \%labels;
}

sub write {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  my $entry = shift;
  $entry->calculate;
  my $record = $self->{pdb}->newRecord;
  my ($field,$i,$j,@phone_display,$phone_display,$phone_display_calc,$phone_target,$value,@phone_attrs);
  $entry->calculate;
  my %labels = %{$self->{field_labels}};
  my $attrs = $entry->get(db=>$self->{db_name});
  my $phone_index = 0;
  foreach $field (keys %{$attrs}) {
    $value = join $self->{intra_attr_sep_char}, @{$attrs->{$field}->{value}};
    if ($field eq "category") {
      if (! exists $self->{category_hash}->{$value}) {
	$self->_add_category($value);
      }
      $record->{category}=$self->{category_hash}->{$value};
    } elsif (exists $self->{phone_labels}->{$field}) {
      push @phone_attrs, $field;
      next; #defer phone field processing until later
    } else {
      $record->{entry}->[$labels{$field}] = $value;
    }
  }
  # now process phone fields
  foreach $field (sort {$attrs->{$a}->{meta}->{order} <=> $attrs->{$b}->{meta}->{order}} @phone_attrs) {
    # for the time being, we will concatenate like phone fields
    $value = join $self->{intra_attr_sep_char}, @{$attrs->{$field}->{value}};
    $record->{phoneLabel}->[$phone_index] = $self->{phone_labels}->{$field};
    $record->{entry}->[$phone_index+3] = $value;
    $phone_index++;
    if ($phone_index == 5) {last}  # there is only room for 5 "phone" fields
  }
  for ($i=0;$i<=keys %labels;$i++) {
    unless ($record->{entry}->[$i]) {$record->{entry}->[$i] = undef}
  }
  ($phone_display_calc = $self->{phone_display}) =~ s/\$([\w-]+)/\$attrs->{$1}->{value}->[0]/g;
  eval qq{ \$phone_display = $phone_display_calc }; warn "Syntax error in phone_display_calc: $@" if $@;
  @phone_display = split ",",$phone_display;
 find_phone: for ($i=0;$i<=$#phone_display;$i++) {
   if ($attrs->{$phone_display[$i]}->{value}->[0]) {
     $phone_target = $self->{phone_labels}->{$phone_display[$i]};
     for ($j=0;$j<=$#{$record->{phoneLabel}};$j++) {
       if ($record->{phoneLabel}->[$j] == $phone_target) {
	 $record->{showPhone} = $j;
	 last find_phone;
       }
      }
   }
 }
  $self->{pdb}->setRecord($record);
  return;
}

sub _add_category {
  my $self = shift;
  my ($new_cat) = @_;
  my $class = ref $self || croak "Not a method call";
  my $appBlock = PDA::Pilot::Address::UnpackAppBlock($self->{pdb}->getAppBlock);
  my @categories = @{$appBlock->{categoryName}};
  my $i;
  for ($i=0;$i<=$#categories;$i++) {
    last if ($categories[$i] eq "");
  }
  $appBlock->{categoryName}->[$i] = $new_cat;
  $self->{pdb}->setAppBlock($appBlock);
  $self->_read_appinfo;
}

sub _read_appinfo {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  my $appBlock = PDA::Pilot::Address::UnpackAppBlock($self->{pdb}->getAppBlock);
  $self->{category_hash} = {};
  my @categories = @{$appBlock->{categoryName}};
  my $i;
  for ($i=0;$i<=$#categories;$i++) {
    $self->{category_hash}->{$categories[$i]} = $i;
  }
  my @labels = $appBlock->{label};
  for ($i=0;$i<=$#{$labels[0]};$i++) {
    $self->{field_labels}->{$labels[0][$i]} = $i;
  }
  my @phone_labels = $appBlock->{phoneLabel};
  for ($i=0;$i<=$#{$phone_labels[0]};$i++) {
    $self->{phone_labels}->{$phone_labels[0][$i]} = $i;
  }
}

sub truncate {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  $self->{pdb}->deleteRecords;
  $self->reset;
}

sub _remove_deleted_records {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  my ($i,$record);
  for ($i=$self->{pdb}->getRecords-1;$i>=0;$i--) {
    $record = PDA::Pilot::Address::Unpack($self->{pdb}->getRecord($i));
    if ($record->{deleted}) {
      $self->{pdb}->deleteRecord($record->{id});
    }
  }
}

sub write_to_disk {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  $self->pdb->Write($self->{filename});
}

1;
__END__

=head2 Timestamps

For syncronization purposes, all records which have the "modified" flag set are
timestamped with the current time.  All records with have the "modified" flag
unset are timestamped with "0" (very, very old).

=head1 Deleted Records

PDB records which have the "deleted" flag set are removed as part of the initialization
process.  The "archive" flag is ignored. 

=head1 Categories

For convienience, a record's category is treated like any other attribute.  New
categories are created as necessary.  Moving a record to a new category will achieve
the expected result during synchronization.
However, because renaming a category does
not cause affected records to be marked as "modified", category renaming operations will
be lost during synchronization.  

=head1 AUTHOR

David L. Leigh, <dleigh@sameasiteverwas.net>

=head1 SEE ALSO

L<AddressBook>,
L<AddressBook::Config>,
L<AddressBook::Entry>.

PDA::Pilot

=cut