Tree-File

 view release on metacpan or  search on metacpan

lib/Tree/File.pm  view on Meta::CPAN

}

sub get {
  my ($self, $id, $autovivify) = @_;

  $id && $id =~ s|\A/+||;
  my $rest;

  croak "get called on $self without property identifier" unless defined $id;

  ($id, $rest) = split m|/|, $id, 2;
  if ($rest) {
    my $head = $self->get($id, $autovivify);
    return $self->_not_found($id, $self->{root}) unless $head;
    return $head->get($rest, $autovivify);
  }

  if (exists $self->{data}{$id}) {
    if (ref $self->{data}{$id} eq 'CODE') {
      $self->{data}{$id} = $self->{data}{$id}->();
    }

lib/Tree/File.pm  view on Meta::CPAN

  $value = $value->data if eval { $value->isa("Tree::File") };

  croak "set called on readonly tree" if $self->{readonly};

  $id && $id =~ s|\A/+||;
  $root = $id unless $root;
  my $rest;

  croak "set called on $self without property identifier" unless defined $id;

  ($id, $rest) = split m|/|, $id, 2;
  if ($rest) { return $self->get($id, 1)->set($rest, $value, $root); }

  return $self->{data}{$id} =
    $self->_new_node($root, $value);
}

=head2 C<< $tree->delete($id) >>

This method deletes the identified branch (and returns the deleted value).

lib/Tree/File.pm  view on Meta::CPAN

sub delete { ## no critic Homonym
  my ($self, $id) = @_;

  croak "delete called on readonly tree" if $self->{readonly};

  $id && $id =~ s|\A/+||;
  my $rest;

  croak "delete called on $self without property identifier" unless defined $id;

  ($id, $rest) = split m|/|, $id, 2;
  if ($rest) { return $self->get($id)->delete($rest); }

  return delete $self->{data}{$id};
}

=head2 C<< $tree->move($old_id, $new_id) >>

This method deletes the value at the old id and places it at the new id.

=cut

lib/Tree/File.pm  view on Meta::CPAN

=head2 C<< $tree->basename() >>

This method retuns the base name of the node.  (If, for example, the path to
the node is "/things/good/all" then its base name is "all".)

=cut

sub basename {
  my ($self) = @_;
  my @parts = split m{/}, $self->path();
  return $parts[-1];
}

sub _handoff {
  my $self = shift;
  my $method = (caller(1))[3];
  $method =~ s/.*:://;
  my $node = $self->get(@_);
  unless ($node) {
    return $self->_not_found(@_);