view release on metacpan or  search on metacpan

Ace/Object.pm  view on Meta::CPAN

  }

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


################# delete a portion of the tree #############
# Only changes local copy until you perform commit() #
#  returns true if this is a valid thing to do #
sub replace {
  my $self = shift;
  my($tag,$oldvalue,$newvalue,@rest) = rearrange([['TAG','PATH'],
						  ['OLDVALUE','OLD'],
						  ['NEWVALUE','NEW']],@_);
    $self->delete($tag,$oldvalue);
    $self->add($tag,$newvalue,@rest);
    delete $self->{'.PATHS'}; # uncache cached values
    1;
}

# commit changes from local copy to database copy
sub commit {
  my $self = shift;
  return unless my $db = $self->db;
  
  my ($retval,@cmd);
  my $name = $self->{'name'};
  return unless defined $name;
  
  $name =~ s/([^a-zA-Z0-9_-])/\\$1/g;
  return 1 unless exists $self->{'.update'} && $self->{'.update'};

  $Ace::Error = '';
  my $result = '';

  # bad design alert: the following breaks encapsulation
  if ($db->db->can('write')) { # new way for socket server
    my $cmd = join "\n","$self->{'class'} : $name",@{$self->{'.update'}};
    warn $cmd if $self->debug;
    $result = $db->raw_query($cmd,0,'parse');  # sets Ace::Error for us
  } else {   # old way for RPC server and local
    my $cmd = join('; ',"$self->{'class'} : $name",
		   @{$self->{'.update'}});
    warn $cmd if $self->debug;
    $result = $db->raw_query("parse = $cmd");
  }

  if (defined($result) and $result=~/write( or admin)? access/im) {  # this keeps changing
    $Ace::Error = "Write access denied";
  } elsif (defined($result) and $result =~ /sorry|parse error/mi) {
    $Ace::Error = $result;
  }
  return if $Ace::Error;
  undef $self->{'.update'};
  # this will force a fresh retrieval of the object
  # and synchronize our in-memory copy with the db
  delete $self->{'.right'};
  delete $self->{'.PATHS'};
  return 1;
}

# undo changes
sub rollback {
    my $self = shift;
    undef $self->{'.update'};
    # this will force object to be reloaded from database
    # next time it is needed.
    delete $self->{'.right'};
    delete $self->{'.PATHS'};
    1;
}

sub debug {
    my $self = shift;
    Ace->debug(@_);
}

### Get or set the date style (actually calls through to the database object) ###
sub date_style {
  my $self = shift;
  return unless $self->db;
  return $self->db->date_style(@_);
}

sub _asHTML {
  my($self,$out,$position,$level,$morph_code) = @_;
  do {
    $$out .= "<TR ALIGN=LEFT VALIGN=TOP>" unless $position;
    $$out .= "<TD></TD>" x ($level-$position-1);
    my ($cell,$prune,$did_it_myself) = $morph_code->($self);
    $$out .= $did_it_myself ? $cell : "<TD>$cell</TD>";
    if ($self->comment) {
      my ($cell,$p,$d) = $morph_code->($self->comment);
      $$out .= $d ? $cell : "<TD>$cell</TD>";
      $$out .= "</TR>\n" . "<TD></TD>" x $level unless $self->down && !defined($self->right);
    }
    $level = $self->right->_asHTML($out,$level,$level+1,$morph_code) if defined($self->right) && !$prune;
    $$out .= "</TR>\n" if defined($self = $self->down);
    $position = 0;
  } while defined $self;
  return --$level;
}


# This function is overly long because it is optimized to prevent parsing
# parts of the tree that haven't previously been parsed.
sub _asTable {
    my($self,$out,$position,$level) = @_;
    do {
      if ($self->{'.raw'}) {  # we still have raw data, so we can optimize
	my ($a,$start,$end) = @{$self}{ qw(.col .start_row .end_row) };
	my @to_append = map { join("\t",@{$_}[$a..$#{$_}]) } @{$self->{'.raw'}}[$start..$end];
	my $new_row;
	foreach (@to_append) {
	  # hack alert
	  s/(\?.*?[^\\]\?.*?[^\\]\?)\S*/$self->_ace_format(Ace->split($1))/eg;