view release on metacpan or  search on metacpan

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

		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;