view release on metacpan or  search on metacpan

Ace/Object.pm  view on Meta::CPAN

################# kill an object ################
# Removes the object from the database immediately.
sub kill {
  my $self = shift;
  return unless my $db = $self->db;
  return 1 unless $db->count($self->class,$self->name);
  my $result = $db->raw_query("kill");
  if (defined($result) and $result=~/write access/im) {  # this keeps changing
    $Ace::Error = "Write access denied";
    return;
  }
  # uncache cached values and clear the object out
  # as best we can
  delete @{$self}{qw[.PATHS .right .raw .down]};
  1;
}

# sub isTimestamp {
#   my $self = shift;
#   return 1 if $self->class eq 'UserSession';
#   return;
# }

sub isComment {
  my $self = shift;
  return 1 if $self->class eq 'Comment';
  return;
}

################# add a new row #############
#  Only changes local copy until you perform commit() #
#  returns true if this is a valid thing to do #
sub add_row {
  my $self = shift;
  my($tag,@newvalue) = rearrange([['TAG','PATH'],'VALUE'],@_);

  # flatten array refs into array
  my @values = map { ref($_) && ref($_) eq 'ARRAY' ? @$_ : $_ } @newvalue;

  # make sure that this entry doesn't already exist
  unless ($tag =~ /\./) {
    my $model = $self->model;
    my @intermediate_tags = $model->path($tag);
    $tag = join '.',@intermediate_tags,$tag;
  }
  my $row = join(".",($tag,map { (my $x = $_) =~s/\./\\./g; $x } @values));
  return if $self->at($row);  # an identical row already exists in the object

  # If we get here then we need to turn @values into an array of Ace::Objects
  # for insertion.  Also need to link them together into a row.
  my $previous;
  foreach (@values) {
    if (ref($_) && $_->isa('Ace::Object')) {
      $_ = $_->_clone;
    } else {
      $_ = $self->new('scalar',$_);
    }
    $previous->{'.right'} = $_ if defined $previous;
    $previous = $_;
    $_->{'.right'} = undef; # make sure it doesn't automatically expand!
  }

  # position at the indicated tag (creating it if necessary)
  my (@tags) = $self->_split_tags($tag);
  my $p = $self;
  foreach (@tags) {
    $p = $p->_insert($_);
  }
  if ($p->{'.right'}) {
    $p = $p->{'.right'};
    while (1) { 
      last unless $p->{'.down'};
      $p = $p->{'.down'};
    }
    $p->{'.down'} = $values[0];
  } else {
    $p->{'.right'} = $values[0];
  }

  push(@{$self->{'.update'}},join(' ',map { Ace->freeprotect($_) } (@tags,@values)));
  delete $self->{'.PATHS'}; # uncache cached values
  $self->_dirty(1);
  1;
}

# Use this method to add an entire subobject to the right of the tag.
# The tree may come from another database.
sub add_tree {
  my $self = shift;
  my($tag,$value,@rest) = rearrange([['TAG','PATH'],['VALUE','TREE']],@_);
  croak "Value must be an Ace::Object" unless ref($value) && $value->isa('Ace::Object');

  unless ($tag =~ /\./) {
    my $model = $self->model;
    my @intermediate_tags = $model->path($tag);
    $tag = join '.',@intermediate_tags,$tag;
  }

  # position at the indicated tag, creating it if necessary
  my (@tags) = $self->_split_tags($tag);
  my $p = $self;
  foreach (@tags) {
    $p = $p->_insert($_);
  }
  # Copy the subtree too
  if ($p->{'.right'}) {
    $p = $p->{'.right'};
    while (1) { 
      last unless $p->{'.down'};
      $p = $p->{'.down'};
    }
    $p->{'.down'} = $value->{'.right'};
  } else {
    $p->{'.right'} = $value->{'.right'};
  }
  push(@{$self->{'.update'}},map { join(' ',@tags,$_) } split("\n",$value->asAce));
  delete $self->{'.PATHS'}; # uncache cached values
  $self->_dirty(1);
  1;
}