dtRdr::NoteThread - an n-ary tree of notes

  my (@threads) = dtRdr::NoteThread->create(@notes);

  my (@threads) = dtRdr::NoteThread->create(@notes);

  my $note = dtRdr::NoteThread->dummy($id, $descendant);

  my $thread = dtRdr::NoteThread->new($note, $parent);

  my $sub = sub {
    my ($node, $ctrl) = @_;
    if(something($node)) {
      $ctrl->{prune} = 1; # do not follow children
    }
  };
  $tree->rmap($sub);

package dtRdr::NoteThread;
$VERSION = eval{require version}?version::qv($_):$_ for(0.0.1);

use warnings;
use strict;

use Tree::Simple 'use_weak_refs';
use base 'Tree::Simple'; # I guess

# the id will always be the note id
use Method::Alias (
# new     old     (Method::Alias still feels backwards)
  id   => 'getUID',
  note => 'getNodeValue',
  # the rest are names that I just don't like because this isn't java
  map({my $n = $_; $n =~ s/^get//; (lc($n) => $_)} qw(
    getDepth
    getWidth
    getIndex
    getParent
  )),
  children => 'getAllChildren',
  is_root  => 'isRoot',
  # and these to make it pretend to be a range
  'a'         => 'get_start_pos',
  'start_pos' => 'get_start_pos',
  'b'         => 'get_end_pos',
  'end_pos'   => 'get_end_pos',
);

  sub has_children {return(! $_[0]->isLeaf);}
  sub get_start_pos {return($_[0]->note->get_start_pos)};
  sub get_end_pos {return($_[0]->note->get_end_pos)};

  sub is_dummy {return($_[0]->note->is_fake)}; # for now

  # the text 'root' makes a terrible object, and yet it is a true value,
  # which is about useless thank you very much
  sub getParent {
    my $self = shift;
    my $p = $self->SUPER::getParent;
    $p or die "now what?";
    ($p eq 'root') and return();
    return($p);
  }

use constant {ANNOTATION_TYPE => 'notethread'};

sub create {
  my $package = shift;
  my @notes = @_;
  my %notes = map({$_->id => $_} @notes);
  # not sure if I can build trees and arbitrarily plug them together.
  my %roots; # will hold rootlist
  my %done;
  my $mk_root = sub {
    my ($rid, $note) = @_;
    my $tree = $package->new($note);
    return($roots{$rid} = $done{$rid} = $tree);
  };
  my $get_root = sub {
    my ($rid, $child) = @_;
    $roots{$rid} and return($roots{$rid});
    my $note = $notes{$rid};
    unless($note) {
      $note = $package->dummy($rid, $child);
    }
    return($mk_root->($rid, $note));
  };
  my $mk_tree = sub {
    my ($id, $note, $parent) = @_;
    my $tree = $package->new($note, $parent);
    return($done{$id} = $tree);
  };
  my $get_parent;
  $get_parent = sub {
    my ($note, @anc) = @_;
    # lookup
    if(my $tree = $done{$anc[0]}) {
      return($tree);
    }
    # create
    if(1 == scalar(@anc)) {
      return($get_root->($anc[0], $note));
    }
    my $grandparent = $get_parent->($note, @anc[1..$#anc]);
    my $pid = $anc[0];
    my $pnote = $notes{$pid};
    unless($pnote) {
      $pnote = $package->dummy($pid, $note);
    }
    return($mk_tree->($pid, $pnote, $grandparent));
  };
  foreach my $note (@notes) {
    my $id = $note->id;
    $done{$id} and next;
    if(my @ancestors = $note->references) {
      my $parent = $get_parent->($note, @ancestors);
      $mk_tree->($id, $note, $parent);
    }
    else {
      $mk_root->($id, $note);
    }
  }
  return(values(%roots));
} # end subroutine create definition
########################################################################

sub dummy {
  my $package = shift;
  my ($id, $desc) = @_;

  my @refs = $desc->references;
  my ($i) = grep({$id eq $refs[$_]} 0..$#refs);
  defined($i) or croak("cannot find '$id' in those references");
  splice(@refs, 0, $i);

  my $note = $desc->dummy(
    id => $id,
    (scalar(@refs) ? (references => \@refs) : ())
  );
  $note->set_is_fake;
  $note->set_content("note '$id' not available");
  return($note);
} # end subroutine dummy definition
########################################################################

sub new {
  my $package = shift;
  my $note = shift;

  my $self = $package->SUPER::new($note, @_);
  $self->setUID($note->id);
  return($self);
} # end subroutine new definition
########################################################################

sub rmap {
  my $self = shift;
  my ($subref) = @_;

  my %ctrl;
  my @answers = do {
    local $_ = $self;
    $subref->($self, \%ctrl);
  };
  $ctrl{prune} and return(@answers);
  foreach my $child ($self->children) {
    push(@answers, $child->rmap($subref));
  }
  return(@answers);
} # end subroutine rmap definition
########################################################################

# vi:ts=2:sw=2:et:sta
1;