view release on metacpan or  search on metacpan

lib/AddressBook/Entry.pm  view on Meta::CPAN

      $key=$self->{config}->{generic2db}->{$_}->{$args{db}};
    } else {
      $key=$_;
    }
    if ($args{values_only}) {
      $ret->{$key}=$self->{attr}->{$_};
    } else {
      $ret->{$key}->{value}=$self->{attr}->{$_};
      %{$ret->{$key}->{meta}} = %{$self->{config}->getMeta(attr=>$_,db=>$args{db})};
    }
  }
  return $ret->{$args{attr}} if defined $args{attr};
  return $ret;
}

=head2 calculate

    $entry->calculate

Computes all calculated attributes.  Does so in the order specified
by the calc_order attribute metadata value.

=cut

sub calculate {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  my ($calculate,$result,$attr,$i);
  foreach (sort {$self->{config}->{meta}->{$a}->{calc_order} <=> 
		     $self->{config}->{meta}->{$b}->{calc_order}}
	   grep {defined $self->{config}->{meta}->{$_}->{calculate}} 
	   keys %{$self->{config}->{meta}}) {
    $calculate=$self->{config}->{meta}->{$_}->{calculate};
    foreach $attr (keys %{$self->{config}->{generic2db}}) {
      $calculate =~ s/\$$attr/\$self->{attr}->{$attr}/g;
    }
    eval qq{(\$result) = $calculate}; croak "Error in attribute calculation for \"$_\": $@" if $@;
    if (! ref $result) {
      $self->{attr}->{$_}->[0] = $result;
    } elsif (ref $result eq "ARRAY") {
      @{$self->{attr}->{$_}} = @{$result};
    } else {
      croak "Error in attribute calculation for \"$_\": result must be a scalar or arrayref\n";
    }
  }
  foreach (keys %{$self->{attr}}) {
    delete $self->{attr}->{$_} unless (defined $self->{attr}->{$_}->[0]);
  }
}

=head2 compare

  AddressBook::Entry::compare($entry1,$entry2)

Returns true if all attributes in both entries match, false otherwise.

=cut

sub compare {
  my ($entry1,$entry2) = @_;
  _compare_oneway($entry1,$entry2) || return undef;
  _compare_oneway($entry2,$entry1) || return undef;
  return 1;
}

sub _compare_oneway {
  my ($entry1,$entry2) = @_;
  my ($key,$i);
  foreach $key (keys %{$entry1->{attr}}) {
    if (defined $entry2->{attr}->{$key}) {
      for ($i=0;$i<=$#{$entry1->{attr}->{$key}};$i++) {
	if ($entry1->{attr}->{$key}->[$i] ne $entry2->{attr}->{$key}->[$i]) {
	  return undef;
	}
      }
      return undef if ($#{$entry1->{attr}->{$key}} != $#{$entry2->{attr}->{$key}});
    } else {
      return undef;
    }
  }
  return 1;
}

=head2 fill

  $entry->fill(db=>$db);
  $entry->fill(db=>$db,defaults=>1);

Ensures that the Entry includes all attributes for a specific backend database.
New attributes are added with null values.  If the "defaults" parameter is specified,
new attributes are added with values as specified by the attribute "default" metadata
specified in the config file.

=cut

sub fill {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  my %args = @_;
  unless ($args{db}) {croak "database type not specified in AddressBook::Entry::fill"}
  my (%add_hash,$value,$meta);
  foreach (values %{$self->{config}->{db2generic}->{$args{db}}}) {
    unless (exists $self->{attr}->{$_}) {
      if ($args{defaults}) {
	$meta = $self->{config}->getMeta(attr=>$_,db=>$args{db});
	$value = $meta->{default} || '';
      } else {
	$value = "";
      }
      $add_hash{$_} = $value;
    }
  }
  $self->add(attr=>\%add_hash);
}

=head2 chop

  $entry->chop

Removes null valued attributes from an Entry.

=cut

sub chop {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  my (@delete_list,@list,$key,$found,$i);
  foreach $key (keys %{$self->{attr}}) {
    $found = 0;
    @list=();
    for ($i=0;$i<=$#{$self->{attr}->{$key}};$i++) {
      if ($self->{attr}->{$key}->[$i] ne "") {
	$found=1;
	push @list,$self->{attr}->{$key}->[$i];
      }
    }
    @{$self->{attr}->{$key}} = @list;
    if (! $found) {