view release on metacpan or  search on metacpan

Ace.pm  view on Meta::CPAN

      $self->file_cache_store($obj);
    }
    push @result,$obj;
  }
  return @result;
}

# return a portion of the active list
sub _fetch {
  my $self = shift;
  my ($count,$start,$tag) = @_;
  my (@result);
  $tag = '' unless defined $tag;
  my $query = "show -j $tag";
  $query .= ' -T' if $self->{timestamps};
  $query .= " -b $start"  if defined $start;
  $query .= " -c $count"  if defined $count;
  $self->{database}->query($query);
  while (my @objects = $self->_fetch_chunk) {
    push (@result,@objects);
  }
  # copy tag into a portion of the tree
  if ($tag) {
    for my $tree (@result) {
      my $obj = $self->class_for($tree->class,$tree->name)->new($tree->class,$tree->name,$self,1);
      $obj->_attach_subtree($tag=>$tree);
      $tree = $obj;
    }
  }
  # now recache 'em
  for (@result) {
    if (my $obj = $self->memory_cache_store($_)) {
      %$obj = %$_ unless $obj->filled;  # contents copy -- replace partial object with full object
      $_ = $obj;
    } else {
      $self->memory_cache_store($_);
    }
  }
  return wantarray ? @result : $result[0];
}

sub _fetch_chunk {
  my $self = shift;
  return unless $self->{database}->status == STATUS_PENDING();
  my $result = $self->{database}->read();
  $result =~ s/\0//g;  # get rid of &$#&@!! nulls
  my @chunks = split("\n\n",$result);
  my @result;
  foreach (@chunks) {
    next if m!^//!;
    next unless /\S/;  # occasional empty lines
    my ($class,$id) = Ace->split($_); # /^\?([^?]+)\?([^?]+)\?/m;
    push(@result,$self->class_for($class,$id)->newFromText($_,$self));
  }
  return @result;
}

sub _alert_iterators {
  my $self = shift;
  foreach (keys %{$self->{iterators}}) {
    $self->{iterators}{$_}->invalidate if $self->{iterators}{$_};
  }
  undef $self->{active_list};
}

sub asString {
  my $self = shift;
  return "tace://$self->{path}" if $self->{'path'};
  my $server = $self->db && $self->db->isa('Ace::SocketServer') ? 'sace' : 'rpcace';
  return "$server://$self->{host}:$self->{port}" if $self->{'host'};
  return ref $self;
}

sub cmp {
  my ($self,$arg,$reversed) = @_;
  my $cmp;
  if (ref($arg) and $arg->isa('Ace')) {
    $cmp = $self->asString cmp $arg->asString;
  } else {
    $cmp = $self->asString cmp $arg;
  }
  return $reversed ? -$cmp : $cmp;
}


# Count the objects matching pattern without fetching them.
sub count {
  my $self = shift;
  my ($class,$pattern,$query) = rearrange(['CLASS',
					   ['NAME','PATTERN'],
					   'QUERY'],@_);
  $Ace::Error = '';

  # A special case occurs when we have already fetched this
  # object and it is already on the active list.  In this
  # case, we do not need to recount.
  $query   = '' unless defined $query;
  $pattern = '' unless defined $pattern;
  $class   = '' unless defined $class;

  my $active_tag = "$class$pattern$query";
  if (defined $self->{'active_list'} &&
      defined ($self->{'active_list'}->{$active_tag})) {
    return $self->{'active_list'}->{$active_tag};
  }

  if ($query) {
    $query = "query $query" unless $query=~/^query\s/;
  } else {
    $pattern =~ tr/\n//d;
    $pattern ||= '*';
    $pattern = Ace->freeprotect($pattern);
    $query = "find $class $pattern";
  }
  my $result = $self->raw_query($query);
#  unless ($result =~ /Found (\d+) objects/m) {
  unless ($result =~ /(\d+) Active Objects/m) {
    $Ace::Error = 'Unexpected close during find';
    return;
  }
  return $self->{'active_list'}->{$active_tag} = $1;