Tree-DAG_Node-1.35/0000755000175000017500000000000015010317500012045 5ustar ronronTree-DAG_Node-1.35/lib/0000755000175000017500000000000015010317500012613 5ustar ronronTree-DAG_Node-1.35/lib/Tree/0000755000175000017500000000000015010317500013512 5ustar ronronTree-DAG_Node-1.35/lib/Tree/DAG_Node.pm0000644000175000017500000027762415010315267015442 0ustar ronronpackage Tree::DAG_Node; use strict; use warnings; use warnings qw(FATAL utf8); # Fatalize encoding glitches. our $Debug = 0; our $VERSION = '1.35'; use File::Slurper 'read_lines'; # ----------------------------------------------- sub add_daughter { # alias my($it,@them) = @_; $it->add_daughters(@them); } # ----------------------------------------------- sub add_daughters { # write-only method my($mother, @daughters) = @_; return unless @daughters; # no-op return $mother->_add_daughters_wrapper( sub { push @{$_[0]}, $_[1]; }, @daughters ); } # ----------------------------------------------- sub add_daughter_left { # alias my($it,@them) = @_; $it->add_daughters_left(@them); } # ----------------------------------------------- sub add_daughters_left { # write-only method my($mother, @daughters) = @_; return unless @daughters; return $mother->_add_daughters_wrapper( sub { unshift @{$_[0]}, $_[1]; }, @daughters ); } # ----------------------------------------------- sub _add_daughters_wrapper { my($mother, $callback, @daughters) = @_; return unless @daughters; my %ancestors; @ancestors{ $mother->ancestors } = undef; # This could be made more efficient by not bothering to compile # the ancestor list for $mother if all the nodes to add are # daughterless. # But then you have to CHECK if they're daughterless. # If $mother is [big number] generations down, then it's worth checking. foreach my $daughter (@daughters) { # which may be () die "daughter must be a node object!" unless UNIVERSAL::can($daughter, 'is_node'); printf "Mother : %s (%s)\n", $mother, ref $mother if $Debug; printf "Daughter: %s (%s)\n", $daughter, ref $daughter if $Debug; printf "Adding %s to %s\n", ($daughter->name() || $daughter), ($mother->name() || $mother) if $Debug > 1; die 'Mother (' . $mother -> name . ") can't be its own daughter\n" if $mother eq $daughter; die "$daughter (" . ($daughter->name || 'no_name') . ") is an ancestor of $mother (" . ($mother->name || 'no_name') . "), so can't became its daughter\n" if exists $ancestors{$daughter}; my $old_mother = $daughter->{'mother'}; next if defined($old_mother) && ref($old_mother) && $old_mother eq $mother; # noop if $daughter is already $mother's daughter $old_mother->remove_daughters($daughter) if defined($old_mother) && ref($old_mother); &{$callback}($mother->{'daughters'}, $daughter); } $mother->_update_daughter_links; # need only do this at the end return; } # ----------------------------------------------- sub add_left_sister { # alias my($it,@them) = @_; $it->add_left_sisters(@them); } # ----------------------------------------------- sub add_left_sisters { # write-only method my($this, @new) = @_; return() unless @new; @new = $this->replace_with(@new, $this); shift @new; pop @new; # kill the copies of $this return @new; } # ----------------------------------------------- sub add_right_sister { # alias my($it,@them) = @_; $it->add_right_sisters(@them); } # ----------------------------------------------- sub add_right_sisters { # write-only method my($this, @new) = @_; return() unless @new; @new = $this->replace_with($this, @new); shift @new; shift @new; # kill the copies of $this return @new; } # ----------------------------------------------- sub address { my($it, $address) = @_[0,1]; if(defined($address) && length($address)) { # given the address, return the node. # invalid addresses return undef my $root = $it->root; my @parts = map {$_ + 0} $address =~ m/(\d+)/g; # generous! die "Address \"$address\" is an ill-formed address" unless @parts; die "Address \"$address\" must start with '0'" unless shift(@parts) == 0; my $current_node = $root; while(@parts) { # no-op for root my $ord = shift @parts; my @daughters = @{$current_node->{'daughters'}}; if($#daughters < $ord) { # illegal address print "* $address has an out-of-range index ($ord)!" if $Debug; return undef; } $current_node = $daughters[$ord]; unless(ref($current_node)) { print "* $address points to or thru a non-node!" if $Debug; return undef; } } return $current_node; } else { # given the node, return the address my @parts = (); my $current_node = $it; my $mother; while(defined( $mother = $current_node->{'mother'} ) && ref($mother)) { unshift @parts, $current_node->my_daughter_index; $current_node = $mother; } return join(':', 0, @parts); } } # ----------------------------------------------- sub ancestors { my $this = shift; my $mama = $this->{'mother'}; # initial condition return () unless ref($mama); # I must be root! # Could be defined recursively, as: # if(ref($mama = $this->{'mother'})){ # return($mama, $mama->ancestors); # } else { # return (); # } # But I didn't think of that until I coded the stuff below, which is # faster. my @ancestors = ( $mama ); # start off with my mama while(defined( $mama = $mama->{'mother'} ) && ref($mama)) { # Walk up the tree push(@ancestors, $mama); # This turns into an infinite loop if someone gets stupid # and makes this tree cyclic! Don't do it! } return @ancestors; } # ----------------------------------------------- sub attribute { # alias my($it,@them) = @_; $it->attributes(@them); } # ----------------------------------------------- sub attributes { # read/write attribute-method # expects a ref, presumably a hashref my $this = shift; if(@_) { die "my parameter must be a reference" unless ref($_[0]); $this->{'attributes'} = $_[0]; } return $this->{'attributes'}; } # ----------------------------------------------- sub clear_daughters { # write-only method my($mother) = $_[0]; my @daughters = @{$mother->{'daughters'}}; @{$mother->{'daughters'}} = (); foreach my $one (@daughters) { next unless UNIVERSAL::can($one, 'is_node'); # sanity check $one->{'mother'} = undef; } # Another, simpler, way to do it: # $mother->remove_daughters($mother->daughters); return @daughters; # NEW } # ----------------------------------------------- sub common { # Return the lowest node common to all these nodes... # Called as $it->common($other) or $it->common(@others) my @ones = @_; # all nodes I was given my($first, @others) = @_; return $first unless @others; # degenerate case my %ones; @ones{ @ones } = undef; foreach my $node (@others) { die "TILT: node \"$node\" is not a node" unless UNIVERSAL::can($node, 'is_node'); my %first_lineage; @first_lineage{$first, $first->ancestors} = undef; my $higher = undef; # the common of $first and $node my @my_lineage = $node->ancestors; Find_Common: while(@my_lineage) { if(exists $first_lineage{$my_lineage[0]}) { $higher = $my_lineage[0]; last Find_Common; } shift @my_lineage; } return undef unless $higher; $first = $higher; } return $first; } # ----------------------------------------------- sub common_ancestor { my @ones = @_; # all nodes I was given my($first, @others) = @_; return $first->{'mother'} unless @others; # which may be undef if $first is the root! my %ones; @ones{ @ones } = undef; # my arguments my $common = $first->common(@others); if(exists($ones{$common})) { # if the common is one of my nodes... return $common->{'mother'}; # and this might be undef, if $common is root! } else { return $common; # which might be null if that's all common came up with } } # ----------------------------------------------- sub copy { my($from, $o) = @_[0,1]; $o = {} unless ref $o; # Straight dup, and bless into same class. my $to = bless { %$from }, ref($from); # Null out linkages. $to -> _init_mother; $to -> _init_daughters; # Dup the 'attributes' attribute. if ($$o{'no_attribute_copy'}) { $$to{attributes} = {}; } else { my $attrib_copy = ref($to->{'attributes'}); if ($attrib_copy) { if ($attrib_copy eq 'HASH') { # Dup the hashref. $$to{'attributes'} = { %{$$to{'attributes'}} }; } elsif ($attrib_copy = UNIVERSAL::can($to->{'attributes'}, 'copy') ) { # $attrib_copy now points to the copier method. $$to{'attributes'} = &{$attrib_copy}($from); } # Otherwise I don't know how to copy it; leave as is. } } $$o{'from_to'}{$from} = $to; # SECRET VOODOO # ...autovivifies an anon hashref for 'from_to' if need be # This is here in case I later want/need a table corresponding # old nodes to new. return $to; } # ----------------------------------------------- sub copy_at_and_under { my($from, $o) = @_[0,1]; $o = {} unless ref $o; my @daughters = map($_->copy_at_and_under($o), @{$from->{'daughters'}}); my $to = $from->copy($o); $to->set_daughters(@daughters) if @daughters; return $to; } # ----------------------------------------------- sub copy_tree { my($this, $o) = @_[0,1]; my $root = $this->root; $o = {} unless ref $o; my $new_root = $root->copy_at_and_under($o); return $new_root; } # ----------------------------------------------- sub daughters { # read-only attrib-method: returns a list. my $this = shift; if(@_) { # undoc'd and disfavored to use as a write-method die "Don't set daughters with daughters anymore\n"; warn "my parameter must be a listref" unless ref($_[0]); $this->{'daughters'} = $_[0]; $this->_update_daughter_links; } #return $this->{'daughters'}; return @{$this->{'daughters'} || []}; } # ------------------------------------------------ sub decode_lol { my($self, $result) = @_; my(@worklist) = $result; my($obj); my($ref_type); my(@stack); do { $obj = shift @worklist; $ref_type = ref $obj; if ($ref_type eq 'ARRAY') { unshift @worklist, @$obj; } elsif ($ref_type eq 'HASH') { push @stack, {%$obj}; } elsif ($ref_type) { die "Unsupported object type $ref_type\n"; } else { push @stack, $obj; } } while (@worklist); return [@stack]; } # End of decode_lol. # ----------------------------------------------- sub delete_tree { my $it = $_[0]; $it->root->walk_down({ # has to be callbackback, not callback 'callbackback' => sub { %{$_[0]} = (); bless($_[0], 'DEADNODE'); # cause become dead! cause become dead! return 1; } }); return; # Why DEADNODE? Because of the nice error message: # "Can't locate object method "leaves_under" via package "DEADNODE"." # Moreover, DEADNODE doesn't provide is_node, so fails my can() tests. } sub DEADNODE::delete_tree { return; } # in case you kill it AGAIN!!!!! AND AGAIN AND AGAIN!!!!!! OO-HAHAHAHA! # ----------------------------------------------- sub depth_under { my $node = shift; my $max_depth = 0; $node->walk_down({ '_depth' => 0, 'callback' => sub { my $depth = $_[1]->{'_depth'}; $max_depth = $depth if $depth > $max_depth; return 1; }, }); return $max_depth; } # ----------------------------------------------- sub descendants { # read-only method: return a list of my descendants my $node = shift; my @list = $node->self_and_descendants; shift @list; # lose myself. return @list; } # ----------------------------------------------- sub draw_ascii_tree { # Make a "box" for this node and its possible daughters, recursively. # The guts of this routine are horrific AND recursive! # Feel free to send me better code. I worked on this until it # gave me a headache and it worked passably, and then I stopped. my $it = $_[0]; my $o = ref($_[1]) ? $_[1] : {}; my(@box, @daughter_boxes, $width, @daughters); @daughters = @{$it->{'daughters'}}; $o->{'no_name'} = 0 unless exists $o->{'no_name'}; $o->{'h_spacing'} = 1 unless exists $o->{'h_spacing'}; $o->{'h_compact'} = 1 unless exists $o->{'h_compact'}; $o->{'v_compact'} = 1 unless exists $o->{'v_compact'}; my $printable_name; if($o->{'no_name'}) { $printable_name = '*'; } else { $printable_name = defined $it->name ? $it->name : $it; $printable_name =~ tr<\cm\cj\t >< >s; $printable_name = "<$printable_name>"; } if(!scalar(@daughters)) { # I am a leaf! # Now add the top parts, and return. @box = ("|", $printable_name); } else { @daughter_boxes = map { &draw_ascii_tree($_, $o) } @daughters; my $max_height = 0; foreach my $box (@daughter_boxes) { my $h = @$box; $max_height = $h if $h > $max_height; } @box = ('') x $max_height; # establish the list foreach my $one (@daughter_boxes) { my $length = length($one->[0]); my $height = @$one; #now make all the same height. my $deficit = $max_height - $height; if($deficit > 0) { push @$one, ( scalar( ' ' x $length ) ) x $deficit; $height = scalar(@$one); } # Now tack 'em onto @box ########################################################## # This used to be a sub of its own. Ho-hum. my($b1, $b2) = (\@box, $one); my($h1, $h2) = (scalar(@$b1), scalar(@$b2)); my(@diffs, $to_chop); if($o->{'h_compact'}) { # Try for h-scrunching. my @diffs; my $min_diff = length($b1->[0]); # just for starters foreach my $line (0 .. ($h1 - 1)) { my $size_l = 0; # length of terminal whitespace my $size_r = 0; # length of initial whitespace $size_l = length($1) if $b1->[$line] =~ /( +)$/s; $size_r = length($1) if $b2->[$line] =~ /^( +)/s; my $sum = $size_l + $size_r; $min_diff = $sum if $sum < $min_diff; push @diffs, [$sum, $size_l, $size_r]; } $to_chop = $min_diff - $o->{'h_spacing'}; $to_chop = 0 if $to_chop < 0; } if(not( $o->{'h_compact'} and $to_chop )) { # No H-scrunching needed/possible foreach my $line (0 .. ($h1 - 1)) { $b1->[ $line ] .= $b2->[ $line ] . (' ' x $o->{'h_spacing'}); } } else { # H-scrunching is called for. foreach my $line (0 .. ($h1 - 1)) { my $r = $b2->[$line]; # will be the new line my $remaining = $to_chop; if($remaining) { my($l_chop, $r_chop) = @{$diffs[$line]}[1,2]; if($l_chop) { if($l_chop > $remaining) { $l_chop = $remaining; $remaining = 0; } elsif($l_chop == $remaining) { $remaining = 0; } else { # remaining > l_chop $remaining -= $l_chop; } } if($r_chop) { if($r_chop > $remaining) { $r_chop = $remaining; $remaining = 0; } elsif($r_chop == $remaining) { $remaining = 0; } else { # remaining > r_chop $remaining -= $r_chop; # should never happen! } } substr($b1->[$line], -$l_chop) = '' if $l_chop; substr($r, 0, $r_chop) = '' if $r_chop; } # else no-op $b1->[ $line ] .= $r . (' ' x $o->{'h_spacing'}); } # End of H-scrunching ickyness } # End of ye big tack-on } # End of the foreach daughter_box loop # remove any fencepost h_spacing if($o->{'h_spacing'}) { foreach my $line (@box) { substr($line, -$o->{'h_spacing'}) = '' if length($line); } } # end of catenation die "SPORK ERROR 958203: Freak!!!!!" unless @box; # Now tweak the pipes my $new_pipes = $box[0]; my $pipe_count = $new_pipes =~ tr<|><+>; if($pipe_count < 2) { $new_pipes = "|"; } else { my($init_space, $end_space); # Thanks to Gilles Lamiral for pointing out the need to set to '', # to avoid -w warnings about undeffiness. if( $new_pipes =~ s<^( +)><>s ) { $init_space = $1; } else { $init_space = ''; } if( $new_pipes =~ s<( +)$><>s ) { $end_space = $1 } else { $end_space = ''; } $new_pipes =~ tr< ><->; substr($new_pipes,0,1) = "/"; substr($new_pipes,-1,1) = "\\"; $new_pipes = $init_space . $new_pipes . $end_space; # substr($new_pipes, int((length($new_pipes)), 1)) / 2) = "^"; # feh } # Now tack on the formatting for this node. if($o->{'v_compact'} == 2) { if(@daughters == 1) { unshift @box, "|", $printable_name; } else { unshift @box, "|", $printable_name, $new_pipes; } } elsif ($o->{'v_compact'} == 1 and @daughters == 1) { unshift @box, "|", $printable_name; } else { # general case unshift @box, "|", $printable_name, $new_pipes; } } # Flush the edges: my $max_width = 0; foreach my $line (@box) { my $w = length($line); $max_width = $w if $w > $max_width; } foreach my $one (@box) { my $space_to_add = $max_width - length($one); next unless $space_to_add; my $add_left = int($space_to_add / 2); my $add_right = $space_to_add - $add_left; $one = (' ' x $add_left) . $one . (' ' x $add_right); } return \@box; # must not return a null list! } # ----------------------------------------------- sub dump_names { my($it, $o) = @_[0,1]; $o = {} unless ref $o; my @out = (); $o->{'_depth'} ||= 0; $o->{'indent'} ||= ' '; $o->{'tick'} ||= ''; $o->{'callback'} = sub { my($this, $o) = @_[0,1]; push(@out, join('', $o->{'indent'} x $o->{'_depth'}, $o->{'tick'}, defined $this->name ? $this->name : $this, "\n" ) ); return 1; } ; $it->walk_down($o); return @out; } # ----------------------------------------------- sub format_node { my($self, $options, $node) = @_; my($s) = $node -> name; $s .= $$options{no_attributes} ? '. Attributes: {}' : '. Attributes: ' . $self -> hashref2string($node -> attributes); return $s; } # End of format_node. # ----------------------------------------------- sub generation { my($node, $limit) = @_[0,1]; return $node if $node eq $limit || not( defined($node->{'mother'}) && ref($node->{'mother'}) ); # bailout return map(@{$_->{'daughters'}}, $node->{'mother'}->generation($limit)); # recurse! # Yup, my generation is just all the daughters of my mom's generation. } # ----------------------------------------------- sub generation_under { my($node, @rest) = @_; return $node->generation(@rest); } # ----------------------------------------------- sub hashref2string { my($self, $hashref) = @_; $hashref ||= {}; return '{' . join(', ', map{$_ = 'undef' if (! defined($_) ); $$hashref{$_} = 'undef' if (! defined($$hashref{$_}) ); qq|$_ => "$$hashref{$_}"|} sort keys %$hashref) . '}'; } # End of hashref2string. # ----------------------------------------------- sub _init { # method my $this = shift; my $o = ref($_[0]) eq 'HASH' ? $_[0] : {}; # Sane initialization. $this->_init_mother($o); $this->_init_daughters($o); $this->_init_name($o); $this->_init_attributes($o); return; } # ----------------------------------------------- sub _init_attributes { # to be called by an _init my($this, $o) = @_[0,1]; $this->{'attributes'} = {}; # Undocumented and disfavored. Consider this just an example. $this->attributes( $o->{'attributes'} ) if exists $o->{'attributes'}; } # ----------------------------------------------- sub _init_daughters { # to be called by an _init my($this, $o) = @_[0,1]; $this->{'daughters'} = []; # Undocumented and disfavored. Consider this just an example. $this->set_daughters( @{$o->{'daughters'}} ) if ref($o->{'daughters'}) && (@{$o->{'daughters'}}); # DO NOT use this option (as implemented) with new_daughter or # new_daughter_left!!!!! # BAD THINGS MAY HAPPEN!!! } # ----------------------------------------------- sub _init_mother { # to be called by an _init my($this, $o) = @_[0,1]; $this->{'mother'} = undef; # Undocumented and disfavored. Consider this just an example. ( $o->{'mother'} )->add_daughter($this) if defined($o->{'mother'}) && ref($o->{'mother'}); # DO NOT use this option (as implemented) with new_daughter or # new_daughter_left!!!!! # BAD THINGS MAY HAPPEN!!! } # ----------------------------------------------- sub _init_name { # to be called by an _init my($this, $o) = @_[0,1]; $this->{'name'} = undef; # Undocumented and disfavored. Consider this just an example. $this->name( $o->{'name'} ) if exists $o->{'name'}; } # ----------------------------------------------- sub is_daughter_of { my($it,$mama) = @_[0,1]; return $it->{'mother'} eq $mama; } # ----------------------------------------------- sub is_node { return 1; } # always true. # NEVER override this with anything that returns false in the belief # that this'd signal "not a node class". The existence of this method # is what I test for, with the various "can()" uses in this class. # ----------------------------------------------- sub is_root { my($self) = @_; return defined $self -> mother ? 0 : 1; } # End of is_root. # ----------------------------------------------- sub leaves_under { # read-only method: return a list of all leaves under myself. # Returns myself in the degenerate case of being a leaf myself. my $node = shift; my @List = (); $node->walk_down({ 'callback' => sub { my $node = $_[0]; my @daughters = @{$node->{'daughters'}}; push(@List, $node) unless @daughters; return 1; } }); die "Spork Error 861: \@List has no contents!?!?" unless @List; # impossible return @List; } # ----------------------------------------------- sub left_sister { my $it = $_[0]; my $mother = $it->{'mother'}; return undef unless $mother; my @sisters = @{$mother->{'daughters'}}; return undef if @sisters == 1; # I'm an only daughter my $left = undef; foreach my $one (@sisters) { return $left if $one eq $it; $left = $one; } die "SPORK ERROR 9757: I'm not in my mother's daughter list!?!?"; } # ----------------------------------------------- sub left_sisters { my $it = $_[0]; my $mother = $it->{'mother'}; return() unless $mother; my @sisters = @{$mother->{'daughters'}}; return() if @sisters == 1; # I'm an only daughter my @out = (); foreach my $one (@sisters) { return @out if $one eq $it; push @out, $one; } die "SPORK ERROR 9767: I'm not in my mother's daughter list!?!?"; } # ----------------------------------------------- sub lol_to_tree { my($class, $lol, $seen_r) = @_[0,1,2]; $seen_r = {} unless ref($seen_r) eq 'HASH'; return if ref($lol) && $seen_r->{$lol}++; # catch circularity $class = ref($class) || $class; my $node = $class->new(); unless(ref($lol) eq 'ARRAY') { # It's a terminal node. $node->name($lol) if defined $lol; return $node; } return $node unless @$lol; # It's a terminal node, oddly represented # It's a non-terminal node. my @options = @$lol; unless(ref($options[-1]) eq 'ARRAY') { # This is what separates this method from simple_lol_to_tree $node->name(pop(@options)); } foreach my $d (@options) { # Scan daughters (whether scalars or listrefs) $node->add_daughter( $class->lol_to_tree($d, $seen_r) ); # recurse! } return $node; } # ----------------------------------------------- sub mother { # read-only attrib-method: returns an object (the mother node) my $this = shift; die "I'm a read-only method!" if @_; return $this->{'mother'}; } # ----------------------------------------------- sub my_daughter_index { # returns what number is my index in my mother's daughter list # special case: 0 for root. my $node = $_[0]; my $ord = -1; my $mother = $node->{'mother'}; return 0 unless $mother; my @sisters = @{$mother->{'daughters'}}; die "SPORK ERROR 6512: My mother has no kids!!!" unless @sisters; Find_Self: for(my $i = 0; $i < @sisters; $i++) { if($sisters[$i] eq $node) { $ord = $i; last Find_Self; } } die "SPORK ERROR 2837: I'm not a daughter of my mother?!?!" if $ord == -1; return $ord; } # ----------------------------------------------- sub name { # read/write attribute-method. returns/expects a scalar my $this = shift; $this->{'name'} = $_[0] if @_; return $this->{'name'}; } # ----------------------------------------------- sub new { # constructor my $class = shift; $class = ref($class) if ref($class); # tchristic style. why not? my $o = ref($_[0]) eq 'HASH' ? $_[0] : {}; # o for options hashref my $it = bless( {}, $class ); print "Constructing $it in class $class\n" if $Debug; $it->_init( $o ); return $it; } # ----------------------------------------------- sub new_daughter { my($mother, @options) = @_; my $daughter = $mother->new(@options); push @{$mother->{'daughters'}}, $daughter; $daughter->{'mother'} = $mother; return $daughter; } # ----------------------------------------------- sub new_daughter_left { my($mother, @options) = @_; my $daughter = $mother->new(@options); unshift @{$mother->{'daughters'}}, $daughter; $daughter->{'mother'} = $mother; return $daughter; } # ----------------------------------------------- sub node2string { my($self, $options, $node, $vert_dashes) = @_; my($depth) = scalar($node -> ancestors) || 0; my($sibling_count) = defined $node -> mother ? scalar $node -> self_and_sisters : 1; my($offset) = ' ' x 5; my(@indent) = map{$$vert_dashes[$_] || $offset} 0 .. $depth - 1; @$vert_dashes = ( @indent, ($sibling_count == 1 ? $offset : ' |'), ); if ($sibling_count == ($node -> my_daughter_index + 1) ) { $$vert_dashes[$depth] = $offset; } return join('' => @indent[1 .. $#indent]) . ($depth ? ' |--- ' : '') . $self -> format_node($options, $node); } # End of node2string. # ----------------------------------------------- sub quote_name { my($self, $name) = @_; return "'$name'"; } # End of quote_name. # ----------------------------------------------- sub random_network { # constructor or method. my $class = $_[0]; my $o = ref($_[1]) ? $_[1] : {}; my $am_cons = 0; my $root; if(ref($class)){ # I'm a method. $root = $_[0]; # build under the given node, from same class. $class = ref $class; $am_cons = 0; } else { # I'm a constructor $root = $class->new; # build under a new node, with class named. $root->name("Root"); $am_cons = 1; } my $min_depth = $o->{'min_depth'} || 2; my $max_depth = $o->{'max_depth'} || ($min_depth + 3); my $max_children = $o->{'max_children'} || 4; my $max_node_count = $o->{'max_node_count'} || 25; die "max_children has to be positive" if int($max_children) < 1; my @mothers = ( $root ); my @children = ( ); my $node_count = 1; # the root Gen: foreach my $depth (1 .. $max_depth) { last if $node_count > $max_node_count; Mother: foreach my $mother (@mothers) { last Gen if $node_count > $max_node_count; my $children_number; if($depth <= $min_depth) { until( $children_number = int(rand(1 + $max_children)) ) {} } else { $children_number = int(rand($max_children)); } Beget: foreach (1 .. $children_number) { last Gen if $node_count > $max_node_count; my $node = $mother->new_daughter; $node->name("Node$node_count"); ++$node_count; push(@children, $node); } } @mothers = @children; @children = (); last unless @mothers; } return $root; } # ----------------------------------------------- sub read_attributes { my($self, $s) = @_; my($attributes); my($name); if ($s =~ /^(.+)\. Attributes: (\{.*\})$/) { ($name, $attributes) = ($1, $self -> string2hashref($2) ); } else { ($name, $attributes) = ($s, {}); } return Tree::DAG_Node -> new({name => $name, attributes => $attributes}); } # End of read_attributes. # ----------------------------------------------- sub read_tree { my($self, $file_name) = @_; my($count) = 0; my($last_indent) = 0; my($test_string) = '--- '; my($test_length) = length $test_string; my($indent); my($node); my($offset); my($root); my(@stack); my($tos); for my $line (read_lines($file_name) ) { # Ensure inter-OS compatability. $line =~ s/\r$//g; $count++; if ($count == 1) { $root = $node = $self -> read_attributes($line); } else { $indent = index($line, $test_string); if ($indent > $last_indent) { $tos = $node; push @stack, $node, $indent; } elsif ($indent < $last_indent) { $offset = $last_indent; while ($offset > $indent) { $offset = pop @stack; $tos = pop @stack; } push @stack, $tos, $offset; } # Warning: The next line must set $node. # Don't put the RHS into the call to add_daughter()! $node = $self -> read_attributes(substr($line, $indent + $test_length) ); $last_indent = $indent; $tos -> add_daughter($node); } } return $root; } # End of read_tree. # ----------------------------------------------- sub remove_daughters { # write-only method my($mother, @daughters) = @_; die "mother must be an object!" unless ref $mother; return unless @daughters; my %to_delete; @daughters = grep {ref($_) and defined($_->{'mother'}) and $mother eq $_->{'mother'} } @daughters; return unless @daughters; @to_delete{ @daughters } = undef; # This could be done better and more efficiently, I guess. foreach my $daughter (@daughters) { $daughter->{'mother'} = undef; } my $them = $mother->{'daughters'}; @$them = grep { !exists($to_delete{$_}) } @$them; # $mother->_update_daughter_links; # unnecessary return; } # ----------------------------------------------- sub remove_daughter { # alias my($it,@them) = @_; $it->remove_daughters(@them); } # ----------------------------------------------- sub replace_with { # write-only method my($this, @replacements) = @_; if(not( defined($this->{'mother'}) && ref($this->{'mother'}) )) { # if root foreach my $replacement (@replacements) { $replacement->{'mother'}->remove_daughters($replacement) if $replacement->{'mother'}; } # make 'em roots } else { # I have a mother my $mother = $this->{'mother'}; #@replacements = grep(($_ eq $this || $_->{'mother'} ne $mother), # @replacements); @replacements = grep { $_ eq $this || not(defined($_->{'mother'}) && ref($_->{'mother'}) && $_->{'mother'} eq $mother ) } @replacements; # Eliminate sisters (but not self) # i.e., I want myself or things NOT with the same mother as myself. $mother->set_daughters( # old switcheroo map($_ eq $this ? (@replacements) : $_ , @{$mother->{'daughters'}} ) ); # and set_daughters does all the checking and possible # unlinking } return($this, @replacements); } # ----------------------------------------------- sub replace_with_daughters { # write-only method my($this) = $_[0]; # takes no params other than the self my $mother = $this->{'mother'}; return($this, $this->clear_daughters) unless defined($mother) && ref($mother); my @daughters = $this->clear_daughters; my $sib_r = $mother->{'daughters'}; @$sib_r = map($_ eq $this ? (@daughters) : $_, @$sib_r # old switcheroo ); foreach my $daughter (@daughters) { $daughter->{'mother'} = $mother; } return($this, @daughters); } # ----------------------------------------------- sub right_sister { my $it = $_[0]; my $mother = $it->{'mother'}; return undef unless $mother; my @sisters = @{$mother->{'daughters'}}; return undef if @sisters == 1; # I'm an only daughter my $seen = 0; foreach my $one (@sisters) { return $one if $seen; $seen = 1 if $one eq $it; } die "SPORK ERROR 9777: I'm not in my mother's daughter list!?!?" unless $seen; return undef; } # ----------------------------------------------- sub right_sisters { my $it = $_[0]; my $mother = $it->{'mother'}; return() unless $mother; my @sisters = @{$mother->{'daughters'}}; return() if @sisters == 1; # I'm an only daughter my @out; my $seen = 0; foreach my $one (@sisters) { push @out, $one if $seen; $seen = 1 if $one eq $it; } die "SPORK ERROR 9787: I'm not in my mother's daughter list!?!?" unless $seen; return @out; } # ----------------------------------------------- sub root { my $it = $_[0]; my @ancestors = ($it, $it->ancestors); return $ancestors[-1]; } # ----------------------------------------------- sub self_and_descendants { # read-only method: return a list of myself and any/all descendants my $node = shift; my @List = (); $node->walk_down({ 'callback' => sub { push @List, $_[0]; return 1;}}); die "Spork Error 919: \@List has no contents!?!?" unless @List; # impossible return @List; } # ----------------------------------------------- sub self_and_sisters { my $node = $_[0]; my $mother = $node->{'mother'}; return $node unless defined($mother) && ref($mother); # special case return @{$node->{'mother'}->{'daughters'}}; } # ----------------------------------------------- sub set_daughters { # write-only method my($mother, @them) = @_; $mother->clear_daughters; $mother->add_daughters(@them) if @them; # yup, it's that simple } # ----------------------------------------------- sub simple_lol_to_tree { my($class, $lol, $seen_r) = @_[0,1,2]; $class = ref($class) || $class; $seen_r = {} unless ref($seen_r) eq 'HASH'; return if ref($lol) && $seen_r->{$lol}++; # catch circularity my $node = $class->new(); unless(ref($lol) eq 'ARRAY') { # It's a terminal node. $node->name($lol) if defined $lol; return $node; } # It's a non-terminal node. foreach my $d (@$lol) { # scan daughters (whether scalars or listrefs) $node->add_daughter( $class->simple_lol_to_tree($d, $seen_r) ); # recurse! } return $node; } # ----------------------------------------------- sub sisters { my $node = $_[0]; my $mother = $node->{'mother'}; return() unless $mother; # special case return grep($_ ne $node, @{$node->{'mother'}->{'daughters'}} ); } # ----------------------------------------------- sub string2hashref { my($self, $s) = @_; $s ||= ''; my($result) = {}; my($k); my($v); if ($s) { # Expect: # 1: The presence of the comma in "(',')" complicates things, so we can't use split(/\s*,\s*/, $s). # {x => "(',')"} # 2: The presence of "=>" complicates things, so we can't use split(/\s*=>\s*/). # {x => "=>"} # 3: So, assume ', ' is the outer separator, and then ' => ' is the inner separator. # Firstly, clean up the input, just to be safe. # None of these will match output from hashref2string($h). $s =~ s/^\s*\{*//; $s =~ s/\s*\}\s*$/\}/; my($finished) = 0; # The first '\' is for UltraEdit's syntax hiliting. my($reg_exp) = qr/ ([\"'])([^"']*?)\1\s*=>\s*(["'])([^"']*?)\3,?\s* | (["'])([^"']*?)\5\s*=>\s*(.*?),?\s* | (.*?)\s*=>\s*(["'])([^"']*?)\9,?\s* | (.*?)\s*=>\s*(.*?),?\s* /sx; my(@got); while (! $finished) { if ($s =~ /$reg_exp/gc) { push @got, defined($2) ? ($2, $4) : defined($6) ? ($6, $7) : defined($8) ? ($8, $10) : ($11, $12); } else { $finished = 1; } } $result = {@got}; } return $result; } # End of string2hashref. # ----------------------------------------------- sub tree_to_lol { # I haven't /rigorously/ tested this. my($it, $o) = @_[0,1]; # $o is currently unused anyway $o = {} unless ref $o; my $out = []; my @lol_stack = ($out); $o->{'callback'} = sub { my($this, $o) = @_[0,1]; my $new = []; push @{$lol_stack[-1]}, $new; push(@lol_stack, $new); return 1; } ; $o->{'callbackback'} = sub { my($this, $o) = @_[0,1]; my $name = defined $this->name ? $it -> quote_name($this->name) : 'undef'; push @{$lol_stack[-1]}, $name; pop @lol_stack; return 1; } ; $it->walk_down($o); die "totally bizarre error 12416" unless ref($out->[0]); $out = $out->[0]; # the real root return $out; } # ----------------------------------------------- sub tree_to_lol_notation { my($it, $o) = @_[0,1]; $o = {} unless ref $o; my @out = (); $o->{'_depth'} ||= 0; $o->{'multiline'} = 0 unless exists($o->{'multiline'}); my $line_end; if($o->{'multiline'}) { $o->{'indent'} ||= ' '; $line_end = "\n"; } else { $o->{'indent'} ||= ''; $line_end = ''; } $o->{'callback'} = sub { my($this, $o) = @_[0,1]; push(@out, $o->{'indent'} x $o->{'_depth'}, "[$line_end", ); return 1; } ; $o->{'callbackback'} = sub { my($this, $o) = @_[0,1]; my $name = defined $this->name ? $it -> quote_name($this->name) : 'undef'; push(@out, $o->{'indent'} x ($o->{'_depth'} + 1), "$name$line_end", $o->{'indent'} x $o->{'_depth'}, "],$line_end", ); return 1; } ; $it->walk_down($o); return join('', @out); } # ----------------------------------------------- sub tree_to_simple_lol { # I haven't /rigorously/ tested this. my $root = $_[0]; return $root->name unless scalar($root->daughters); # special case we have to nip in the bud my($it, $o) = @_[0,1]; # $o is currently unused anyway $o = {} unless ref $o; my $out = []; my @lol_stack = ($out); $o->{'callback'} = sub { my($this, $o) = @_[0,1]; my $new; my $name = defined $this->name ? $it -> quote_name($this->name) : 'undef'; $new = scalar($this->daughters) ? [] : $name; # Terminal nodes are scalars, the rest are listrefs we'll fill in # as we recurse the tree below here. push @{$lol_stack[-1]}, $new; push(@lol_stack, $new); return 1; } ; $o->{'callbackback'} = sub { pop @lol_stack; return 1; }; $it->walk_down($o); die "totally bizarre error 12416" unless ref($out->[0]); $out = $out->[0]; # the real root return $out; } # ----------------------------------------------- sub tree_to_simple_lol_notation { my($it, $o) = @_[0,1]; $o = {} unless ref $o; my @out = (); $o->{'_depth'} ||= 0; $o->{'multiline'} = 0 unless exists($o->{'multiline'}); my $line_end; if($o->{'multiline'}) { $o->{'indent'} ||= ' '; $line_end = "\n"; } else { $o->{'indent'} ||= ''; $line_end = ''; } $o->{'callback'} = sub { my($this, $o) = @_[0,1]; if(scalar($this->daughters)) { # Nonterminal push(@out, $o->{'indent'} x $o->{'_depth'}, "[$line_end", ); } else { # Terminal my $name = defined $this->name ? $it -> quote_name($this->name) : 'undef'; push @out, $o->{'indent'} x $o->{'_depth'}, "$name,$line_end"; } return 1; } ; $o->{'callbackback'} = sub { my($this, $o) = @_[0,1]; push(@out, $o->{'indent'} x $o->{'_depth'}, "], $line_end", ) if scalar($this->daughters); return 1; } ; $it->walk_down($o); return join('', @out); } # ----------------------------------------------- sub tree2string { my($self, $options, $tree) = @_; $options ||= {}; $$options{no_attributes} ||= 0; $tree ||= $self; my(@out); my(@vert_dashes); $tree -> walk_down ({ callback => sub { my($node) = @_; push @out, $self -> node2string($options, $node, \@vert_dashes); return 1, }, _depth => 0, }); return [@out]; } # End of tree2string. # ----------------------------------------------- sub unlink_from_mother { my $node = $_[0]; my $mother = $node->{'mother'}; $mother->remove_daughters($node) if defined($mother) && ref($mother); return $mother; } # ----------------------------------------------- sub _update_daughter_links { # Eliminate any duplicates in my daughters list, and update # all my daughters' links to myself. my $this = shift; my $them = $this->{'daughters'}; # Eliminate duplicate daughters. my %seen = (); @$them = grep { ref($_) && not($seen{$_}++) } @$them; # not that there should ever be duplicate daughters anyhoo. foreach my $one (@$them) { # linkage bookkeeping die "daughter <$one> isn't an object!" unless ref $one; $one->{'mother'} = $this; } return; } # ----------------------------------------------- sub walk_down { my($this, $o) = @_[0,1]; # All the can()s are in case an object changes class while I'm # looking at it. die "I need options!" unless ref($o); die "I need a callback or a callbackback" unless ( ref($o->{'callback'}) || ref($o->{'callbackback'}) ); my $callback = ref($o->{'callback'}) ? $o->{'callback'} : undef; my $callbackback = ref($o->{'callbackback'}) ? $o->{'callbackback'} : undef; my $callback_status = 1; print "Callback: $callback Callbackback: $callbackback\n" if $Debug; printf "* Entering %s\n", ($this->name || $this) if $Debug; $callback_status = &{ $callback }( $this, $o ) if $callback; if($callback_status) { # Keep recursing unless callback returned false... and if there's # anything to recurse into, of course. my @daughters = UNIVERSAL::can($this, 'is_node') ? @{$this->{'daughters'}} : (); if(@daughters) { $o->{'_depth'} += 1; #print "Depth " , $o->{'_depth'}, "\n"; foreach my $one (@daughters) { $one->walk_down($o) if UNIVERSAL::can($one, 'is_node'); # and if it can do "is_node", it should provide a walk_down! } $o->{'_depth'} -= 1; } } else { printf "* Recursing below %s pruned\n", ($this->name || $this) if $Debug; } # Note that $callback_status doesn't block callbackback from being called if($callbackback){ if(UNIVERSAL::can($this, 'is_node')) { # if it's still a node! print "* Calling callbackback\n" if $Debug; scalar( &{ $callbackback }( $this, $o ) ); # scalar to give it the same context as callback } else { print "* Can't call callbackback -- $this isn't a node anymore\n" if $Debug; } } if($Debug) { if(UNIVERSAL::can($this, 'is_node')) { # if it's still a node! printf "* Leaving %s\n", ($this->name || $this) } else { print "* Leaving [no longer a node]\n"; } } return; } # ----------------------------------------------- 1; =pod =encoding utf-8 =head1 NAME Tree::DAG_Node - An N-ary tree =head1 SYNOPSIS =head2 Using as a base class package Game::Tree::Node; use parent 'Tree::DAG_Node'; # Now add your own methods overriding/extending the methods in C... =head2 Using as a class on its own use Tree::DAG_Node; my($root) = Tree::DAG_Node -> new({name => 'root', attributes => {uid => 0} }); $root -> add_daughter(Tree::DAG_Node -> new({name => 'one', attributes => {uid => 1} }) ); $root -> add_daughter(Tree::DAG_Node -> new({name => 'two', attributes => {} }) ); $root -> add_daughter(Tree::DAG_Node -> new({name => 'three'}) ); # Attrs default to {}. Or: my($count) = 0; my($tree) = Tree::DAG_Node -> new({name => 'Root', attributes => {'uid' => $count} }); Or: my $root = Tree::DAG_Node -> new(); $root -> name("I'm the tops"); $root -> attributes({uid => 0}); my $new_daughter = $root -> new_daughter; $new_daughter -> name('Another node'); $new_daughter -> attributes({uid => 1}); ... Lastly, for fancy wrappers - called _add_daughter() - around C, see these modules: L and L. Both of these modules use L. See scripts/*.pl for other samples. =head2 Using with utf-8 data read_tree($file_name) works with utf-8 data. See t/read.tree.t and t/tree.utf8.attributes.txt. Such a file can be created by redirecting the output of tree2string() to a file of type utf-8. See the docs for L for the difference between utf8 and utf-8. In brief, use utf-8. See also scripts/write_tree.pl and scripts/read.tree.pl and scripts/read.tree.log. =head1 DESCRIPTION This class encapsulates/makes/manipulates objects that represent nodes in a tree structure. The tree structure is not an object itself, but is emergent from the linkages you create between nodes. This class provides the methods for making linkages that can be used to build up a tree, while preventing you from ever making any kinds of linkages which are not allowed in a tree (such as having a node be its own mother or ancestor, or having a node have two mothers). This is what I mean by a "tree structure", a bit redundantly stated: =over 4 =item o A tree is a special case of an acyclic directed graph =item o A tree is a network of nodes where there's exactly one root node Also, the only primary relationship between nodes is the mother-daughter relationship. =item o No node can be its own mother, or its mother's mother, etc =item o Each node in the tree has exactly one parent Except for the root of course, which is parentless. =item o Each node can have any number (0 .. N) daughter nodes A given node's daughter nodes constitute an I list. However, you are free to consider this ordering irrelevant. Some applications do need daughters to be ordered, so I chose to consider this the general case. =item o A node can appear in only one tree, and only once in that tree Notably (notable because it doesn't follow from the two above points), a node cannot appear twice in its mother's daughter list. =item o There's an idea of up versus down Up means towards to the root, and down means away from the root (and towards the leaves). =item o There's an idea of left versus right Left is toward the start (index 0) of a given node's daughter list, and right is toward the end of a given node's daughter list. =back Trees as described above have various applications, among them: representing syntactic constituency, in formal linguistics; representing contingencies in a game tree; representing abstract syntax in the parsing of any computer language -- whether in expression trees for programming languages, or constituency in the parse of a markup language document. (Some of these might not use the fact that daughters are ordered.) (Note: B-Trees are a very special case of the above kinds of trees, and are best treated with their own class. Check CPAN for modules encapsulating B-Trees; or if you actually want a database, and for some reason ended up looking here, go look at L.) Many base classes are not usable except as such -- but C can be used as a normal class. You can go ahead and say: use Tree::DAG_Node; my $root = Tree::DAG_Node->new(); $root->name("I'm the tops"); $new_daughter = Tree::DAG_Node->new(); $new_daughter->name("More"); $root->add_daughter($new_daughter); and so on, constructing and linking objects from C and making useful tree structures out of them. =head1 A NOTE TO THE READER This class is big and provides lots of methods. If your problem is simple (say, just representing a simple parse tree), this class might seem like using an atomic sledgehammer to swat a fly. But the complexity of this module's bells and whistles shouldn't detract from the efficiency of using this class for a simple purpose. In fact, I'd be very surprised if any one user ever had use for more that even a third of the methods in this class. And remember: an atomic sledgehammer B kill that fly. =head1 OBJECT CONTENTS Implementationally, each node in a tree is an object, in the sense of being an arbitrarily complex data structure that belongs to a class (presumably C, or ones derived from it) that provides methods. The attributes of a node-object are: =over =item o mother -- this node's mother. undef if this is a root =item o daughters -- the (possibly empty) list of daughters of this node =item o name -- the name for this node Need not be unique, or even printable. This is printed in some of the various dumper methods, but it's up to you if you don't put anything meaningful or printable here. =item o attributes -- whatever the user wants to use it for Presumably a hashref to whatever other attributes the user wants to store without risk of colliding with the object's real attributes. (Example usage: attributes to an SGML tag -- you definitely wouldn't want the existence of a "mother=foo" pair in such a tag to collide with a node object's 'mother' attribute.) Aside from (by default) initializing it to {}, and having the access method called "attributes" (described a ways below), I don't do anything with the "attributes" in this module. I basically intended this so that users who don't want/need to bother deriving a class from C, could still attach whatever data they wanted in a node. =back "mother" and "daughters" are attributes that relate to linkage -- they are never written to directly, but are changed as appropriate by the "linkage methods", discussed below. The other two (and whatever others you may add in derived classes) are simply accessed thru the same-named methods, discussed further below. =head2 About The Documented Interface Stick to the documented interface (and comments in the source -- especially ones saying "undocumented!" and/or "disfavored!" -- do not count as documentation!), and don't rely on any behavior that's not in the documented interface. Specifically, unless the documentation for a particular method says "this method returns thus-and-such a value", then you should not rely on it returning anything meaningful. A I acquaintance with at least the broader details of the source code for this class is assumed for anyone using this class as a base class -- especially if you're overriding existing methods, and B if you're overriding linkage methods. =head1 MAIN CONSTRUCTOR, AND INITIALIZER =over =item the constructor CLASS->new() or CLASS->new($options) This creates a new node object, calls $object->_init($options) to provide it sane defaults (like: undef name, undef mother, no daughters, 'attributes' setting of a new empty hashref), and returns the object created. (If you just said "CLASS->new()" or "CLASS->new", then it pretends you called "CLASS->new({})".) See also the comments under L for options supported in the call to new(). If you use C as a superclass, and you add attributes that need to be initialized, what you need to do is provide an _init method that calls $this->SUPER::_init($options) to use its superclass's _init method, and then initializes the new attributes: sub _init { my($this, $options) = @_[0,1]; $this->SUPER::_init($options); # call my superclass's _init to # init all the attributes I'm inheriting # Now init /my/ new attributes: $this->{'amigos'} = []; # for example } =item the constructor $obj->new() or $obj->new($options) Just another way to get at the L method. This B $obj, but merely constructs a new object of the same class as it. Saves you the bother of going $class = ref $obj; $obj2 = $class->new; =item the method $node->_init($options) Initialize the object's attribute values. See the discussion above. Presumably this should be called only by the guts of the L constructor -- never by the end user. Currently there are no documented options for putting in the $options hashref, but (in case you want to disregard the above rant) the option exists for you to use $options for something useful in a derived class. Please see the source for more information. =item see also (below) the constructors "new_daughter" and "new_daughter_left" =back =head1 METHODS =head2 add_daughter(LIST) An exact synonym for L. =head2 add_daughters(LIST) This method adds the node objects in LIST to the (right) end of $mother's I list. Making a node N1 the daughter of another node N2 also means that N1's I attribute is "automatically" set to N2; it also means that N1 stops being anything else's daughter as it becomes N2's daughter. If you try to make a node its own mother, a fatal error results. If you try to take one of a node N1's ancestors and make it also a daughter of N1, a fatal error results. A fatal error results if anything in LIST isn't a node object. If you try to make N1 a daughter of N2, but it's B a daughter of N2, then this is a no-operation -- it won't move such nodes to the end of the list or anything; it just skips doing anything with them. =head2 add_daughter_left(LIST) An exact synonym for L. =head2 add_daughters_left(LIST) This method is just like L, except that it adds the node objects in LIST to the (left) beginning of $mother's daughter list, instead of the (right) end of it. =head2 add_left_sister(LIST) An exact synonym for L. =head2 add_left_sisters(LIST) This adds the elements in LIST (in that order) as immediate left sisters of $node. In other words, given that B's mother's daughter-list is (A,B,C,D), calling B->add_left_sisters(X,Y) makes B's mother's daughter-list (A,X,Y,B,C,D). If LIST is empty, this is a no-op, and returns empty-list. This is basically implemented as a call to $node->replace_with(LIST, $node), and so all replace_with's limitations and caveats apply. The return value of $node->add_left_sisters(LIST) is the elements of LIST that got added, as returned by replace_with -- minus the copies of $node you'd get from a straight call to $node->replace_with(LIST, $node). =head2 add_right_sister(LIST) An exact synonym for L. =head2 add_right_sisters(LIST) Just like add_left_sisters (which see), except that the elements in LIST (in that order) as immediate B sisters of $node; In other words, given that B's mother's daughter-list is (A,B,C,D), calling B->add_right_sisters(X,Y) makes B's mother's daughter-list (A,B,X,Y,C,D). =head2 address() =head2 address(ADDRESS) With the first syntax, returns the address of $node within its tree, based on its position within the tree. An address is formed by noting the path between the root and $node, and concatenating the daughter-indices of the nodes this passes thru (starting with 0 for the root, and ending with $node). For example, if to get from node ROOT to node $node, you pass thru ROOT, A, B, and $node, then the address is determined as: =over 4 =item o ROOT's my_daughter_index is 0 =item o A's my_daughter_index is, suppose, 2 A is index 2 in ROOT's daughter list. =item o B's my_daughter_index is, suppose, 0 B is index 0 in A's daughter list. =item o $node's my_daughter_index is, suppose, 4 $node is index 4 in B's daughter list. =back The address of the above-described $node is, therefore, "0:2:0:4". (As a somewhat special case, the address of the root is always "0"; and since addresses start from the root, all addresses start with a "0".) The second syntax, where you provide an address, starts from the root of the tree $anynode belongs to, and returns the node corresponding to that address. Returns undef if no node corresponds to that address. Note that this routine may be somewhat liberal in its interpretation of what can constitute an address; i.e., it accepts "0.2.0.4", besides "0:2:0:4". Also note that the address of a node in a tree is meaningful only in that tree as currently structured. (Consider how ($address1 cmp $address2) may be magically meaningful to you, if you meant to figure out what nodes are to the right of what other nodes.) =head2 ancestors() Returns the list of this node's ancestors, starting with its mother, then grandmother, and ending at the root. It does this by simply following the 'mother' attributes up as far as it can. So if $item IS the root, this returns an empty list. Consider that scalar($node->ancestors) returns the ply of this node within the tree -- 2 for a granddaughter of the root, etc., and 0 for root itself. =head2 attribute() =head2 attribute(SCALAR) Exact synonyms for L and L. =head2 attributes() =head2 attributes(SCALAR) In the first form, returns the value of the node object's "attributes" attribute. In the second form, sets it to the value of SCALAR. I intend this to be used to store a reference to a (presumably anonymous) hash the user can use to store whatever attributes he doesn't want to have to store as object attributes. In this case, you needn't ever set the value of this. (_init has already initialized it to {}.) Instead you can just do... $node->attributes->{'foo'} = 'bar'; ...to write foo => bar. =head2 clear_daughters() This unlinks all $mother's daughters. Returns the list of what used to be $mother's daughters. Not to be confused with L. =head2 common(LIST) Returns the lowest node in the tree that is ancestor-or-self to the nodes $node and LIST. If the nodes are far enough apart in the tree, the answer is just the root. If the nodes aren't all in the same tree, the answer is undef. As a degenerate case, if LIST is empty, returns $node. =head2 common_ancestor(LIST) Returns the lowest node that is ancestor to all the nodes given (in nodes $node and LIST). In other words, it answers the question: "What node in the tree, as low as possible, is ancestor to the nodes given ($node and LIST)?" If the nodes are far enough apart, the answer is just the root -- except if any of the nodes are the root itself, in which case the answer is undef (since the root has no ancestor). If the nodes aren't all in the same tree, the answer is undef. As a degenerate case, if LIST is empty, returns $node's mother; that'll be undef if $node is root. =head2 copy($option) Returns a copy of the calling node (the invocant). E.g.: my($copy) = $node -> copy; $option is a hashref of options, with these (key => value) pairs: =over 4 =item o no_attribute_copy => $Boolean If set to 1, do not copy the node's attributes. If not specified, defaults to 0, which copies attributes. =back =head2 copy_at_and_under() =head2 copy_at_and_under($options) This returns a copy of the subtree consisting of $node and everything under it. If you pass no options, copy_at_and_under pretends you've passed {}. This works by recursively building up the new tree from the leaves, duplicating nodes using $orig_node->copy($options_ref) and then linking them up into a new tree of the same shape. Options you specify are passed down to calls to $node->copy. =head2 copy_tree() =head2 copy_tree($options) This returns the root of a copy of the tree that $node is a member of. If you pass no options, copy_tree pretends you've passed {}. This method is currently implemented as just a call to $this->root->copy_at_and_under($options), but magic may be added in the future. Options you specify are passed down to calls to $node->copy. =head2 daughters() This returns the (possibly empty) list of daughters for $node. =head2 decode_lol($lol) Returns an arrayref having decoded the deeply nested structure $lol. $lol will be the output of either tree_to_lol() or tree_to_simple_lol(). See scripts/read.tree.pl, and it's output file scripts/read.tree.log. =head2 delete_tree() Destroys the entire tree that $node is a member of (starting at the root), by nulling out each node-object's attributes (including, most importantly, its linkage attributes -- hopefully this is more than sufficient to eliminate all circularity in the data structure), and then moving it into the class DEADNODE. Use this when you're finished with the tree in question, and want to free up its memory. (If you don't do this, it'll get freed up anyway when your program ends.) If you try calling any methods on any of the node objects in the tree you've destroyed, you'll get an error like: Can't locate object method "leaves_under" via package "DEADNODE". So if you see that, that's what you've done wrong. (Actually, the class DEADNODE does provide one method: a no-op method "delete_tree". So if you want to delete a tree, but think you may have deleted it already, it's safe to call $node->delete_tree on it (again).) The L method is needed because Perl's garbage collector would never (as currently implemented) see that it was time to de-allocate the memory the tree uses -- until either you call $node->delete_tree, or until the program stops (at "global destruction" time, when B is unallocated). Incidentally, there are better ways to do garbage-collecting on a tree, ways which don't require the user to explicitly call a method like L -- they involve dummy classes, as explained at L However, introducing a dummy class concept into C would be rather a distraction. If you want to do this with your derived classes, via a DESTROY in a dummy class (or in a tree-metainformation class, maybe), then feel free to. The only case where I can imagine L failing to totally void the tree, is if you use the hashref in the "attributes" attribute to store (presumably among other things) references to other nodes' "attributes" hashrefs -- which 1) is maybe a bit odd, and 2) is your problem, because it's your hash structure that's circular, not the tree's. Anyway, consider: # null out all my "attributes" hashes $anywhere->root->walk_down({ 'callback' => sub { $hr = $_[0]->attributes; %$hr = (); return 1; } }); # And then: $anywhere->delete_tree; (I suppose L is a "destructor", or as close as you can meaningfully come for a circularity-rich data structure in Perl.) See also L. =head2 depth_under() Returns an integer representing the number of branches between this $node and the most distant leaf under it. (In other words, this returns the ply of subtree starting of $node. Consider scalar($it->ancestors) if you want the ply of a node within the whole tree.) =head2 descendants() Returns a list consisting of all the descendants of $node. Returns empty-list if $node is a terminal_node. (Note that it's spelled "descendants", not "descendents".) =head2 draw_ascii_tree([$options]) Here, the [] refer to an optional parameter. Returns an arrayref of lines suitable for printing. Draws a nice ASCII-art representation of the tree structure. The tree looks like: | /-------+-----+---+---\ | | | | | /---\ /---\ | | | | | | | | | | | | | | | | | | | See scripts/cut.and.paste.subtrees.pl. Example usage: print map("$_\n", @{$tree->draw_ascii_tree}); I takes parameters you set in the $options hashref: =over 4 =item o h_compact Takes 0 or 1. Sets the extent to which I tries to save horizontal space. If I think of a better scrunching algorithm, there'll be a "2" setting for this. Default: 1. =item o h_spacing Takes a number 0 or greater. Sets the number of spaces inserted horizontally between nodes (and groups of nodes) in a tree. Default: 1. =item o no_name If true, I doesn't print the name of the node; it simply prints a "*". Default: 0 (i.e., print the node name.) =item o v_compact Takes a number 0, 1, or 2. Sets the degree to which I tries to save vertical space. Defaults to 1. =back The code occasionally returns trees that are a bit cock-eyed in parts; if anyone can suggest a better drawing algorithm, I'd be appreciative. See also L. =head2 dump_names($options) Returns an array. Dumps, as an indented list, the names of the nodes starting at $node, and continuing under it. Options are: =over 4 =item o _depth -- A nonnegative number Indicating the depth to consider $node as being at (and so the generation under that is that plus one, etc.). You may choose to use set _depth => scalar($node->ancestors). Default: 0. =item o tick -- a string to preface each entry with This string goes between the indenting-spacing and the node's name. You may prefer "*" or "-> " or something. Default: ''. =item o indent -- the string used to indent with Another sane value might be '. ' (period, space). Setting it to empty-string suppresses indenting. Default: ' ' x 2. =back The output is not printed, but is returned as a list, where each item is a line, with a "\n" at the end. =head2 format_node($options, $node) Returns a string consisting of the node's name and, optionally, it's attributes. Possible keys in the $options hashref: =over 4 =item o no_attributes => $Boolean If 1, the node's attributes are not included in the string returned. Default: 0 (include attributes). =back Calls L. Called by L. You would not normally call this method. If you don't wish to supply options, use format_node({}, $node). =head2 generation() Returns a list of all nodes (going left-to-right) that are in $node's generation -- i.e., that are the some number of nodes down from the root. $root->generation() is just $root. Of course, $node is always in its own generation. =head2 generation_under($node) Like L, but returns only the nodes in $node's generation that are also descendants of $node -- in other words, @us = $node->generation_under( $node->mother->mother ); is all $node's first cousins (to borrow yet more kinship terminology) -- assuming $node does indeed have a grandmother. Actually "cousins" isn't quite an apt word, because C<@us> ends up including $node's siblings and $node. Actually, L is just an alias to L, but I figure that this: @us = $node->generation_under($way_upline); is a bit more readable than this: @us = $node->generation($way_upline); But it's up to you. $node->generation_under($node) returns just $node. If you call $node->generation_under($node) but NODE2 is not $node or an ancestor of $node, it behaves as if you called just $node->generation(). =head2 hashref2string($hashref) Returns the given hashref as a string. Called by L. =head2 is_daughter_of($node2) Returns true iff $node is a daughter of $node2. Currently implemented as just a test of ($it->mother eq $node2). =head2 is_node() This always returns true. More pertinently, $object->can('is_node') is true (regardless of what L would do if called) for objects belonging to this class or for any class derived from it. =head2 is_root() Returns 1 if the caller is the root, and 0 if it is not. =head2 leaves_under() Returns a list (going left-to-right) of all the leaf nodes under $node. ("Leaf nodes" are also called "terminal nodes" -- i.e., nodes that have no daughters.) Returns $node in the degenerate case of $node being a leaf itself. =head2 left_sister() Returns the node that's the immediate left sister of $node. If $node is the leftmost (or only) daughter of its mother (or has no mother), then this returns undef. See also L and L. =head2 left_sisters() Returns a list of nodes that're sisters to the left of $node. If $node is the leftmost (or only) daughter of its mother (or has no mother), then this returns an empty list. See also L and L. =head2 lol_to_tree($lol) This must be called as a class method. Converts something like bracket-notation for "Chomsky trees" (or rather, the closest you can come with Perl list-of-lists(-of-lists(-of-lists))) into a tree structure. Returns the root of the tree converted. The conversion rules are that: 1) if the last (possibly the only) item in a given list is a scalar, then that is used as the "name" attribute for the node based on this list. 2) All other items in the list represent daughter nodes of the current node -- recursively so, if they are list references; otherwise, (non-terminal) scalars are considered to denote nodes with that name. So ['Foo', 'Bar', 'N'] is an alternate way to represent [['Foo'], ['Bar'], 'N']. An example will illustrate: use Tree::DAG_Node; $lol = [ [ [ [ 'Det:The' ], [ [ 'dog' ], 'N'], 'NP'], [ '/with rabies\\', 'PP'], 'NP' ], [ 'died', 'VP'], 'S' ]; $tree = Tree::DAG_Node->lol_to_tree($lol); $diagram = $tree->draw_ascii_tree; print map "$_\n", @$diagram; ...returns this tree: | | /------------------\ | | | | /---------------\ | | | | /-------\ | | | By the way (and this rather follows from the above rules), when denoting a LoL tree consisting of just one node, this: $tree = Tree::DAG_Node->lol_to_tree( 'Lonely' ); is okay, although it'd probably occur to you to denote it only as: $tree = Tree::DAG_Node->lol_to_tree( ['Lonely'] ); which is of course fine, too. =head2 mother() This returns what node is $node's mother. This is undef if $node has no mother -- i.e., if it is a root. See also L and L. =head2 my_daughter_index() Returns what index this daughter is, in its mother's C list. In other words, if $node is ($node->mother->daughters)[3], then $node->my_daughter_index returns 3. As a special case, returns 0 if $node has no mother. =head2 name() =head2 name(SCALAR) In the first form, returns the value of the node object's "name" attribute. In the second form, sets it to the value of SCALAR. =head2 new($hashref) These options are supported in $hashref: =over 4 =item o attributes => A hashref of attributes =item o daughters => An arrayref of nodes =item o mother => A node =item o name => A string =back See also L for a long discussion on object creation. =head2 new_daughter() =head2 new_daughter($options) This B a B node (of the same class as $mother), and adds it to the (right) end of the daughter list of $mother. This is essentially the same as going $daughter = $mother->new; $mother->add_daughter($daughter); but is rather more efficient because (since $daughter is guaranteed new and isn't linked to/from anything), it doesn't have to check that $daughter isn't an ancestor of $mother, isn't already daughter to a mother it needs to be unlinked from, isn't already in $mother's daughter list, etc. As you'd expect for a constructor, it returns the node-object created. Note that if you radically change 'mother'/'daughters' bookkeeping, you may have to change this routine, since it's one of the places that directly writes to 'daughters' and 'mother'. =head2 new_daughter_left() =head2 new_daughter_left($options) This is just like $mother->new_daughter, but adds the new daughter to the left (start) of $mother's daughter list. Note that if you radically change 'mother'/'daughters' bookkeeping, you may have to change this routine, since it's one of the places that directly writes to 'daughters' and 'mother'. =head2 node2string($options, $node, $vert_dashes) Returns a string of the node's name and attributes, with a leading indent, suitable for printing. Possible keys in the $options hashref: =over 4 =item o no_attributes => $Boolean If 1, the node's attributes are not included in the string returned. Default: 0 (include attributes). =back Ignore the parameter $vert_dashes. The code uses it as temporary storage. Calls L. Called by L. =head2 quote_name($name) Returns the string "'$name'", which is used in various methods for outputting node names. =head2 random_network($options) This method can be called as a class method or as an object method. In the first case, constructs a randomly arranged network under a new node, and returns the root node of that tree. In the latter case, constructs the network under $node. Currently, this is implemented a bit half-heartedly, and half-wittedly. I basically needed to make up random-looking networks to stress-test the various tree-dumper methods, and so wrote this. If you actually want to rely on this for any application more serious than that, I suggest examining the source code and seeing if this does really what you need (say, in reliability of randomness); and feel totally free to suggest changes to me (especially in the form of "I rewrote L, here's the code...") It takes four options: =over 4 =item o max_node_count -- maximum number of nodes this tree will be allowed to have (counting the root) Default: 25. =item o min_depth -- minimum depth for the tree Leaves can be generated only after this depth is reached, so the tree will be at least this deep -- unless max_node_count is hit first. Default: 2. =item o max_depth -- maximum depth for the tree The tree will not be deeper than this. Default: 3 plus min_depth. =item o max_children -- maximum number of children any mother in the tree can have. Default: 4. =back =head2 read_attributes($s) Parses the string $s and extracts the name and attributes, assuming the format is as generated by L. This bascially means the attribute string was generated by L. Attributes may be absent, in which case they default to {}. Returns a new node with this name and these attributes. This method is for use by L. See t/tree.without.attributes.txt and t/tree.with.attributes.txt for sample data. =head2 read_tree($file_name) Returns the root of the tree read from $file_name. The file must have been written by re-directing the output of L to a file, since it makes assumptions about the format of the stringified attributes. read_tree() works with utf-8 data. See t/read.tree.t and t/tree.utf8.attributes.txt. Note: To call this method you need a caller. It'll be a tree of 1 node. The reason is that inside this method it calls various other methods, and for these calls it needs $self. That way, those methods can be called from anywhere, and not just from within read_tree(). For reading and writing trees to databases, see L. Calls L. =head2 remove_daughter(LIST) An exact synonym for L. =head2 remove_daughters(LIST) This removes the nodes listed in LIST from $mother's daughter list. This is a no-operation if LIST is empty. If there are things in LIST that aren't a current daughter of $mother, they are ignored. Not to be confused with L. =head2 replace_with(LIST) This replaces $node in its mother's daughter list, by unlinking $node and replacing it with the items in LIST. This returns a list consisting of $node followed by LIST, i.e., the nodes that replaced it. LIST can include $node itself (presumably at most once). LIST can also be the empty list. However, if any items in LIST are sisters to $node, they are ignored, and are not in the copy of LIST passed as the return value. As you might expect for any linking operation, the items in LIST cannot be $node's mother, or any ancestor to it; and items in LIST are, of course, unlinked from their mothers (if they have any) as they're linked to $node's mother. (In the special (and bizarre) case where $node is root, this simply calls $this->unlink_from_mother on all the items in LIST, making them roots of their own trees.) Note that the daughter-list of $node is not necessarily affected; nor are the daughter-lists of the items in LIST. I mention this in case you think replace_with switches one node for another, with respect to its mother list B its daughter list, leaving the rest of the tree unchanged. If that's what you want, replacing $Old with $New, then you want: $New->set_daughters($Old->clear_daughters); $Old->replace_with($New); (I can't say $node's and LIST-items' daughter lists are B affected my replace_with -- they can be affected in this case: $N1 = ($node->daughters)[0]; # first daughter of $node $N2 = ($N1->daughters)[0]; # first daughter of $N1; $N3 = Tree::DAG_Node->random_network; # or whatever $node->replace_with($N1, $N2, $N3); As a side affect of attaching $N1 and $N2 to $node's mother, they're unlinked from their parents ($node, and $N1, respectively). But N3's daughter list is unaffected. In other words, this method does what it has to, as you'd expect it to. =head2 replace_with_daughters() This replaces $node in its mother's daughter list, by unlinking $node and replacing it with its daughters. In other words, $node becomes motherless and daughterless as its daughters move up and take its place. This returns a list consisting of $node followed by the nodes that were its daughters. In the special (and bizarre) case where $node is root, this simply unlinks its daughters from it, making them roots of their own trees. Effectively the same as $node->replace_with($node->daughters), but more efficient, since less checking has to be done. (And I also think $node->replace_with_daughters is a more common operation in tree-wrangling than $node->replace_with(LIST), so deserves a named method of its own, but that's just me.) Note that if you radically change 'mother'/'daughters' bookkeeping, you may have to change this routine, since it's one of the places that directly writes to 'daughters' and 'mother'. =head2 right_sister() Returns the node that's the immediate right sister of $node. If $node is the rightmost (or only) daughter of its mother (or has no mother), then this returns undef. See also L and L. =head2 right_sisters() Returns a list of nodes that're sisters to the right of $node. If $node is the rightmost (or only) daughter of its mother (or has no mother), then this returns an empty list. See also L and L. =head2 root() Returns the root of whatever tree $node is a member of. If $node is the root, then the result is $node itself. Not to be confused with L. =head2 self_and_descendants() Returns a list consisting of itself (as element 0) and all the descendants of $node. Returns just itself if $node is a terminal_node. (Note that it's spelled "descendants", not "descendents".) =head2 self_and_sisters() Returns a list of all nodes (going left-to-right) that have the same mother as $node -- including $node itself. This is just like $node->mother->daughters, except that that fails where $node is root, whereas $root->self_and_siblings, as a special case, returns $root. (Contrary to how you may interpret how this method is named, "self" is not (necessarily) the first element of what's returned.) =head2 set_daughters(LIST) This unlinks all $mother's daughters, and replaces them with the daughters in LIST. Currently implemented as just $mother->clear_daughters followed by $mother->add_daughters(LIST). =head2 simple_lol_to_tree($simple_lol) This must be called as a class method. This is like lol_to_tree, except that rule 1 doesn't apply -- i.e., all scalars (or really, anything not a listref) in the LoL-structure end up as named terminal nodes, and only terminal nodes get names (and, of course, that name comes from that scalar value). This method is useful for making things like expression trees, or at least starting them off. Consider that this: $tree = Tree::DAG_Node->simple_lol_to_tree( [ 'foo', ['bar', ['baz'], 'quux'], 'zaz', 'pati' ] ); converts from something like a Lispish or Iconish tree, if you pretend the brackets are parentheses. Note that there is a (possibly surprising) degenerate case of what I'm calling a "simple-LoL", and it's like this: $tree = Tree::DAG_Node->simple_lol_to_tree('Lonely'); This is the (only) way you can specify a tree consisting of only a single node, which here gets the name 'Lonely'. =head2 sisters() Returns a list of all nodes (going left-to-right) that have the same mother as $node -- B $node itself. If $node is root, this returns empty-list. =head2 string2hashref($s) Returns the hashref built from the string. The string is expected to be something like '{AutoCommit => '1', PrintError => "0", ReportError => 1}'. The empty string is returned as {}. Called by L. =head2 tree_to_lol() Returns that tree (starting at $node) represented as a LoL, like what $lol, above, holds. (This is as opposed to L, which returns the viewable code like what gets evaluated and stored in $lol, above.) Undefined node names are returned as the string 'undef'. See also L. Lord only knows what you use this for -- maybe for feeding to Data::Dumper, in case L doesn't do just what you want? =head2 tree_to_lol_notation($options) Dumps a tree (starting at $node) as the sort of LoL-like bracket notation you see in the above example code. Returns just one big block of text. The only option is "multiline" -- if true, it dumps the text as the sort of indented structure as seen above; if false (and it defaults to false), dumps it all on one line (with no indenting, of course). For example, starting with the tree from the above example, this: print $tree->tree_to_lol_notation, "\n"; prints the following (which I've broken over two lines for sake of printability of documentation): [[[['Det:The'], [['dog'], 'N'], 'NP'], [["/with rabies\x5c"], 'PP'], 'NP'], [['died'], 'VP'], 'S'], Doing this: print $tree->tree_to_lol_notation({ multiline => 1 }); prints the same content, just spread over many lines, and prettily indented. Undefined node names are returned as the string 'undef'. =head2 tree_to_simple_lol() Returns that tree (starting at $node) represented as a simple-LoL -- i.e., one where non-terminal nodes are represented as listrefs, and terminal nodes are gotten from the contents of those nodes' "name' attributes. Note that in the case of $node being terminal, what you get back is the same as $node->name. Compare to tree_to_simple_lol_notation. Undefined node names are returned as the string 'undef'. See also L. =head2 tree_to_simple_lol_notation($options) A simple-LoL version of tree_to_lol_notation (which see); takes the same options. Undefined node names are returned as the string 'undef'. =head2 tree2string($options, [$some_tree]) Here, the [] represent an optional parameter. Returns an arrayref of lines, suitable for printing. Draws a nice ASCII-art representation of the tree structure. The tree looks like: Root. Attributes: {} |--- Â. Attributes: {# => "ÂÂ"} | |--- â. Attributes: {# => "ââ"} | | |--- É. Attributes: {# => "ÉÉ"} | |--- ä. Attributes: {# => "ää"} | |--- é. Attributes: {# => "éé"} | |--- Ñ. Attributes: {# => "ÑÑ"} | |--- ñ. Attributes: {# => "ññ"} | |--- Ô. Attributes: {# => "ÔÔ"} | |--- ô. Attributes: {# => "ôô"} | |--- ô. Attributes: {# => "ôô"} |--- ß. Attributes: {# => "ßß"} |--- ®. Attributes: {# => "®®"} | |--- ©. Attributes: {# => "©©"} |--- £. Attributes: {# => "££"} |--- €. Attributes: {# => "€€"} |--- √. Attributes: {# => "√√"} |--- ×xX. Attributes: {# => "×xX×xX"} |--- í. Attributes: {# => "íí"} |--- ú. Attributes: {# => "úú"} |--- «. Attributes: {# => "««"} |--- ». Attributes: {# => "»»"} Or, without attributes: Root |--- Â | |--- â | | |--- É | |--- ä | |--- é | |--- Ñ | |--- ñ | |--- Ô | |--- ô | |--- ô |--- ß |--- ® | |--- © |--- £ |--- € |--- √ |--- ×xX |--- í |--- ú |--- « |--- » See scripts/cut.and.paste.subtrees.pl. Example usage: print map("$_\n", @{$tree->tree2string}); Can be called with $some_tree set to any $node, and will print the tree assuming $node is the root. If you don't wish to supply options, use tree2string({}, $node). Possible keys in the $options hashref (which defaults to {}): =over 4 =item o no_attributes => $Boolean If 1, the node's attributes are not included in the string returned. Default: 0 (include attributes). =back Calls L. See also L. =head2 unlink_from_mother() This removes node from the daughter list of its mother. If it has no mother, this is a no-operation. Returns the mother unlinked from (if any). =head2 walk_down($options) Performs a depth-first traversal of the structure at and under $node. What it does at each node depends on the value of the options hashref, which you must provide. There are three options, "callback" and "callbackback" (at least one of which must be defined, as a sub reference), and "_depth". This is what I does, in pseudocode form: =over 4 =item o Starting point Start at the $node given. =item o Callback If there's a I, call it with $node as the first argument, and the options hashref as the second argument (which contains the potentially useful I<_depth>, remember). This function must return true or false -- if false, it will block the next step: =item o Daughters If $node has any daughter nodes, increment I<_depth>, and call $daughter->walk_down($options) for each daughter (in order, of course), where options_hashref is the same hashref it was called with. When this returns, decrements I<_depth>. =item Callbackback If there's a I, call just it as with I (but tossing out the return value). Note that I returning false blocks traversal below $node, but doesn't block calling callbackback for $node. (Incidentally, in the unlikely case that $node has stopped being a node object, I won't get called.) =item o Return =back $node->walk_down($options) is the way to recursively do things to a tree (if you start at the root) or part of a tree; if what you're doing is best done via pre-pre order traversal, use I; if what you're doing is best done with post-order traversal, use I. I is even the basis for plenty of the methods in this class. See the source code for examples both simple and horrific. Note that if you don't specify I<_depth>, it effectively defaults to 0. You should set it to scalar($node->ancestors) if you want I<_depth> to reflect the true depth-in-the-tree for the nodes called, instead of just the depth below $node. (If $node is the root, there's no difference, of course.) And B, it's a bad idea to modify the tree from the callback. Unpredictable things may happen. I instead suggest having your callback add to a stack of things that need changing, and then, once I is all finished, changing those nodes from that stack. Note that the existence of I doesn't mean you can't write you own special-use traversers. =head1 WHEN AND HOW TO DESTROY THE TREE It should be clear to you that if you've built a big parse tree or something, and then you're finished with it, you should call $some_node->delete_tree on it if you want the memory back. But consider this case: you've got this tree: A / | \ B C D | | \ E X Y Let's say you decide you don't want D or any of its descendants in the tree, so you call D->unlink_from_mother. This does NOT automagically destroy the tree D-X-Y. Instead it merely splits the tree into two: A D / \ / \ B C X Y | E To destroy D and its little tree, you have to explicitly call delete_tree on it. Note, however, that if you call C->unlink_from_mother, and if you don't have a link to C anywhere, then it B magically go away. This is because nothing links to C -- whereas with the D-X-Y tree, D links to X and Y, and X and Y each link back to D. Note that calling C->delete_tree is harmless -- after all, a tree of only one node is still a tree. So, this is a surefire way of getting rid of all $node's children and freeing up the memory associated with them and their descendants: foreach my $it ($node->clear_daughters) { $it->delete_tree } Just be sure not to do this: foreach my $it ($node->daughters) { $it->delete_tree } $node->clear_daughters; That's bad; the first call to $_->delete_tree will climb to the root of $node's tree, and nuke the whole tree, not just the bits under $node. You might as well have just called $node->delete_tree. (Moreavor, once $node is dead, you can't call clear_daughters on it, so you'll get an error there.) =head1 BUG REPORTS If you find a bug in this library, report it to me as soon as possible, at the address listed in the MAINTAINER section, below. Please try to be as specific as possible about how you got the bug to occur. =head1 HELP! If you develop a given routine for dealing with trees in some way, and use it a lot, then if you think it'd be of use to anyone else, do email me about it; it might be helpful to others to include that routine, or something based on it, in a later version of this module. It's occurred to me that you might like to (and might yourself develop routines to) draw trees in something other than ASCII art. If you do so -- say, for PostScript output, or for output interpretable by some external plotting program -- I'd be most interested in the results. =head1 RAMBLINGS This module uses "strict", but I never wrote it with -w warnings in mind -- so if you use -w, do not be surprised if you see complaints from the guts of DAG_Node. As long as there is no way to turn off -w for a given module (instead of having to do it in every single subroutine with a "local $^W"), I'm not going to change this. However, I do, at points, get bursts of ambition, and I try to fix code in DAG_Node that generates warnings, I -- which is only occasionally. Feel free to email me any patches for any such fixes you come up with, tho. Currently I don't assume (or enforce) anything about the class membership of nodes being manipulated, other than by testing whether each one provides a method L, a la: die "Not a node!!!" unless UNIVERSAL::can($node, "is_node"); So, as far as I'm concerned, a given tree's nodes are free to belong to different classes, just so long as they provide/inherit L, the few methods that this class relies on to navigate the tree, and have the same internal object structure, or a superset of it. Presumably this would be the case for any object belonging to a class derived from C, or belonging to C itself. When routines in this class access a node's "mother" attribute, or its "daughters" attribute, they (generally) do so directly (via $node->{'mother'}, etc.), for sake of efficiency. But classes derived from this class should probably do this instead thru a method (via $node->mother, etc.), for sake of portability, abstraction, and general goodness. However, no routines in this class (aside from, necessarily, I<_init()>, I<_init_name()>, and L) access the "name" attribute directly; routines (like the various tree draw/dump methods) get the "name" value thru a call to $obj->name(). So if you want the object's name to not be a real attribute, but instead have it derived dynamically from some feature of the object (say, based on some of its other attributes, or based on its address), you can to override the L method, without causing problems. (Be sure to consider the case of $obj->name as a write method, as it's used in I and L.) =head1 FAQ =head2 Which is the best tree processing module? C, as it happens. More details: L. =head2 How to process every node in tree? See L. $options normally looks like this, assuming we wish to pass in an arrayref as a stack: my(@stack); $tree -> walk_down ({ callback => sub { my(@node, $options) = @_; # Process $node, using $options... push @{$$options{stack} }, $node -> name; return 1; # Keep walking. }, _depth => 0, stack => \@stack, }); # Process @stack... =head2 How do I switch from Tree to Tree::DAG_Node? =over 4 =item o The node's name In C you use $node -> value and in C it's $node -> name. =item o The node's attributes In C you use $node -> meta and in C it's $node -> attributes. =back =head2 Are there techniques for processing lists of nodes? =over 4 =item o Copy the daughter list, and change it @them = $mother->daughters; @removed = splice(@them, 0, 2, @new_nodes); $mother->set_daughters(@them); =item o Select a sub-set of nodes $mother->set_daughters ( grep($_->name =~ /wanted/, $mother->daughters) ); =back =head2 Why did you break up the sections of methods in the POD? Because I want to list the methods in alphabetical order. =head2 Why did you move the POD to the end? Because the apostrophes in the text confused the syntax hightlighter in my editor UltraEdit. =head1 SEE ALSO =over 4 =item o L, L and L Sean is also the author of these modules. =item o L Lightweight. =item o L Lightweight. =item o L Lightweight. =item o L Lightweight. =item o L Uses L. =back C itself is also lightweight. =head1 REFERENCES Wirth, Niklaus. 1976. I Prentice-Hall, Englewood Cliffs, NJ. Knuth, Donald Ervin. 1997. I. Addison-Wesley, Reading, MA. Wirth's classic, currently and lamentably out of print, has a good section on trees. I find it clearer than Knuth's (if not quite as encyclopedic), probably because Wirth's example code is in a block-structured high-level language (basically Pascal), instead of in assembler (MIX). Until some kind publisher brings out a new printing of Wirth's book, try poking around used bookstores (or C) for a copy. I think it was also republished in the 1980s under the title I, and in a German edition called I. (That is, I'm sure books by Knuth were published under those titles, but I'm I that they're just later printings/editions of I.) =head1 MACHINE-READABLE CHANGE LOG The file Changes was converted into Changelog.ini by L. =head1 REPOSITORY L =head1 SUPPORT Email the author, or log a bug on RT: L. =head1 ACKNOWLEDGEMENTS The code to print the tree, in tree2string(), was adapted from L by the dread Stevan Little. =head1 MAINTAINER David Hand, C<< >> up to V 1.06. Ron Savage C<< >> from V 1.07. In this POD, usage of 'I' refers to Sean, up until V 1.07. =head1 AUTHOR Sean M. Burke, C<< >> =head1 COPYRIGHT, LICENSE, AND DISCLAIMER Copyright 1998-2001, 2004, 2007 by Sean M. Burke and David Hand. This Program of ours is 'OSI Certified Open Source Software'; you can redistribute it and/or modify it under the terms of The Perl License, a copy of which is available at: http://dev.perl.org/licenses/ This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. =cut Tree-DAG_Node-1.35/META.yml0000644000175000017500000000157015010317500013321 0ustar ronron--- abstract: 'An N-ary tree' author: - 'Sean M. Burke ' build_requires: ExtUtils::MakeMaker: '0' File::Spec: '3.4' File::Temp: '0.19' Test::More: '1.001002' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Tree-DAG_Node no_index: directory: - t - inc requires: ExtUtils::MakeMaker: '7.7' File::Slurper: '0.014' open: '0' strict: '0' utf8: '0' warnings: '0' resources: bugtracker: https://github.com/ronsavage/Tree-DAG_Node/issues license: http://opensource.org/licenses/Artistic-2.0 repository: https://github.com/ronsavage/Tree-DAG_Node.git version: '1.35' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Tree-DAG_Node-1.35/LICENSE0000644000175000017500000004740614772113521013100 0ustar ronronTerms of Perl itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" ---------------------------------------------------------------------------- The General Public License (GPL) Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Lesser General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS ---------------------------------------------------------------------------- The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Tree-DAG_Node-1.35/Changelog.ini0000644000175000017500000004043115010317477014454 0ustar ronron[Module] Name=Tree::DAG_Node Changelog.Creator=Module::Metadata::Changes V 2.12 Changelog.Parser=Config::IniFiles V 3.000003 [V 1.35] Date=2025-05-12T17:00:00 Comments= < Date: Tue Mar 1 09:16:46 2016 +1100 Update distmeta The command used to generate the tags looks like: git tag -afm 'V 1.28 @ Tue Mar 1 09:16:46 2016' 1.28 EOT [V 1.27] Date=2015-07-12T11:01:00 Comments= < 'b, c'}. string2hashref() is called by read_tree(). Escaped chars are still not handled. - Add t/string2hash.t to test new code. EOT [V 1.25] Date=2015-03-22T11:42:00 Comments= < | |---[values] Is now printed as: |--- :default | |--- ::= | |--- action | |--- => | |--- [values] This makes the difference between node names ''/'-', '1'/'-1', etc, much clearer. Apologies to anyone who runs tests which compare the output with pre-existing files. EOT [V 1.22] Date=2014-02-13T13:14:00 Comments=- t/read.tree.t was still using File::Slurp :-(. [V 1.21] Date=2014-02-13T11:14:00 Comments=- Switch from File::Slurp to File::Slurp::Tiny, on the advice of Karen Etheridge. See RT#92976. [V 1.20] Date=2014-01-31T09:46:00 Comments= < 1} option. - Add method read_tree(), for text files. It uses Perl6::Slurp (which supports utf8). - Add methods read_attributes() and string2hashref($s) for use by read_tree(). - Add t/read.tree.t to test read_tree(). - Add t/tree.utf8.attributes.txt, in utf8, for use by t/read.tree.t. - Add t/tree.with.attributes.txt and t/tree.without.attributes.txt for use by t/read.tree.t. - Make Perl V 5.8.1 a pre-req so we have access to the utf8 pragma. EOT [V 1.13] Date=2013-08-12T17:16:00 Comments= < 2013) in this file used for V 1.10. - Correct the text at L so it refers to Artistic License 2.0, which now matches what it says in Build.PL and Makefile.PL. Resolves RT#83088. EOT [V 1.10] Date=2013-02-01T08:53:00 Comments= <new constructor syntax now documented. Internal accesses to "daughter" and "mother" attribs are now direct, for efficiency's sake. - Minor improvements to the docs. EOT [V 0.74] Date=1998-10-28T12:00:00 Comments= < 'An N-ary tree', AUTHOR => 'Sean M. Burke ', clean => { FILES => 'blib/* Makefile MANIFEST Tree-DAG_Node-*' }, dist => { COMPRESS => 'gzip', SUFFIX => 'gz' }, DISTNAME => 'Tree-DAG_Node', LICENSE => 'perl', NAME => 'Tree::DAG_Node', PL_FILES => {}, PREREQ_PM => { 'ExtUtils::MakeMaker' => 7.70, 'File::Slurper' => 0.014, 'open' => 0, 'strict' => 0, 'utf8' => 0, 'warnings' => 0, }, TEST_REQUIRES => { 'File::Spec' => 3.40, 'File::Temp' => 0.19, 'Test::More' => 1.001002, }, VERSION_FROM => 'lib/Tree/DAG_Node.pm', ); if ( ($ExtUtils::MakeMaker::VERSION =~ /^\d\.\d\d$/) && ($ExtUtils::MakeMaker::VERSION > 6.30) ) { $params{LICENSE} = 'perl'; } if ($ExtUtils::MakeMaker::VERSION ge '6.46') { $params{META_MERGE} = { 'meta-spec' => { version => 2, }, prereqs => { develop => { requires => { 'Test::Pod' => 1.48 } } }, resources => { bugtracker => { web => 'https://github.com/ronsavage/Tree-DAG_Node/issues', }, license => 'http://opensource.org/licenses/Artistic-2.0', repository => { type => 'git', url => 'https://github.com/ronsavage/Tree-DAG_Node.git', web => 'https://github.com/ronsavage/Tree-DAG_Node', }, }, }; } WriteMakefile(%params); Tree-DAG_Node-1.35/share/0000755000175000017500000000000015010317500013147 5ustar ronronTree-DAG_Node-1.35/share/metag.cooked.tree.new0000644000175000017500000002007715002622145017173 0ustar ronronCooked tree. Attributes: {rule => "", uid => "1"} |--- statements. Attributes: {rule => "1", uid => "2"} |--- default_rule. Attributes: {rule => "1", uid => "3"} |--- lexeme_default_statement. Attributes: {rule => "1", uid => "4"} |--- start_rule. Attributes: {rule => "1", uid => "5"} |--- quantified_rule. Attributes: {rule => "1", uid => "6"} |--- priority_rule. Attributes: {rule => "1", uid => "7"} |--- priority_rule. Attributes: {rule => "1", uid => "8"} |--- priority_rule. Attributes: {rule => "1", uid => "9"} |--- priority_rule. Attributes: {rule => "1", uid => "10"} |--- priority_rule. Attributes: {rule => "1", uid => "11"} |--- priority_rule. Attributes: {rule => "1", uid => "12"} |--- priority_rule. Attributes: {rule => "1", uid => "13"} |--- priority_rule. Attributes: {rule => "1", uid => "14"} |--- priority_rule. Attributes: {rule => "1", uid => "15"} |--- priority_rule. Attributes: {rule => "1", uid => "16"} |--- priority_rule. Attributes: {rule => "1", uid => "17"} |--- priority_rule. Attributes: {rule => "1", uid => "18"} |--- priority_rule. Attributes: {rule => "1", uid => "19"} |--- priority_rule. Attributes: {rule => "1", uid => "20"} |--- priority_rule. Attributes: {rule => "1", uid => "21"} |--- priority_rule. Attributes: {rule => "1", uid => "22"} |--- priority_rule. Attributes: {rule => "1", uid => "23"} |--- priority_rule. Attributes: {rule => "1", uid => "24"} |--- priority_rule. Attributes: {rule => "1", uid => "25"} |--- priority_rule. Attributes: {rule => "1", uid => "26"} |--- separator_specification. Attributes: {rule => "1", uid => "27"} |--- separator_specification. Attributes: {rule => "1", uid => "28"} |--- priority_rule. Attributes: {rule => "1", uid => "29"} |--- priority_rule. Attributes: {rule => "1", uid => "30"} |--- quantified_rule. Attributes: {rule => "1", uid => "31"} |--- priority_rule. Attributes: {rule => "1", uid => "32"} |--- priority_rule. Attributes: {rule => "1", uid => "33"} |--- priority_rule. Attributes: {rule => "1", uid => "34"} |--- priority_rule. Attributes: {rule => "1", uid => "35"} |--- priority_rule. Attributes: {rule => "1", uid => "36"} |--- priority_rule. Attributes: {rule => "1", uid => "37"} |--- priority_rule. Attributes: {rule => "1", uid => "38"} |--- priority_rule. Attributes: {rule => "1", uid => "39"} |--- priority_rule. Attributes: {rule => "1", uid => "40"} |--- priority_rule. Attributes: {rule => "1", uid => "41"} |--- priority_rule. Attributes: {rule => "1", uid => "42"} |--- priority_rule. Attributes: {rule => "1", uid => "43"} |--- priority_rule. Attributes: {rule => "1", uid => "44"} |--- priority_rule. Attributes: {rule => "1", uid => "45"} |--- priority_rule. Attributes: {rule => "1", uid => "46"} |--- priority_rule. Attributes: {rule => "1", uid => "47"} |--- priority_rule. Attributes: {rule => "1", uid => "48"} |--- priority_rule. Attributes: {rule => "1", uid => "49"} |--- lhs. Attributes: {rule => "1", uid => "50"} |--- priority_rule. Attributes: {rule => "1", uid => "51"} |--- priority_rule. Attributes: {rule => "1", uid => "52"} |--- priority_rule. Attributes: {rule => "1", uid => "53"} |--- priority_rule. Attributes: {rule => "1", uid => "54"} |--- priority_rule. Attributes: {rule => "1", uid => "55"} |--- priority_rule. Attributes: {rule => "1", uid => "56"} |--- priority_rule. Attributes: {rule => "1", uid => "57"} |--- priority_rule. Attributes: {rule => "1", uid => "58"} |--- priority_rule. Attributes: {rule => "1", uid => "59"} |--- priority_rule. Attributes: {rule => "1", uid => "60"} |--- priority_rule. Attributes: {rule => "1", uid => "61"} |--- quantified_rule. Attributes: {rule => "1", uid => "62"} |--- priority_rule. Attributes: {rule => "1", uid => "63"} |--- priority_rule. Attributes: {rule => "1", uid => "64"} |--- priority_rule. Attributes: {rule => "1", uid => "65"} |--- priority_rule. Attributes: {rule => "1", uid => "66"} |--- quantified_rule. Attributes: {rule => "1", uid => "67"} |--- priority_rule. Attributes: {rule => "1", uid => "68"} |--- priority_rule. Attributes: {rule => "1", uid => "69"} |--- priority_rule. Attributes: {rule => "1", uid => "70"} |--- priority_rule. Attributes: {rule => "1", uid => "71"} |--- priority_rule. Attributes: {rule => "1", uid => "72"} |--- priority_rule. Attributes: {rule => "1", uid => "73"} |--- priority_rule. Attributes: {rule => "1", uid => "74"} |--- discard_rule. Attributes: {rule => "1", uid => "75"} |--- quantified_rule. Attributes: {rule => "1", uid => "76"} |--- discard_rule. Attributes: {rule => "1", uid => "77"} |--- priority_rule. Attributes: {rule => "1", uid => "78"} |--- priority_rule. Attributes: {rule => "1", uid => "79"} |--- priority_rule. Attributes: {rule => "1", uid => "80"} |--- quantified_rule. Attributes: {rule => "1", uid => "81"} |--- priority_rule. Attributes: {rule => "1", uid => "82"} |--- priority_rule. Attributes: {rule => "1", uid => "83"} |--- priority_rule. Attributes: {rule => "1", uid => "84"} |--- priority_rule. Attributes: {rule => "1", uid => "85"} |--- priority_rule. Attributes: {rule => "1", uid => "86"} |--- priority_rule. Attributes: {rule => "1", uid => "87"} |--- priority_rule. Attributes: {rule => "1", uid => "88"} |--- priority_rule. Attributes: {rule => "1", uid => "89"} |--- priority_rule. Attributes: {rule => "1", uid => "90"} |--- priority_rule. Attributes: {rule => "1", uid => "91"} |--- quantified_rule. Attributes: {rule => "1", uid => "92"} |--- priority_rule. Attributes: {rule => "1", uid => "93"} |--- priority_rule. Attributes: {rule => "1", uid => "94"} |--- priority_rule. Attributes: {rule => "1", uid => "95"} |--- quantified_rule. Attributes: {rule => "1", uid => "96"} |--- quantified_rule. Attributes: {rule => "1", uid => "97"} |--- quantified_rule. Attributes: {rule => "1", uid => "98"} |--- priority_rule. Attributes: {rule => "1", uid => "99"} |--- separator_specification. Attributes: {rule => "1", uid => "100"} |--- quantified_rule. Attributes: {rule => "1", uid => "101"} |--- priority_rule. Attributes: {rule => "1", uid => "102"} |--- priority_rule. Attributes: {rule => "1", uid => "103"} |--- quantified_rule. Attributes: {rule => "1", uid => "104"} |--- priority_rule. Attributes: {rule => "1", uid => "105"} |--- priority_rule. Attributes: {rule => "1", uid => "106"} |--- priority_rule. Attributes: {rule => "1", uid => "107"} |--- priority_rule. Attributes: {rule => "1", uid => "108"} |--- priority_rule. Attributes: {rule => "1", uid => "109"} |--- bracketed_name. Attributes: {rule => "1", uid => "110"} |--- priority_rule. Attributes: {rule => "1", uid => "111"} |--- priority_rule. Attributes: {rule => "1", uid => "112"} |--- priority_rule. Attributes: {rule => "1", uid => "113"} |--- priority_rule. Attributes: {rule => "1", uid => "114"} |--- priority_rule. Attributes: {rule => "1", uid => "115"} |--- quantified_rule. Attributes: {rule => "1", uid => "116"} |--- priority_rule. Attributes: {rule => "1", uid => "117"} |--- quantified_rule. Attributes: {rule => "1", uid => "118"} |--- priority_rule. Attributes: {rule => "1", uid => "119"} |--- priority_rule. Attributes: {rule => "1", uid => "120"} |--- priority_rule. Attributes: {rule => "1", uid => "121"} |--- priority_rule. Attributes: {rule => "1", uid => "122"} |--- priority_rule. Attributes: {rule => "1", uid => "123"} |--- priority_rule. Attributes: {rule => "1", uid => "124"} |--- quantified_rule. Attributes: {rule => "1", uid => "125"} |--- priority_rule. Attributes: {rule => "1", uid => "126"} |--- priority_rule. Attributes: {rule => "1", uid => "127"} |--- priority_rule. Attributes: {rule => "1", uid => "128"} |--- priority_rule. Attributes: {rule => "1", uid => "129"} |--- quantified_rule. Attributes: {rule => "1", uid => "130"} Tree-DAG_Node-1.35/share/metag.bnf0000644000175000017500000002056415002602011014735 0ustar ronron# Copyright 2022 Jeffrey Kegler # This file is part of Marpa::R2. Marpa::R2 is free software: you can # redistribute it and/or modify it under the terms of the GNU Lesser # General Public License as published by the Free Software Foundation, # either version 3 of the License, or (at your option) any later version. # # Marpa::R2 is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser # General Public License along with Marpa::R2. If not, see # http://www.gnu.org/licenses/. :default ::= action => [start,length,values] bless => ::lhs lexeme default = action => [start,length,value] bless => ::name forgiving => 1 :start ::= statements statements ::= statement+ statement ::= | | | | | | | | | | | | | | | ::= ';' ::= ('{') statements '}' ::= (':start' ) symbol ::= ('start' 'symbol' 'is') symbol ::= ':default' ::= ('lexeme' 'default' '=') ::= ('discard' 'default' '=') ::= lhs priorities ::= lhs ::= lhs quantifier ::= (':discard' ) ::= (':lexeme' ) symbol ::= ('event') ('=' 'completed') ::= ('event') ('=' 'nulled') ::= ('event') ('=' 'predicted') ::= ('current' 'lexer' 'is') ::= ('inaccessible' 'is') ('by' 'default') ::= 'warn' | 'ok' | 'fatal' ::= | priorities ::= alternatives+ separator => proper => 1 alternatives ::= alternative+ separator => proper => 1 alternative ::= rhs ::= ::= * ::= action | | | | | | | | | | | | blessing | naming | ::= ',' action ::= ('action' '=>') ::= ('assoc' '=>' 'left') ::= ('assoc' '=>' 'right') ::= ('assoc' '=>' 'group') ::= ('separator' '=>') ::= ('proper' '=>') boolean ::= ('rank' '=>') ::= ('null-ranking' '=>') ::= ('null' 'rank' '=>') ::= 'low' | 'high' ::= ('priority' '=>') ::= ('pause' '=>') ::= ('event' '=>') ::= ::= ('=') ::= 'on' | 'off' ::= # empty ::= ('forgiving' '=>') boolean ::= ('latm' '=>') boolean ::= ('bless' '=>') ::= ('name' '=>') ::= | ::= | ::= | | ~ ':symbol' ::= ::= lhs ::= rhs ::= + ::= ::= ::= ::= ('(') (')') ::= + ::= symbol | symbol ::= ::= ::= ::= ::= ::= :discard ~ whitespace whitespace ~ [\s]+ # allow comments :discard ~ ~ | ~ '#' ~ '#' ~ * ~ [\x{A}\x{B}\x{C}\x{D}\x{2028}\x{2029}] ~ [^\x{A}\x{B}\x{C}\x{D}\x{2028}\x{2029}] ~ '::=' ~ '~' ~ '||' ~ '|' quantifier ::= '*' | '+' ~ 'before' | 'after' ~ | ~ [+-] ~ [\d]+ boolean ~ [01] ~ '::' ~ '::' ~ [\w]+ ~ [\w]* # Perl identifiers allow an initial digit, which makes them slightly more liberal than Perl bare names # but equivalent to Perl names with sigils. ~ [\w]+ ~ '::' ~ + separator => proper => 1 ~ [\w]+ ~ [a-zA-Z] ~ '<' '>' ~ [\s\w]+ ~ ~ '[' ~ '[' whitespace ~ ']' ~ whitespace ']' ~ * separator => ~ [,] ~ [,] whitespace ~ 'start' | 'length' | 'g1start' | 'g1length' | 'name' | 'lhs' | 'symbol' | 'rule' | 'value' | 'values' # In single quoted strings and character classes # no escaping or internal newlines, and disallow empty string ~ ['] ['] ~ ['] ['] ~ [^'\x{0A}\x{0B}\x{0C}\x{0D}\x{0085}\x{2028}\x{2029}]+ ~ '[' ']' ~ + ~ # hex 5d is right square bracket ~ [^\x{5d}\x{0A}\x{0B}\x{0C}\x{0D}\x{0085}\x{2028}\x{2029}] ~ ~ '\' ~ ~ ~ * ~ ':ic' ~ ':i' # [=xyz=] and [.xyz.] are parsed by Perl, but then currently cause an exception. # Catching Perl exceptions is inconvenient for Marpa, # so we reject them syntactically instead. ~ '[:' ':]' ~ '[:^' ':]' ~ [[:alnum:]]+ # a horizontal character is any character that is not vertical space ~ [^\x{A}\x{B}\x{C}\x{D}\x{2028}\x{2029}] Tree-DAG_Node-1.35/share/metag.cooked.tree0000644000175000017500000002007715002577125016412 0ustar ronronCooked tree. Attributes: {rule => "", uid => "1"} |--- statements. Attributes: {rule => "1", uid => "2"} |--- default_rule. Attributes: {rule => "1", uid => "3"} |--- lexeme_default_statement. Attributes: {rule => "1", uid => "4"} |--- start_rule. Attributes: {rule => "1", uid => "5"} |--- quantified_rule. Attributes: {rule => "1", uid => "6"} |--- priority_rule. Attributes: {rule => "1", uid => "7"} |--- priority_rule. Attributes: {rule => "1", uid => "8"} |--- priority_rule. Attributes: {rule => "1", uid => "9"} |--- priority_rule. Attributes: {rule => "1", uid => "10"} |--- priority_rule. Attributes: {rule => "1", uid => "11"} |--- priority_rule. Attributes: {rule => "1", uid => "12"} |--- priority_rule. Attributes: {rule => "1", uid => "13"} |--- priority_rule. Attributes: {rule => "1", uid => "14"} |--- priority_rule. Attributes: {rule => "1", uid => "15"} |--- priority_rule. Attributes: {rule => "1", uid => "16"} |--- priority_rule. Attributes: {rule => "1", uid => "17"} |--- priority_rule. Attributes: {rule => "1", uid => "18"} |--- priority_rule. Attributes: {rule => "1", uid => "19"} |--- priority_rule. Attributes: {rule => "1", uid => "20"} |--- priority_rule. Attributes: {rule => "1", uid => "21"} |--- priority_rule. Attributes: {rule => "1", uid => "22"} |--- priority_rule. Attributes: {rule => "1", uid => "23"} |--- priority_rule. Attributes: {rule => "1", uid => "24"} |--- priority_rule. Attributes: {rule => "1", uid => "25"} |--- priority_rule. Attributes: {rule => "1", uid => "26"} |--- separator_specification. Attributes: {rule => "1", uid => "27"} |--- separator_specification. Attributes: {rule => "1", uid => "28"} |--- priority_rule. Attributes: {rule => "1", uid => "29"} |--- priority_rule. Attributes: {rule => "1", uid => "30"} |--- quantified_rule. Attributes: {rule => "1", uid => "31"} |--- priority_rule. Attributes: {rule => "1", uid => "32"} |--- priority_rule. Attributes: {rule => "1", uid => "33"} |--- priority_rule. Attributes: {rule => "1", uid => "34"} |--- priority_rule. Attributes: {rule => "1", uid => "35"} |--- priority_rule. Attributes: {rule => "1", uid => "36"} |--- priority_rule. Attributes: {rule => "1", uid => "37"} |--- priority_rule. Attributes: {rule => "1", uid => "38"} |--- priority_rule. Attributes: {rule => "1", uid => "39"} |--- priority_rule. Attributes: {rule => "1", uid => "40"} |--- priority_rule. Attributes: {rule => "1", uid => "41"} |--- priority_rule. Attributes: {rule => "1", uid => "42"} |--- priority_rule. Attributes: {rule => "1", uid => "43"} |--- priority_rule. Attributes: {rule => "1", uid => "44"} |--- priority_rule. Attributes: {rule => "1", uid => "45"} |--- priority_rule. Attributes: {rule => "1", uid => "46"} |--- priority_rule. Attributes: {rule => "1", uid => "47"} |--- priority_rule. Attributes: {rule => "1", uid => "48"} |--- priority_rule. Attributes: {rule => "1", uid => "49"} |--- lhs. Attributes: {rule => "1", uid => "50"} |--- priority_rule. Attributes: {rule => "1", uid => "51"} |--- priority_rule. Attributes: {rule => "1", uid => "52"} |--- priority_rule. Attributes: {rule => "1", uid => "53"} |--- priority_rule. Attributes: {rule => "1", uid => "54"} |--- priority_rule. Attributes: {rule => "1", uid => "55"} |--- priority_rule. Attributes: {rule => "1", uid => "56"} |--- priority_rule. Attributes: {rule => "1", uid => "57"} |--- priority_rule. Attributes: {rule => "1", uid => "58"} |--- priority_rule. Attributes: {rule => "1", uid => "59"} |--- priority_rule. Attributes: {rule => "1", uid => "60"} |--- priority_rule. Attributes: {rule => "1", uid => "61"} |--- quantified_rule. Attributes: {rule => "1", uid => "62"} |--- priority_rule. Attributes: {rule => "1", uid => "63"} |--- priority_rule. Attributes: {rule => "1", uid => "64"} |--- priority_rule. Attributes: {rule => "1", uid => "65"} |--- priority_rule. Attributes: {rule => "1", uid => "66"} |--- quantified_rule. Attributes: {rule => "1", uid => "67"} |--- priority_rule. Attributes: {rule => "1", uid => "68"} |--- priority_rule. Attributes: {rule => "1", uid => "69"} |--- priority_rule. Attributes: {rule => "1", uid => "70"} |--- priority_rule. Attributes: {rule => "1", uid => "71"} |--- priority_rule. Attributes: {rule => "1", uid => "72"} |--- priority_rule. Attributes: {rule => "1", uid => "73"} |--- priority_rule. Attributes: {rule => "1", uid => "74"} |--- discard_rule. Attributes: {rule => "1", uid => "75"} |--- quantified_rule. Attributes: {rule => "1", uid => "76"} |--- discard_rule. Attributes: {rule => "1", uid => "77"} |--- priority_rule. Attributes: {rule => "1", uid => "78"} |--- priority_rule. Attributes: {rule => "1", uid => "79"} |--- priority_rule. Attributes: {rule => "1", uid => "80"} |--- quantified_rule. Attributes: {rule => "1", uid => "81"} |--- priority_rule. Attributes: {rule => "1", uid => "82"} |--- priority_rule. Attributes: {rule => "1", uid => "83"} |--- priority_rule. Attributes: {rule => "1", uid => "84"} |--- priority_rule. Attributes: {rule => "1", uid => "85"} |--- priority_rule. Attributes: {rule => "1", uid => "86"} |--- priority_rule. Attributes: {rule => "1", uid => "87"} |--- priority_rule. Attributes: {rule => "1", uid => "88"} |--- priority_rule. Attributes: {rule => "1", uid => "89"} |--- priority_rule. Attributes: {rule => "1", uid => "90"} |--- priority_rule. Attributes: {rule => "1", uid => "91"} |--- quantified_rule. Attributes: {rule => "1", uid => "92"} |--- priority_rule. Attributes: {rule => "1", uid => "93"} |--- priority_rule. Attributes: {rule => "1", uid => "94"} |--- priority_rule. Attributes: {rule => "1", uid => "95"} |--- quantified_rule. Attributes: {rule => "1", uid => "96"} |--- quantified_rule. Attributes: {rule => "1", uid => "97"} |--- quantified_rule. Attributes: {rule => "1", uid => "98"} |--- priority_rule. Attributes: {rule => "1", uid => "99"} |--- separator_specification. Attributes: {rule => "1", uid => "100"} |--- quantified_rule. Attributes: {rule => "1", uid => "101"} |--- priority_rule. Attributes: {rule => "1", uid => "102"} |--- priority_rule. Attributes: {rule => "1", uid => "103"} |--- quantified_rule. Attributes: {rule => "1", uid => "104"} |--- priority_rule. Attributes: {rule => "1", uid => "105"} |--- priority_rule. Attributes: {rule => "1", uid => "106"} |--- priority_rule. Attributes: {rule => "1", uid => "107"} |--- priority_rule. Attributes: {rule => "1", uid => "108"} |--- priority_rule. Attributes: {rule => "1", uid => "109"} |--- bracketed_name. Attributes: {rule => "1", uid => "110"} |--- priority_rule. Attributes: {rule => "1", uid => "111"} |--- priority_rule. Attributes: {rule => "1", uid => "112"} |--- priority_rule. Attributes: {rule => "1", uid => "113"} |--- priority_rule. Attributes: {rule => "1", uid => "114"} |--- priority_rule. Attributes: {rule => "1", uid => "115"} |--- quantified_rule. Attributes: {rule => "1", uid => "116"} |--- priority_rule. Attributes: {rule => "1", uid => "117"} |--- quantified_rule. Attributes: {rule => "1", uid => "118"} |--- priority_rule. Attributes: {rule => "1", uid => "119"} |--- priority_rule. Attributes: {rule => "1", uid => "120"} |--- priority_rule. Attributes: {rule => "1", uid => "121"} |--- priority_rule. Attributes: {rule => "1", uid => "122"} |--- priority_rule. Attributes: {rule => "1", uid => "123"} |--- priority_rule. Attributes: {rule => "1", uid => "124"} |--- quantified_rule. Attributes: {rule => "1", uid => "125"} |--- priority_rule. Attributes: {rule => "1", uid => "126"} |--- priority_rule. Attributes: {rule => "1", uid => "127"} |--- priority_rule. Attributes: {rule => "1", uid => "128"} |--- priority_rule. Attributes: {rule => "1", uid => "129"} |--- quantified_rule. Attributes: {rule => "1", uid => "130"} Tree-DAG_Node-1.35/META.json0000644000175000017500000000330715010317500013471 0ustar ronron{ "abstract" : "An N-ary tree", "author" : [ "Sean M. Burke " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Tree-DAG_Node", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Test::Pod" : "1.48" } }, "runtime" : { "requires" : { "ExtUtils::MakeMaker" : "7.7", "File::Slurper" : "0.014", "open" : "0", "strict" : "0", "utf8" : "0", "warnings" : "0" } }, "test" : { "requires" : { "File::Spec" : "3.4", "File::Temp" : "0.19", "Test::More" : "1.001002" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/ronsavage/Tree-DAG_Node/issues" }, "license" : [ "http://opensource.org/licenses/Artistic-2.0" ], "repository" : { "type" : "git", "url" : "https://github.com/ronsavage/Tree-DAG_Node.git", "web" : "https://github.com/ronsavage/Tree-DAG_Node" } }, "version" : "1.35", "x_serialization_backend" : "JSON::PP version 4.16" } Tree-DAG_Node-1.35/Changes0000644000175000017500000003713315010317224013352 0ustar ronronRevision history for Perl module Tree::DAG_Node. 1.35 2025-05-12T17:00:00 - Change sub hashref2string() line 726 so it does not generate an error or warning when the node or node name is '' (empty string), undef or 0 (zero). - Change test data so that when stringifying a tree, node names without attributes are output as (e.g.) 'lexeme: Attributes{}' rather than as just 'lexeme'. This was alleged to have been done as per the last dot point under v 1.34 below, but was not done properly. - This last point also affects the related module Data::RenderAsTree, which ships with a range of test programs and sample scripts which futher exercise these features. The point of these latter samples is so you can use them without having to fiddle about removing the test code in the corresponding test scripts. 1.34 2025-04-23T17:01:00 - Thanx to Shawn Laffan for reporting a problem with line-endings in files read and written, by both Tree::DAG_Node and t/read.tree.t, when he tests under Strawberry Perl. - The 2 test files t/tree.with*.txt ship as ISO-8859-1 while t/tree.utf8.attributes.txt ships as UTF-8. So... - Don't explicitly use UTF-8 encoding in DAG_Node.pm's sub read_tree(). Rather, use a regexp to standardize line endings after reading. Likewise, in t/read.tree.t, do the same. - I have un-commented the 2 extra tests at the end of t/read.tree.t. Specifically, line 50 was 'for (qw/utf8/)# with without/)'. It now says 'for (qw/utf8 with without/)' - Reformat test data files t/tree.*.attributes.txt This was done with the new files share/read.write.tree.(pl, sh). And it was done because some of the test data files had been written by old code with slightly different indenting. - Add a new test data file, t/metag.cooked.tree.txt It's a copy of MarpaX::Grammar::Parser's share/metag.cooked.tree. The test program t/read.tree.t was edited to include this new file. - Patch tree::DAG_Node.format_node() to output 'Attributes: {}' and not just 'Attributes:' when the user does not want attributes reported. This makes the code match the sample trees shipped in t/. 1.33 2025-03-20T11:16:00 - Replace the discouraged File::Slurp::Tiny with File::Slurper. Thanx to Marcel Telka for the report. But why not use File::Slurp? Because... https://blogs.perl.org/users/leon_timmermans/2015/08/fileslurp-is-broken-and-wrong.html - Add a security policy file SECURITY.md - Update Makefile.PL to include both ExtUtils::MakeMaker and perl. 1.32 2021-02-01T15:56:00 - Update Makefile.PL and POD to change RT to github. 1.31 2018-02-14T09:08:00 - Clarify licence issue by changing the reference in the DAG_Node.pm file from Artistic V 2 to Perl, so it now matches what I preemptively put in Makefile.PL and the LICENSE file. Sean Burke has kindly agreed to this change. $thanx x $many to Gregor Herrmann (Debian Perl Group) for reporting this via github. 1.30 2018-01-26T15:32:00 - Explicitly escape { and } in a regexp because unescaped { issues a warning now and will become a fatal error in Perl V 5.32. - Adopt new repo structure. See http://savage.net.au/Ron/html/My.Workflow.for.Building.Distros.html. 1.29 2016-03-01T13:39:00 - After another email exchange with Kent Fredric (via RT) and Karen Etheridge (via the cpan-testers-discuss mailing list), I've edited Makefile.PL, again, to indicate that Test::Pod is needed neither for building nor testing this module, but is only needed for development. Specifically, it's used by xt/author/pod.t, and not elsewhere. See https://metacpan.org/pod/CPAN::Meta::Spec#PREREQUISITES for more details. 1.28 2016-03-01T08:43:00 - No code changes. - Rework Makefile.PL so File::Spec, File::Temp, Test::More and Test::Pod are in TEST_REQUIRES. Many thanx to Kent Fredric in RT#112568 for this suggestion. - Expand the SYNOPSIS. - Update MANIFEST.SKIP to include .gitignore. - Finally add lightweight git tags to distros, so that if you have a Bash alias such as: alias gl='git log --decorate=full' you'll see something like these 5 lines: commit 2501bd9672244fe698c0f3e48e142637e92eb7e5 (HEAD, tag: refs/tags/1.28, refs/heads/master) Author: ronsavage Date: Tue Mar 1 09:16:46 2016 +1100 Update distmeta The command used to generate the tags looks like: git tag -afm 'V 1.28 @ Tue Mar 1 09:16:46 2016' 1.28 1.27 2015-07-12T11:01:00 - Remove the line which reads 'use open qw(:std :utf8);'. As Tom Molesworth says: "Specifically, it turns on the UTF-8 encoding layer on STDIO when any code does 'use Tree::DAG_Node'. That's no good when code is expecting a different encoding (raw, etc.)". See RT#105798. Karen Etheridge followed up with a comment about it appearing in another module of mine. Then I checked all my modules (including some not intended for publication - Local::*) and found about 28 offenders, with some using it in multiple files. The original idea came from adopting what Tom Christiansen calls his 'Standard Preamble': http://www.perl.com/pub/2012/04/perlunicook-standard-preamble.html All tests still work after removing that line. - Remove Build.PL. Ship only Makefile.PL. 1.26 2015-04-12T13:37:00 - Fix bug in string2hashref(), which failed on some strings, such as {a => 'b, c'}. string2hashref() is called by read_tree(). Escaped chars are still not handled. - Add t/string2hash.t to test new code. 1.25 2015-03-22T11:42:00 - I've deleted the undocumented sub _dump_quote(), which butchered Unicode characters when it tried to convert ASCII control characters into printable strings (on the assumption all data is ASCII). Thanx to Dr. Petra Steiner (Germany) for discussion and some testing. I hope no-one was relying on this sub in output redirected to disk files, or otherwise saved for later comparisons. Methods which used to call _dump_quote() now just output the node's name by calling quote_name(), which is discussed next. Undefined names are output as the string 'undef'. - Add method quote_name(), which simply returns its input string surrounded by single-quotes. - Add method decode_lol(). This converts the output of tree_to_lol() and tree_to_simple_lol() into something which is easy to read. See scripts/read.tree.pl for sample usage. - Reorder a couple of methods called tree_*(), so that they are in alphabetical order. - Expand the docs for methods tree_to_*(), re undefined node names. - Add scripts/write.tree.pl, which creates the test input file t/tree.utf8.attributes.txt. Note: This latter file is now much more complex that in previous versions. - Add scripts/read.tree.pl, and it's output file scripts/read.tree.log. This program demonstrates the output produced by various methods. - Fix the faulty syntax I had used in Build.PL to identify the github repo. - Delete and re-create github repo after 'git push' failed to upload the new version. - Add LICENSE file to MANIFEST. 1.24 2015-01-25T14:17:00 - Clean up discussion in docs of original author's reluctance to allow parameters to new(). - Rewrite bareword filehandles (INX) to use a variable (my $fh). - Rename github repo from Tree--DAG_Node to Tree-DAG_Node - My new standard. Update Build.PL and Makefile.PL to match. - Reformat the docs, and this file, slighty, to be <= 100 chars per line - My new standard. - Change horizontal indentation used by node2string() to add 1 space, so '|' lines up underneath the first char of the previous node's name. Use scripts/cut.and.paste.subtrees.pl to see the difference. 1.23 2014-10-20T18:12:00 - Change output format when using node2string(), which is called by tree2string(). Indentation which used to be '|---' is now '|--- '. So, a tree which used to be printed as: |---:default | |---::= | |---action | |---=> | |---[values] Is now printed as: |--- :default | |--- ::= | |--- action | |--- => | |--- [values] This makes the difference between node names ''/'-', '1'/'-1', etc, much clearer. Apologies to anyone who runs tests which compare the output with pre-existing files. 1.22 2014-02-13T13:14:00 - t/read.tree.t was still using File::Slurp :-(. 1.21 2014-02-13T11:14:00 - Switch from File::Slurp to File::Slurp::Tiny, on the advice of Karen Etheridge. See RT#92976. 1.20 2014-01-31T09:46:00 - After a private email from Paul Howarth (yea!) I see I need File::Temp V 0.19 because that's the version which introduced the newdir() method, as used in the test suite. Sorry for the churn. 1.19 2014-01-30T09:24:00 - Set pre-req File::Temp version # to 0 (back from 0.2301). See D A Golden's blog entry: http://www.dagolden.com/index.php/2293/why-installing-distzilla-is-slow-and-what-you-can-do-about-it/. 1.18 2013-09-19T14:24:00 - No changes, code or otherwise, except for the version # in the *.pm, this file, and Changelog.ini. - Somehow a corrupted version got uploaded to search.cpan.org, so I've just changed the version #. The file on MetaCPAN was fine. - Thanx to Rob (Sisyphus) for reporting this. 1.17 2013-09-16T15:24:00 - Write test temp files in :raw mode as well as utf-8, for MS Windows users. - Take the opportunity to change all utf8 to utf-8, as per the docs for Encode, except for 'use warnings qw(FATAL utf8);', which doesn't accept utf-8 :-(. 1.16 Mon Sep 9 09;26:00 2013 - Accept a patch (slightly modified by me) from Tom Molesworth (see RT#88501): Remove 'use open qw(:std :utf8);' because of its global effect. Replace Perl6::Slurp with File::Slurp, using the latter's binmode option for the encoding. Fix docs where I'd erroneously said File::Slurp didn't support utf8. 1.15 2013-09-06T11:10:00 - Replace Path::Tiny with File::Spec, because the former's list of dependencies is soooo long. Changed files: t/read.tree.t, Build.PL and Makefile.PL. See: RT#88435 for an explanation. - Move t/pod.t to xt/author/pod.t. 1.14 2013-09-04T13:44:00 - Document the copy() method. - Patch the copy() method so it respects the {no_attribute_copy => 1} option. - Add method read_tree(), for text files. It uses Perl6::Slurp (which supports utf8). - Add methods read_attributes() and string2hashref($s) for use by read_tree(). - Add t/read.tree.t to test read_tree(). - Add t/tree.utf8.attributes.txt, in utf8, for use by t/read.tree.t. - Add t/tree.with.attributes.txt and t/tree.without.attributes.txt for use by t/read.tree.t. - Make Perl V 5.8.1 a pre-req so we have access to the utf8 pragma. 1.13 2013-08-12T17:16:00 - Change the values accepted for the no_attributes option from undef and 1 to 0 and 1. If undef is used, it becomes 0, so pre-existing code will not change behaviour. This makes it easier to pass 0 or 1 from the command line, since there is no default value available. 1.12 2013-07-03T16:38:00 - Change text in README referring to licence to match text in body of source, since it was in conflict with the Artistic Licence V 2.0. This was requested by Petr Pisar who packages stuff for Red Hat. - Rename CHANGES to Changes as per CPAN::Changes::SPEC. - Various spelling fixes in the docs, as kindly reported by dsteinbrunner. 1.11 2013-02-04T09:50:00 - Correct the date (2012 -> 2013) in this file used for V 1.10. - Correct the text at L so it refers to Artistic License 2.0, which now matches what it says in Build.PL and Makefile.PL. Resolves RT#83088. 1.10 2013-02-01T08:53:00 - Change t/pod.t to look for Test::Pod 1.45, but comment out Test::Pod in Build.PL and Makefile.PL. This means Test::Pod is not used at all if it is not installed. As per RT#83077. 1.09 2012-11-08T12:38:00 - No code changes. - Oops. The changes in V 1.08 we made in the other 10 distros, but not in this one. My apologies. 1.08 2012-11-08T12:38:00 - No code changes. - For pre-reqs such as strict, warnings, etc, which ship with Perl, set the version # to 0. Reported as RT#80663 by Father Chrysostomos for Tree::DAG_Node. 1.07 2012-11-01T12:47:00 - New maintainer: Ron Savage - Pre-emptive apologies for any changes which are not back-compat. No such problems are expected, but the introduction of new methods may disconcert some viewers. - Fix RT#78858, reported by Gene Boggs. Audit code for similar problems. - Fix RT#79506. reported by Ron Savage. - Rename ChangeLog to CHANGES, and add Changelog.ini. - Replace all uses of cyclicity_fault() and Carp::croak with die. - Remove unused methods: decommission_root(), cyclicity_allowed(), cyclicity_fault(), inaugurate_root(), no_cyclicity() and _update_links(). OK - cyclicity_fault() was called once. It just died. - Add methods: format_node(), hashref2string(), is_root(), node2string(), tree2string(). tree2string($opts, $node) - unlike draw_ascii_tree() - can optionally print the tree starting at any node. Override format_node(), hashref2string(), and node2string() if desired. - Reformat the POD big-time. - Add Build.PL. - Re-write Makefile.PL. - Remove use vars(@ISA $Debug $VERSION). Replace latter 2 with 'our ...'. - Rename t/00_about_verbose.t to t/about.perl.t. - Add scripts/cut.and.paste.subtrees.pl. Warning: Some trees get into an infinite loop. - Add t/cut.and.paste.subtrees.t. Warning: Some trees get into an infinite loop. - Document the options (discouraged by Sean) supported in the call to new($hashref). 1.06 1998-12-02T12:00:00 - New maintainer: David Hand. - No code changes. 1.05 1998-12-29T12:00:00 - Just repackaging. - No code changes. 1.04 1998-02-23T12:00:00 - Bugfix: Olegt@dreamtime.net notes a bug in depth_under that apparently always makes it return 0. 1.03 1998-05-13T12:00:00 - Superficial changes: Minor doc spiffing-up. Noting my new email address. - In order to keep its symbol table clean, DAG_Node no longer imports routines from Carp and UNIVERSAL. Should have no effect on existing code. - I went and commented out all the places where I have asserts for non-cyclicity. I once had the idea that DAG_Node could be a base class for graphs that /could/ allow cyclicity, or something like that, so those assertions would apply for methods that work only for acyclic networks. But, in time, I realized that almost everything in DAG_Node would have to have such assertions. Moral of the story: DAG_Node has nearly no code that it could share with a class for anything but DAGs. And since DAG_Node does everything it can to /keep/ you from making cyclicities, there's no point in constantly having assertions of noncyclicity (especially when these assertions are rather expensive to check). 1.02 Sun Mar 05 12:00:00 1998 - Minor bugfixes: Fixed a typo in the docs: corrected one "right_sisters" to "right_sister" Initialized a variable to '' to avoid warnings under -w. Thanks to Gilles Lamiral. 1.01 1998-05-14T12:00:00 - Major additions: Scads of new methods. Still (as far as I know) backward compatible with all previous versions. Some minor changes in coding, not affecting the interface. - Hopefully more friendly to users that use -w (warnings). - Cautionary tale: I started making big changes to this right around mid-November 1998. But I kept thinking "oh, ONE MORE change and then I'll release it." Famous last words! Other things came up, I forgot what was new and what was different in this module (which is why you don't see a detailed list of differences here), altho apparently somehow I managed to document all the new methods. 0.75 1998-11-03T12:00:00 - Minor changes: New methods new_daughter, new_daughter_left. $obj->new constructor syntax now documented. Internal accesses to "daughter" and "mother" attribs are now direct, for efficiency's sake. - Minor improvements to the docs. 0.74 1998-10-28T12:00:00 - Whoops, forgot to bundle the README. - No change in the code. 0.73 1998-10-27T12:00:00 - First release.Tree-DAG_Node-1.35/scripts/0000755000175000017500000000000015010317500013534 5ustar ronronTree-DAG_Node-1.35/scripts/read.tree.pl0000644000175000017500000000263415002347073015760 0ustar ronron#!/usr/bin/env perl use strict; use warnings; use warnings qw(FATAL utf8); # Fatalize encoding glitches. use File::Spec; use Tree::DAG_Node; # ------------------------------------------------ my($node) = Tree::DAG_Node -> new; my($input_file_name) = File::Spec -> catfile('t', "tree.utf8.attributes.txt"); my($root) = $node -> read_tree($input_file_name); print "Output from draw_ascii_tree: \n"; print join("\n", @{$root -> draw_ascii_tree}), "\n"; print "\n"; print "Output from tree2string(): \n"; print join("\n", @{$root -> tree2string}), "\n"; print "\n"; print "Output from decode_lol(tree_to_lol): \n"; print join("\n", @{$root -> decode_lol($root -> tree_to_lol)}), "\n"; print "\n"; print "Output from tree_to_lol_notation({multiline => 0}): \n"; print $root -> tree_to_lol_notation({multiline => 0}), "\n"; print "\n"; print "Output from tree_to_lol_notation({multiline => 1}): \n"; print $root -> tree_to_lol_notation({multiline => 1}), "\n"; print "\n"; print "Output from decode_lol(tree_to_simple_lol): \n"; print join("\n", @{$root -> decode_lol($root -> tree_to_simple_lol)}), "\n"; print "\n"; print "Output from tree_to_simple_lol_notation({multiline => 0}): \n"; print $root -> tree_to_simple_lol_notation({multiline => 0}), "\n"; print "\n"; print "Output from tree_to_simple_lol_notation({multiline => 1}): \n"; print $root -> tree_to_simple_lol_notation({multiline => 1}); print "\n"; Tree-DAG_Node-1.35/scripts/cut.and.paste.subtrees.pl0000644000175000017500000000755014106404517020414 0ustar ronron#!/usr/bin/env perl use strict; use warnings; use Tree::DAG_Node; my($starting_node); # ----------------------------------------------- sub grow_tree { my($count) = 0; my($tree) = Tree::DAG_Node -> new({name => 'Root', attributes => {'#' => $count} }); my(%child) = ( I => 'J', H => 'J', J => 'L', L => 'M', D => 'F', E => 'F', F => 'G', B => 'C', ); my($child); my($kid_1, $kid_2); my($name, $node); for $name (qw/I H J J L D E F B/) { $count++; $node = Tree::DAG_Node -> new({name => $name, attributes => {'#' => $count} }); $child = Tree::DAG_Node -> new({name => $child{$name}, attributes => {'#' => $count} }); $starting_node = $node if ($name eq 'H'); $child -> name('K') if ($count == 3); if ($child{$name} eq 'M') { $kid_1 = Tree::DAG_Node -> new({name => 'N', attributes => {'#' => $count}}); $kid_2 = Tree::DAG_Node -> new({name => 'O', attributes => {'#' => $count}}); $kid_1 -> add_daughter($kid_2); $child -> add_daughter($kid_1); } $node -> add_daughter($child); $tree -> add_daughter($node); } return $tree; } # End of grow_tree. # ----------------------------------------------- sub process_tree_helper { my($tree) = @_; my(@ancestors) = map{$_ -> name} $tree -> daughters; my(%ancestors); @ancestors{@ancestors} = (1) x @ancestors; my($attributes); my($name); my(@stack); $tree -> walk_down ({ ancestors => \%ancestors, callback => sub { my($node, $options) = @_; if ($$options{_depth} > 1) { $attributes = $node -> attributes; $name = $node -> name; if (defined $$options{ancestors}{$name} && ! $$attributes{replaced}) { push @{$$options{stack} }, $node; } } return 1; }, _depth => 0, stack => \@stack, }); my($sub_tree) = Tree::DAG_Node -> new; my(@kids); my($node); my(%seen); for $node (@stack) { $name = $node -> name; @kids = grep{$_ -> name eq $name} $tree -> daughters; $seen{$name} = 1; $sub_tree -> add_daughters(map{$_ -> copy_at_and_under({no_attribute_copy => 1})} @kids); for ($sub_tree -> daughters) { $_ -> attributes({%{$_ -> attributes}, replaced => 1}); } $node -> replace_with($sub_tree -> daughters); } return ({%seen}, $#stack); } # End of process_tree_helper. # ------------------------------------------------ sub process_tree { my($tree) = @_; my($finished) = 0; my(@result); my(%seen); while (! $finished) { @result = process_tree_helper($tree); $seen{$_} = 1 for keys %{$result[0]}; $finished = $result[1] < 0; } for my $child ($tree -> daughters) { $tree -> remove_daughter($child) if ($seen{$child -> name}); } } # End of process_tree. # ----------------------------------------------- my($tree) = grow_tree; my(@ascii_1) = @{$tree -> draw_ascii_tree}; my(@string_1) = @{$tree -> tree2string}; my(@string_2) = @{$tree -> tree2string({no_attributes => 1})}; my(@string_3) = @{$tree -> tree2string({}, $starting_node)}; process_tree($tree); print "1: draw_ascii_tree(): Before: \n"; print map{"$_\n"} @ascii_1; print "2: draw_ascii_tree(): After: \n"; print map{"$_\n"} @{$tree -> draw_ascii_tree}; print '-' x 35, "\n"; print "3: tree2string(): Before: \n"; print map{"$_\n"} @string_1; print "4: tree2string(): After: \n"; print map{"$_\n"} @{$tree -> tree2string}; print '-' x 35, "\n"; print "5: tree2string({no_attributes => 1}): Before: \n"; print map{"$_\n"} @string_2; print "6: tree2string({no_attributes => 1}): After: \n"; print map{"$_\n"} @{$tree -> tree2string({no_attributes => 1})}; print '-' x 35, "\n"; print "5: tree2string({}, \$starting_node) before: \n"; print map{"$_\n"} @string_3; print "6: tree2string({}, \$starting_node) after: \n"; print map{"$_\n"} @{$tree -> tree2string({}, $starting_node)}; print '-' x 35, "\n"; print "Warning: Don't try this at home kids. Some trees get into an infinite loop.\n"; Tree-DAG_Node-1.35/scripts/read.write.tree.pl0000755000175000017500000000256615003111416017107 0ustar ronron#!/usr/bin/env perl # # Name: read.write.tree.pl. # # Called by read.write.tree.sh. # # Reads a tree created by Tree::DAG_Node.tree2string() # and somehow written to a disk file. use 5.40.0; use strict; use warnings; use warnings qw(FATAL utf8); # Fatalize encoding glitches. use Data::Dumper; # For Dumper(). use File::Spec; use Getopt::Long; use Tree::DAG_Node; # ------------------------------------------------ my(%options); $options{dir_name} = ''; $options{in_file_name} = ''; $options{help} = 0; $options{log_level} = 'info'; my(%opts) = ( 'dir_name=s' => \$options{dir_name}, 'in_file_name=s' => \$options{in_file_name}, 'help' => \$options{help}, 'log_level=s' => \$options{log_level}, ); GetOptions(%opts) || die("Error in options. Options: " . Dumper(%opts) ); if ($options{help} == 1) { pod2usage(1); } my($input_file_name) = File::Spec -> catfile($options{dir_name}, $options{in_file_name}); my($output_file_name) = File::Spec -> catfile($options{dir_name}, $options{in_file_name} . '.new'); say "Reading: $input_file_name"; my($node) = Tree::DAG_Node -> new; my($root) = $node -> read_tree($input_file_name); my($no_attr) = 0; say "Writing: $output_file_name"; open(my $fh, '> :encoding(utf-8)', $output_file_name); print $fh "$_\n" for @{$root -> tree2string({no_attributes => $no_attr})}; close $fh; say "Wrote: $output_file_name"; Tree-DAG_Node-1.35/scripts/read.tree.log0000644000175000017500000000706014106404517016125 0ustar ronronOutput from draw_ascii_tree: | /-----------------------\ | | <Â> <ß> /---+-----\ /---+---+---+---------\ | | | | | | | | <â> <ä> <é> <®> <£> <€> <√> <×xX> | | | /---+---+---\ <É> <Ñ> <©> | | | | | <í> <ú> <«> <»> <ñ> | <Ô> /---\ | | <ô> <ô> Output from tree2string(): Root. Attributes: {} |--- Â. Attributes: {# => "ÂÂ"} | |--- â. Attributes: {# => "ââ"} | | |--- É. Attributes: {# => "ÉÉ"} | |--- ä. Attributes: {# => "ää"} | |--- é. Attributes: {# => "éé"} | |--- Ñ. Attributes: {# => "ÑÑ"} | |--- ñ. Attributes: {# => "ññ"} | |--- Ô. Attributes: {# => "ÔÔ"} | |--- ô. Attributes: {# => "ôô"} | |--- ô. Attributes: {# => "ôô"} |--- ß. Attributes: {# => "ßß"} |--- ®. Attributes: {# => "®®"} | |--- ©. Attributes: {# => "©©"} |--- £. Attributes: {# => "££"} |--- €. Attributes: {# => "€€"} |--- √. Attributes: {# => "√√"} |--- ×xX. Attributes: {# => "×xX×xX"} |--- í. Attributes: {# => "íí"} |--- ú. Attributes: {# => "úú"} |--- «. Attributes: {# => "««"} |--- ». Attributes: {# => "»»"} Output from decode_lol(tree_to_lol): 'É' 'â' 'ä' 'ô' 'ô' 'Ô' 'ñ' 'Ñ' 'é' 'Â' '©' '®' '£' '€' '√' 'í' 'ú' '«' '»' '×xX' 'ß' 'Root' Output from tree_to_lol_notation({multiline => 0}): [[[['É'],'â'],['ä'],[[[[['ô'],['ô'],'Ô'],'ñ'],'Ñ'],'é'],'Â'],[[['©'],'®'],['£'],['€'],['√'],[['í'],['ú'],['«'],['»'],'×xX'],'ß'],'Root'], Output from tree_to_lol_notation({multiline => 1}): [ [ [ [ 'É' ], 'â' ], [ 'ä' ], [ [ [ [ [ 'ô' ], [ 'ô' ], 'Ô' ], 'ñ' ], 'Ñ' ], 'é' ], 'Â' ], [ [ [ '©' ], '®' ], [ '£' ], [ '€' ], [ '√' ], [ [ 'í' ], [ 'ú' ], [ '«' ], [ '»' ], '×xX' ], 'ß' ], 'Root' ], Output from decode_lol(tree_to_simple_lol): 'É' 'ä' 'ô' 'ô' '©' '£' '€' '√' 'í' 'ú' '«' '»' Output from tree_to_simple_lol_notation({multiline => 0}): [[['É',], 'ä',[[[['ô','ô',], ], ], ], ], [['©',], '£','€','√',['í','ú','«','»',], ], ], Output from tree_to_simple_lol_notation({multiline => 1}): [ [ [ 'É', ], 'ä', [ [ [ [ 'ô', 'ô', ], ], ], ], ], [ [ '©', ], '£', '€', '√', [ 'í', 'ú', '«', '»', ], ], ], Tree-DAG_Node-1.35/scripts/read.write.tree.sh0000755000175000017500000000047515002576464017124 0ustar ronron#!/usr/bin/bash # # Name: read.write.tree.sh. # # Parameters: # 1: The abbreviated name of sample input and output data files. # E.g. xyz simultaneously means read some_dir/xyz.tree and write some_dir/xyz.tree.out. # 2 .. 5: Use for anything. E.g.: -maxlevel debug. perl -Ilib scripts/read.write.tree.pl $1 $2 $3 $4 Tree-DAG_Node-1.35/scripts/write.tree.pl0000644000175000017500000000275515002364215016200 0ustar ronron#!/usr/bin/env perl use strict; use warnings; use warnings qw(FATAL utf8); # Fatalize encoding glitches. use utf8; use File::Slurper 'write_text'; use File::Spec; use Tree::DAG_Node; # ------------------------------------------------ sub add_child { my($parent, $name) = @_; my($daughter) = Tree::DAG_Node -> new({name => $name, attributes => {'#' => "$name$name"} }); $parent -> add_daughter($daughter); return $daughter; } # End of add_child. # ------------------------------------------------ my($root) = Tree::DAG_Node -> new({name => 'Root'}); my($parent) = add_child($root, 'Â'); my($daughter_1) = add_child($parent, 'â'); add_child($parent, 'ä'); my($daughter_2) = add_child($parent, 'é'); add_child($daughter_1, 'É'); my($daughter_3) = add_child($daughter_2, 'Ñ'); my($daughter_4) = add_child($daughter_3, 'ñ'); my($daughter_5) = add_child($daughter_4, 'Ô'); add_child($daughter_5, 'ô'); add_child($daughter_5, 'ô'); $daughter_1 = add_child($root, 'ß'); $daughter_2 = add_child($daughter_1, '®'); add_child($daughter_2, '©'); $daughter_3 = add_child($daughter_1, '£'); add_child($daughter_1, '€'); add_child($daughter_1, '√'); $daughter_4 = add_child($daughter_1, '×xX'); add_child($daughter_4, 'í'); add_child($daughter_4, 'ú'); add_child($daughter_4, '«'); add_child($daughter_4, '»'); my($output_file_name) = File::Spec -> catfile('t', "tree.utf8.attributes.txt"); write_text($output_file_name, join("\n", @{$root -> tree2string}) . "\n"); Tree-DAG_Node-1.35/MANIFEST0000644000175000017500000000136115010317500013177 0ustar ronronChangelog.ini Changes lib/Tree/DAG_Node.pm LICENSE Makefile.PL MANIFEST This list of files MANIFEST.SKIP README scripts/cut.and.paste.subtrees.pl scripts/read.tree.log scripts/read.tree.pl scripts/read.write.tree.pl scripts/read.write.tree.sh scripts/write.tree.pl SECURITY.md share/metag.bnf share/metag.cooked.tree share/metag.cooked.tree.new t/00.versions.t t/00.versions.tx t/about.perl.t t/cut.and.paste.subtrees.t t/load.t t/metag.cooked.tree.txt t/read.tree.t t/string2hash.t t/tree.utf8.attributes.txt t/tree.with.attributes.txt t/tree.without.attributes.txt xt/author/pod.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Tree-DAG_Node-1.35/MANIFEST.SKIP0000644000175000017500000000114214106404517013753 0ustar ronron# Avoid version control files. ,v$ \B\.cvsignore$ \B\.git\b \B\.gitignore\b \B\.svn\b \bCVS\b \bRCS\b # Avoid Makemaker generated and utility files. \bblib \bblibdirs$ \bpm_to_blib$ \bMakefile$ \bMakeMaker-\d # Avoid Module::Build generated and utility files. \b_build \bBuild$ \bBuild.bat$ # Avoid Devel::Cover generated files \bcover_db # Avoid temp and backup files. ~$ \#$ \.# \.bak$ \.old$ \.rej$ \.tmp$ # Avoid OS-specific files/dirs # Mac OSX metadata \B\.DS_Store # Mac OSX SMB mount metadata files \B\._ # Avoid UltraEdit files. \.prj$ \.pui$ ^MYMETA.yml$ ^MYMETA\.json$ ^Tree-DAG_Node-.* Tree-DAG_Node-1.35/xt/0000755000175000017500000000000015010317500012500 5ustar ronronTree-DAG_Node-1.35/xt/author/0000755000175000017500000000000015010317500014002 5ustar ronronTree-DAG_Node-1.35/xt/author/pod.t0000644000175000017500000000020414106404517014757 0ustar ronronuse Test::More; eval "use Test::Pod 1.45"; plan skip_all => "Test::Pod 1.45 required for testing POD" if $@; all_pod_files_ok(); Tree-DAG_Node-1.35/README0000644000175000017500000000253314106404517012742 0ustar ronronREADME file for Tree::DAG_Node. See also: CHANGES and Changelog.ini. Warning: WinZip 8.1 and 9.0 both contain an 'accidental' bug which stops them recognizing POSIX-style directory structures in valid tar files. You are better off using a reliable tool such as InfoZip: ftp://ftp.info-zip.org/pub/infozip/ 1 Installing from a Unix-like distro ------------------------------------ shell>gunzip Tree-DAG_Node-1.18.tgz shell>tar mxvf Tree-DAG_Node-1.18.tar On Unix-like systems, assuming you have installed Module::Build V 0.25+: shell>perl Build.PL shell>./Build shell>./Build test shell>./Build install On MS Windows-like systems, assuming you have installed Module::Build V 0.25+: shell>perl Build.PL shell>perl Build shell>perl Build test shell>perl Build install Alternately, without Module::Build, you do this: Note: 'make' on MS Windows-like systems may be called 'nmake' or 'dmake'. shell>perl Makefile.PL shell>make shell>make test shell>su (for Unix-like systems) shell>make install shell>exit (for Unix-like systems) On all systems: Run DAG_Node.pm through your favourite pod2html translator. 2 Installing from an ActiveState distro --------------------------------------- shell>unzip Tree-DAG_Node-1.18.zip shell>ppm install --location=. Tree-DAG_Node shell>del Tree-DAG_Node-1.18.ppd shell>del PPM-Tree-DAG_Node-1.18.tar.gz Tree-DAG_Node-1.35/t/0000755000175000017500000000000015010317500012310 5ustar ronronTree-DAG_Node-1.35/t/string2hash.t0000644000175000017500000000152514106404517014746 0ustar ronronuse strict; use warnings; use Test::More; # ------------- BEGIN{ use_ok('Tree::DAG_Node'); } my($count) = 1; # Counting the use_ok above. my($s) = q|a => 'b=>b', c => "d=>d", 'e' => "f", 'g=>g' => "h", "i" => "j", 'k, k' => "l, l"|; my($finished) = 0; my($reg_exp) = qr/ ([\"'])([^"']*?)\1\s*=>\s*(["'])([^"']*?)\3,?\s* | (["'])([^"']*?)\5\s*=>\s*(.*?),?\s* | (.*?)\s*=>\s*(["'])([^"']*?)\9,?\s* | (.*?)\s*=>\s*(.*?),?\s* /sx; my(@got); while (! $finished) { if ($s =~ /$reg_exp/gc) { push @got, defined($2) ? ($2, $4) : defined($6) ? ($6, $7) : defined($8) ? ($8, $10) : ($11, $12); } else { $finished = 1; } } my(@expected) = ('a', 'b=>b', 'c', 'd=>d', 'e', 'f', 'g=>g', 'h', 'i', 'j', 'k, k', 'l, l'); for my $i (0 .. $#got) { ok($got[$i] eq $expected[$i], "Matched $got[$i]"); $count++; } done_testing($count); Tree-DAG_Node-1.35/t/cut.and.paste.subtrees.t0000644000175000017500000001436714106404517017024 0ustar ronronuse strict; use warnings; use Test::More; use Tree::DAG_Node; my($starting_node); # ----------------------------------------------- sub grow_tree { my($count) = 0; my($tree) = Tree::DAG_Node -> new({name => 'Root', attributes => {'#' => $count} }); my(%child) = ( I => 'J', H => 'J', J => 'L', L => 'M', D => 'F', E => 'F', F => 'G', B => 'C', ); my($child); my($kid_1, $kid_2); my($name, $node); for $name (qw/I H J J L D E F B/) { $count++; $node = Tree::DAG_Node -> new({name => $name, attributes => {'#' => $count} }); $child = Tree::DAG_Node -> new({name => $child{$name}, attributes => {'#' => $count} }); $starting_node = $node if ($name eq 'H'); $child -> name('K') if ($count == 3); if ($child{$name} eq 'M') { $kid_1 = Tree::DAG_Node -> new({name => 'N', attributes => {'#' => $count}}); $kid_2 = Tree::DAG_Node -> new({name => 'O', attributes => {'#' => $count}}); $kid_1 -> add_daughter($kid_2); $child -> add_daughter($kid_1); } $node -> add_daughter($child); $tree -> add_daughter($node); } return $tree; } # End of grow_tree. # ----------------------------------------------- sub process_tree_helper { my($tree) = @_; my(@ancestors) = map{$_ -> name} $tree -> daughters; my(%ancestors); @ancestors{@ancestors} = (1) x @ancestors; my($attributes); my($name); my(@stack); $tree -> walk_down ({ ancestors => \%ancestors, callback => sub { my($node, $options) = @_; if ($$options{_depth} > 1) { $attributes = $node -> attributes; $name = $node -> name; if (defined $$options{ancestors}{$name} && ! $$attributes{replaced}) { push @{$$options{stack} }, $node; } } return 1; }, _depth => 0, stack => \@stack, }); my($sub_tree) = Tree::DAG_Node -> new; my(@kids); my($node); my(%seen); for $node (@stack) { $name = $node -> name; @kids = grep{$_ -> name eq $name} $tree -> daughters; $seen{$name} = 1; $sub_tree -> add_daughters(map{$_ -> copy_at_and_under({no_attribute_copy => 1})} @kids); for ($sub_tree -> daughters) { $_ -> attributes({%{$_ -> attributes}, replaced => 1}); } $node -> replace_with($sub_tree -> daughters); } return ({%seen}, $#stack); } # End of process_tree_helper. # ------------------------------------------------ sub process_tree { my($tree) = @_; my($finished) = 0; my(@result); my(%seen); while (! $finished) { @result = process_tree_helper($tree); $seen{$_} = 1 for keys %{$result[0]}; $finished = $result[1] < 0; } for my $child ($tree -> daughters) { $tree -> remove_daughter($child) if ($seen{$child -> name}); } } # End of process_tree. # ----------------------------------------------- my($count) = 0; my($tree) = grow_tree; ok(1 == 1, '1: Grow tree'); $count++; my($drawing_1) = join('', map{s/\s+$//; "$_\n"} @{$tree -> draw_ascii_tree}); my($expected_1) = <<'EOS'; | /---+---+---+---+---+---+---+---\ | | | | | | | | | | | | | | | | | | | | EOS ok($drawing_1 eq $expected_1, '2: draw_ascii_tree() before cut-and-paste returned expected string'); $count++; my($drawing_2) = join('', map{s/\s+$//; "$_\n"} @{$tree -> tree2string}); my($expected_2) = <<'EOS'; Root. Attributes: {# => "0"} |--- I. Attributes: {# => "1"} | |--- J. Attributes: {# => "1"} |--- H. Attributes: {# => "2"} | |--- J. Attributes: {# => "2"} |--- J. Attributes: {# => "3"} | |--- K. Attributes: {# => "3"} |--- J. Attributes: {# => "4"} | |--- L. Attributes: {# => "4"} |--- L. Attributes: {# => "5"} | |--- M. Attributes: {# => "5"} | |--- N. Attributes: {# => "5"} | |--- O. Attributes: {# => "5"} |--- D. Attributes: {# => "6"} | |--- F. Attributes: {# => "6"} |--- E. Attributes: {# => "7"} | |--- F. Attributes: {# => "7"} |--- F. Attributes: {# => "8"} | |--- G. Attributes: {# => "8"} |--- B. Attributes: {# => "9"} |--- C. Attributes: {# => "9"} EOS ok($drawing_2 eq $expected_2, '3: tree2string() before cut-and-paste returned expected string'); $count++; process_tree($tree); ok(1 == 1, '4: Process tree'); $count++; my($drawing_3) = join('', map{s/\s+$//; "$_\n"} @{$tree -> draw_ascii_tree}); my($expected_3) = <<'EOS'; | /-------+-----+---+---\ | | | | | /---\ /---\ | | | | | | | | | | | | | | | | | | | EOS ok($drawing_3 eq $expected_3, '5: draw_ascii_tree() after cut-and-paste returned expected string'); $count++; my($drawing_4) = join('', map{s/\s+$//; "$_\n"} @{$tree -> tree2string}); my($expected_4) = <<'EOS'; Root. Attributes: {# => "0"} |--- I. Attributes: {# => "1"} | |--- J. Attributes: {replaced => "1"} | | |--- K. Attributes: {} | |--- J. Attributes: {replaced => "1"} | |--- L. Attributes: {replaced => "1"} | |--- M. Attributes: {} | |--- N. Attributes: {} | |--- O. Attributes: {} |--- H. Attributes: {# => "2"} | |--- J. Attributes: {replaced => "1"} | | |--- K. Attributes: {} | |--- J. Attributes: {replaced => "1"} | |--- L. Attributes: {replaced => "1"} | |--- M. Attributes: {} | |--- N. Attributes: {} | |--- O. Attributes: {} |--- D. Attributes: {# => "6"} | |--- F. Attributes: {replaced => "1"} | |--- G. Attributes: {} |--- E. Attributes: {# => "7"} | |--- F. Attributes: {replaced => "1"} | |--- G. Attributes: {} |--- B. Attributes: {# => "9"} |--- C. Attributes: {# => "9"} EOS ok($drawing_4 eq $expected_4, '6: tree2string() after cut-and-paste returned expected string'); $count++; done_testing($count); diag "Warning: Don't try this at home kids. Some trees get into an infinite loop."; Tree-DAG_Node-1.35/t/tree.without.attributes.txt0000644000175000017500000001164615002623136017715 0ustar ronronstatements. Attributes: {} |--- :default. Attributes: {} | |--- ::=. Attributes: {} | |--- action. Attributes: {} | |--- =>. Attributes: {} | |--- [values]. Attributes: {} |--- :start. Attributes: {} | |--- ::=. Attributes: {} | |--- graph_grammar. Attributes: {} |--- graph_grammar. Attributes: {} | |--- ::=. Attributes: {} | |--- graph_definition. Attributes: {} | |--- action. Attributes: {} | |--- =>. Attributes: {} | |--- graph. Attributes: {} |--- graph_definition. Attributes: {} | |--- ::=. Attributes: {} | |--- node_definition. Attributes: {} | |--- |. Attributes: {} | |--- edge_definition. Attributes: {} |--- node_definition. Attributes: {} | |--- ::=. Attributes: {} | |--- node_statement. Attributes: {} | |--- |. Attributes: {} | |--- node_statement. Attributes: {} | |--- graph_definition. Attributes: {} |--- node_statement. Attributes: {} | |--- ::=. Attributes: {} | |--- node_name. Attributes: {} | |--- |. Attributes: {} | |--- node_name. Attributes: {} | |--- attribute_definition. Attributes: {} | |--- |. Attributes: {} | |--- node_statement. Attributes: {} | |--- (','). Attributes: {} | |--- node_statement. Attributes: {} |--- node_name. Attributes: {} | |--- ::=. Attributes: {} | |--- start_node. Attributes: {} | |--- end_node. Attributes: {} |--- :lexeme. Attributes: {} | |--- ~. Attributes: {} | |--- start_node. Attributes: {} | |--- pause. Attributes: {} | |--- =>. Attributes: {} | |--- before. Attributes: {} | |--- event. Attributes: {} | |--- =>. Attributes: {} | |--- start_node. Attributes: {} |--- start_node. Attributes: {} | |--- ~. Attributes: {} | |--- '['. Attributes: {} |--- :lexeme. Attributes: {} | |--- ~. Attributes: {} | |--- end_node. Attributes: {} |--- end_node. Attributes: {} | |--- ~. Attributes: {} | |--- ']'. Attributes: {} |--- edge_definition. Attributes: {} | |--- ::=. Attributes: {} | |--- edge_statement. Attributes: {} | |--- |. Attributes: {} | |--- edge_statement. Attributes: {} | |--- graph_definition. Attributes: {} |--- edge_statement. Attributes: {} | |--- ::=. Attributes: {} | |--- edge_name. Attributes: {} | |--- |. Attributes: {} | |--- edge_name. Attributes: {} | |--- attribute_definition. Attributes: {} | |--- |. Attributes: {} | |--- edge_statement. Attributes: {} | |--- (','). Attributes: {} | |--- edge_statement. Attributes: {} |--- edge_name. Attributes: {} | |--- ::=. Attributes: {} | |--- directed_edge. Attributes: {} | |--- |. Attributes: {} | |--- undirected_edge. Attributes: {} |--- :lexeme. Attributes: {} | |--- ~. Attributes: {} | |--- directed_edge. Attributes: {} | |--- pause. Attributes: {} | |--- =>. Attributes: {} | |--- before. Attributes: {} | |--- event. Attributes: {} | |--- =>. Attributes: {} | |--- directed_edge. Attributes: {} |--- directed_edge. Attributes: {} | |--- ~. Attributes: {} | |--- '->'. Attributes: {} |--- :lexeme. Attributes: {} | |--- ~. Attributes: {} | |--- undirected_edge. Attributes: {} | |--- pause. Attributes: {} | |--- =>. Attributes: {} | |--- before. Attributes: {} | |--- event. Attributes: {} | |--- =>. Attributes: {} | |--- undirected_edge. Attributes: {} |--- undirected_edge. Attributes: {} | |--- ~. Attributes: {} | |--- '--'. Attributes: {} |--- attribute_definition. Attributes: {} | |--- ::=. Attributes: {} | |--- attribute_statement. Attributes: {} |--- attribute_statement. Attributes: {} | |--- ::=. Attributes: {} | |--- start_attributes. Attributes: {} | |--- end_attributes. Attributes: {} |--- :lexeme. Attributes: {} | |--- ~. Attributes: {} | |--- start_attributes. Attributes: {} | |--- pause. Attributes: {} | |--- =>. Attributes: {} | |--- before. Attributes: {} | |--- event. Attributes: {} | |--- =>. Attributes: {} | |--- start_attributes. Attributes: {} |--- start_attributes. Attributes: {} | |--- ~. Attributes: {} | |--- '{'. Attributes: {} |--- :lexeme. Attributes: {} | |--- ~. Attributes: {} | |--- end_attributes. Attributes: {} |--- end_attributes. Attributes: {} | |--- ~. Attributes: {} | |--- '}'. Attributes: {} |--- :discard. Attributes: {} | |--- =>. Attributes: {} | |--- whitespace. Attributes: {} |--- whitespace. Attributes: {} |--- ~. Attributes: {} |--- [\s]. Attributes: {} Tree-DAG_Node-1.35/t/tree.with.attributes.txt0000644000175000017500000003222415002623027017157 0ustar ronronstatements. Attributes: {} |--- :default. Attributes: {bracketed_name => "0", quantifier => "", real_name => ":default"} | |--- ::=. Attributes: {bracketed_name => "0", quantifier => "", real_name => "::="} | |--- action. Attributes: {bracketed_name => "0", quantifier => "", real_name => "action"} | |--- =>. Attributes: {bracketed_name => "0", quantifier => "", real_name => "=>"} | |--- [values]. Attributes: {bracketed_name => "0", quantifier => "", real_name => "[values]"} |--- :start. Attributes: {bracketed_name => "0", quantifier => "", real_name => ":start"} | |--- ::=. Attributes: {bracketed_name => "0", quantifier => "", real_name => "::="} | |--- graph_grammar. Attributes: {bracketed_name => "0", quantifier => "", real_name => "graph_grammar"} |--- graph_grammar. Attributes: {bracketed_name => "0", quantifier => "", real_name => "graph_grammar"} | |--- ::=. Attributes: {bracketed_name => "0", quantifier => "", real_name => "::="} | |--- graph_definition. Attributes: {bracketed_name => "0", quantifier => "", real_name => "graph_definition"} | |--- action. Attributes: {bracketed_name => "0", quantifier => "", real_name => "action"} | |--- =>. Attributes: {bracketed_name => "0", quantifier => "", real_name => "=>"} | |--- graph. Attributes: {bracketed_name => "0", quantifier => "", real_name => "graph"} |--- graph_definition. Attributes: {bracketed_name => "0", quantifier => "", real_name => "graph_definition"} | |--- ::=. Attributes: {bracketed_name => "0", quantifier => "", real_name => "::="} | |--- node_definition. Attributes: {bracketed_name => "0", quantifier => "", real_name => "node_definition"} | |--- |. Attributes: {bracketed_name => "0", quantifier => "", real_name => "|"} | |--- edge_definition. Attributes: {bracketed_name => "0", quantifier => "", real_name => "edge_definition"} |--- node_definition. Attributes: {bracketed_name => "0", quantifier => "", real_name => "node_definition"} | |--- ::=. Attributes: {bracketed_name => "0", quantifier => "", real_name => "::="} | |--- node_statement. Attributes: {bracketed_name => "0", quantifier => "", real_name => "node_statement"} | |--- |. Attributes: {bracketed_name => "0", quantifier => "", real_name => "|"} | |--- node_statement. Attributes: {bracketed_name => "0", quantifier => "", real_name => "node_statement"} | |--- graph_definition. Attributes: {bracketed_name => "0", quantifier => "", real_name => "graph_definition"} |--- node_statement. Attributes: {bracketed_name => "0", quantifier => "", real_name => "node_statement"} | |--- ::=. Attributes: {bracketed_name => "0", quantifier => "", real_name => "::="} | |--- node_name. Attributes: {bracketed_name => "0", quantifier => "", real_name => "node_name"} | |--- |. Attributes: {bracketed_name => "0", quantifier => "", real_name => "|"} | |--- node_name. Attributes: {bracketed_name => "0", quantifier => "", real_name => "node_name"} | |--- attribute_definition. Attributes: {bracketed_name => "0", quantifier => "", real_name => "attribute_definition"} | |--- |. Attributes: {bracketed_name => "0", quantifier => "", real_name => "|"} | |--- node_statement. Attributes: {bracketed_name => "0", quantifier => "", real_name => "node_statement"} | |--- (','). Attributes: {bracketed_name => "0", quantifier => "", real_name => ""} | |--- node_statement. Attributes: {bracketed_name => "0", quantifier => "", real_name => "node_statement"} |--- node_name. Attributes: {bracketed_name => "0", quantifier => "", real_name => "node_name"} | |--- ::=. Attributes: {bracketed_name => "0", quantifier => "", real_name => "::="} | |--- start_node. Attributes: {bracketed_name => "0", quantifier => "", real_name => "start_node"} | |--- end_node. Attributes: {bracketed_name => "0", quantifier => "", real_name => "end_node"} |--- :lexeme. Attributes: {bracketed_name => "0", quantifier => "", real_name => ":lexeme"} | |--- ~. Attributes: {bracketed_name => "0", quantifier => "", real_name => "~"} | |--- start_node. Attributes: {bracketed_name => "0", quantifier => "", real_name => "start_node"} | |--- pause. Attributes: {bracketed_name => "0", quantifier => "", real_name => "pause"} | |--- =>. Attributes: {bracketed_name => "0", quantifier => "", real_name => "=>"} | |--- before. Attributes: {bracketed_name => "0", quantifier => "", real_name => "before"} | |--- event. Attributes: {bracketed_name => "0", quantifier => "", real_name => "event"} | |--- =>. Attributes: {bracketed_name => "0", quantifier => "", real_name => "=>"} | |--- start_node. Attributes: {bracketed_name => "0", quantifier => "", real_name => "start_node"} |--- start_node. Attributes: {bracketed_name => "0", quantifier => "", real_name => "start_node"} | |--- ~. Attributes: {bracketed_name => "0", quantifier => "", real_name => "~"} | |--- '['. Attributes: {bracketed_name => "0", quantifier => "", real_name => ""} |--- :lexeme. Attributes: {bracketed_name => "0", quantifier => "", real_name => ":lexeme"} | |--- ~. Attributes: {bracketed_name => "0", quantifier => "", real_name => "~"} | |--- end_node. Attributes: {bracketed_name => "0", quantifier => "", real_name => "end_node"} |--- end_node. Attributes: {bracketed_name => "0", quantifier => "", real_name => "end_node"} | |--- ~. Attributes: {bracketed_name => "0", quantifier => "", real_name => "~"} | |--- ']'. Attributes: {bracketed_name => "0", quantifier => "", real_name => ""} |--- edge_definition. Attributes: {bracketed_name => "0", quantifier => "", real_name => "edge_definition"} | |--- ::=. Attributes: {bracketed_name => "0", quantifier => "", real_name => "::="} | |--- edge_statement. Attributes: {bracketed_name => "0", quantifier => "", real_name => "edge_statement"} | |--- |. Attributes: {bracketed_name => "0", quantifier => "", real_name => "|"} | |--- edge_statement. Attributes: {bracketed_name => "0", quantifier => "", real_name => "edge_statement"} | |--- graph_definition. Attributes: {bracketed_name => "0", quantifier => "", real_name => "graph_definition"} |--- edge_statement. Attributes: {bracketed_name => "0", quantifier => "", real_name => "edge_statement"} | |--- ::=. Attributes: {bracketed_name => "0", quantifier => "", real_name => "::="} | |--- edge_name. Attributes: {bracketed_name => "0", quantifier => "", real_name => "edge_name"} | |--- |. Attributes: {bracketed_name => "0", quantifier => "", real_name => "|"} | |--- edge_name. Attributes: {bracketed_name => "0", quantifier => "", real_name => "edge_name"} | |--- attribute_definition. Attributes: {bracketed_name => "0", quantifier => "", real_name => "attribute_definition"} | |--- |. Attributes: {bracketed_name => "0", quantifier => "", real_name => "|"} | |--- edge_statement. Attributes: {bracketed_name => "0", quantifier => "", real_name => "edge_statement"} | |--- (','). Attributes: {bracketed_name => "0", quantifier => "", real_name => ""} | |--- edge_statement. Attributes: {bracketed_name => "0", quantifier => "", real_name => "edge_statement"} |--- edge_name. Attributes: {bracketed_name => "0", quantifier => "", real_name => "edge_name"} | |--- ::=. Attributes: {bracketed_name => "0", quantifier => "", real_name => "::="} | |--- directed_edge. Attributes: {bracketed_name => "0", quantifier => "", real_name => "directed_edge"} | |--- |. Attributes: {bracketed_name => "0", quantifier => "", real_name => "|"} | |--- undirected_edge. Attributes: {bracketed_name => "0", quantifier => "", real_name => "undirected_edge"} |--- :lexeme. Attributes: {bracketed_name => "0", quantifier => "", real_name => ":lexeme"} | |--- ~. Attributes: {bracketed_name => "0", quantifier => "", real_name => "~"} | |--- directed_edge. Attributes: {bracketed_name => "0", quantifier => "", real_name => "directed_edge"} | |--- pause. Attributes: {bracketed_name => "0", quantifier => "", real_name => "pause"} | |--- =>. Attributes: {bracketed_name => "0", quantifier => "", real_name => "=>"} | |--- before. Attributes: {bracketed_name => "0", quantifier => "", real_name => "before"} | |--- event. Attributes: {bracketed_name => "0", quantifier => "", real_name => "event"} | |--- =>. Attributes: {bracketed_name => "0", quantifier => "", real_name => "=>"} | |--- directed_edge. Attributes: {bracketed_name => "0", quantifier => "", real_name => "directed_edge"} |--- directed_edge. Attributes: {bracketed_name => "0", quantifier => "", real_name => "directed_edge"} | |--- ~. Attributes: {bracketed_name => "0", quantifier => "", real_name => "~"} | |--- '->'. Attributes: {bracketed_name => "0", quantifier => "", real_name => ""} |--- :lexeme. Attributes: {bracketed_name => "0", quantifier => "", real_name => ":lexeme"} | |--- ~. Attributes: {bracketed_name => "0", quantifier => "", real_name => "~"} | |--- undirected_edge. Attributes: {bracketed_name => "0", quantifier => "", real_name => "undirected_edge"} | |--- pause. Attributes: {bracketed_name => "0", quantifier => "", real_name => "pause"} | |--- =>. Attributes: {bracketed_name => "0", quantifier => "", real_name => "=>"} | |--- before. Attributes: {bracketed_name => "0", quantifier => "", real_name => "before"} | |--- event. Attributes: {bracketed_name => "0", quantifier => "", real_name => "event"} | |--- =>. Attributes: {bracketed_name => "0", quantifier => "", real_name => "=>"} | |--- undirected_edge. Attributes: {bracketed_name => "0", quantifier => "", real_name => "undirected_edge"} |--- undirected_edge. Attributes: {bracketed_name => "0", quantifier => "", real_name => "undirected_edge"} | |--- ~. Attributes: {bracketed_name => "0", quantifier => "", real_name => "~"} | |--- '--'. Attributes: {bracketed_name => "0", quantifier => "", real_name => ""} |--- attribute_definition. Attributes: {bracketed_name => "0", quantifier => "", real_name => "attribute_definition"} | |--- ::=. Attributes: {bracketed_name => "0", quantifier => "", real_name => "::="} | |--- attribute_statement. Attributes: {bracketed_name => "0", quantifier => "*", real_name => "attribute_statement"} |--- attribute_statement. Attributes: {bracketed_name => "0", quantifier => "", real_name => "attribute_statement"} | |--- ::=. Attributes: {bracketed_name => "0", quantifier => "", real_name => "::="} | |--- start_attributes. Attributes: {bracketed_name => "0", quantifier => "", real_name => "start_attributes"} | |--- end_attributes. Attributes: {bracketed_name => "0", quantifier => "", real_name => "end_attributes"} |--- :lexeme. Attributes: {bracketed_name => "0", quantifier => "", real_name => ":lexeme"} | |--- ~. Attributes: {bracketed_name => "0", quantifier => "", real_name => "~"} | |--- start_attributes. Attributes: {bracketed_name => "0", quantifier => "", real_name => "start_attributes"} | |--- pause. Attributes: {bracketed_name => "0", quantifier => "", real_name => "pause"} | |--- =>. Attributes: {bracketed_name => "0", quantifier => "", real_name => "=>"} | |--- before. Attributes: {bracketed_name => "0", quantifier => "", real_name => "before"} | |--- event. Attributes: {bracketed_name => "0", quantifier => "", real_name => "event"} | |--- =>. Attributes: {bracketed_name => "0", quantifier => "", real_name => "=>"} | |--- start_attributes. Attributes: {bracketed_name => "0", quantifier => "", real_name => "start_attributes"} |--- start_attributes. Attributes: {bracketed_name => "0", quantifier => "", real_name => "start_attributes"} | |--- ~. Attributes: {bracketed_name => "0", quantifier => "", real_name => "~"} | |--- '{'. Attributes: {bracketed_name => "0", quantifier => "", real_name => ""} |--- :lexeme. Attributes: {bracketed_name => "0", quantifier => "", real_name => ":lexeme"} | |--- ~. Attributes: {bracketed_name => "0", quantifier => "", real_name => "~"} | |--- end_attributes. Attributes: {bracketed_name => "0", quantifier => "", real_name => "end_attributes"} |--- end_attributes. Attributes: {bracketed_name => "0", quantifier => "", real_name => "end_attributes"} | |--- ~. Attributes: {bracketed_name => "0", quantifier => "", real_name => "~"} | |--- '}'. Attributes: {bracketed_name => "0", quantifier => "", real_name => ""} |--- :discard. Attributes: {bracketed_name => "0", quantifier => "", real_name => ":discard"} | |--- =>. Attributes: {bracketed_name => "0", quantifier => "", real_name => "=>"} | |--- whitespace. Attributes: {bracketed_name => "0", quantifier => "", real_name => "whitespace"} |--- whitespace. Attributes: {bracketed_name => "0", quantifier => "", real_name => "whitespace"} |--- ~. Attributes: {bracketed_name => "0", quantifier => "", real_name => "~"} |--- [\s]. Attributes: {bracketed_name => "0", quantifier => "+", real_name => "[\s]"} Tree-DAG_Node-1.35/t/about.perl.t0000644000175000017500000000414314106404517014564 0ustar ronron#! perl require 5; # Summary of, well, things. use Test::More; BEGIN {plan tests => 2}; ok 1; use Tree::DAG_Node; #chdir "t" if -e "t"; { my @out; push @out, "\n\nPerl v", defined($^V) ? sprintf('%vd', $^V) : $], " under $^O ", (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber()) ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (), (defined $MacPerl::Version) ? ("(MacPerl version $MacPerl::Version)") : (), "\n" ; # Ugly code to walk the symbol tables: my %v; my @stack = (''); # start out in %:: my $this; my $count = 0; my $pref; while(@stack) { $this = shift @stack; die "Too many packages?" if ++$count > 1000; next if exists $v{$this}; next if $this eq 'main'; # %main:: is %:: #print "Peeking at $this => ${$this . '::VERSION'}\n"; if(defined ${$this . '::VERSION'} ) { $v{$this} = ${$this . '::VERSION'} } elsif( defined *{$this . '::ISA'} or defined &{$this . '::import'} or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"}) # If it has an ISA, an import, or any subs... ) { # It's a class/module with no version. $v{$this} = undef; } else { # It's probably an unpopulated package. ## $v{$this} = '...'; } $pref = length($this) ? "$this\::" : ''; push @stack, map m/^(.+)::$/ ? "$pref$1" : (), keys %{$this . '::'}; #print "Stack: @stack\n"; } push @out, " Modules in memory:\n"; delete @v{'', '[none]'}; foreach my $p (sort {lc($a) cmp lc($b)} keys %v) { $indent = ' ' x (2 + ($p =~ tr/:/:/)); push @out, ' ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n"; } push @out, sprintf "[at %s (local) / %s (GMT)]\n", scalar(gmtime), scalar(localtime); my $x = join '', @out; $x =~ s/^/#/mg; print $x; } print "# Running", (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n", "#\n", ; print "# \@INC:\n", map("# [$_]\n", @INC), "#\n#\n"; print "# \%INC:\n"; foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) { print "# [$x] = [", $INC{$x} || '', "]\n"; } ok 1; Tree-DAG_Node-1.35/t/metag.cooked.tree.txt0000644000175000017500000002007715002624513016363 0ustar ronronCooked tree. Attributes: {rule => "", uid => "1"} |--- statements. Attributes: {rule => "1", uid => "2"} |--- default_rule. Attributes: {rule => "1", uid => "3"} |--- lexeme_default_statement. Attributes: {rule => "1", uid => "4"} |--- start_rule. Attributes: {rule => "1", uid => "5"} |--- quantified_rule. Attributes: {rule => "1", uid => "6"} |--- priority_rule. Attributes: {rule => "1", uid => "7"} |--- priority_rule. Attributes: {rule => "1", uid => "8"} |--- priority_rule. Attributes: {rule => "1", uid => "9"} |--- priority_rule. Attributes: {rule => "1", uid => "10"} |--- priority_rule. Attributes: {rule => "1", uid => "11"} |--- priority_rule. Attributes: {rule => "1", uid => "12"} |--- priority_rule. Attributes: {rule => "1", uid => "13"} |--- priority_rule. Attributes: {rule => "1", uid => "14"} |--- priority_rule. Attributes: {rule => "1", uid => "15"} |--- priority_rule. Attributes: {rule => "1", uid => "16"} |--- priority_rule. Attributes: {rule => "1", uid => "17"} |--- priority_rule. Attributes: {rule => "1", uid => "18"} |--- priority_rule. Attributes: {rule => "1", uid => "19"} |--- priority_rule. Attributes: {rule => "1", uid => "20"} |--- priority_rule. Attributes: {rule => "1", uid => "21"} |--- priority_rule. Attributes: {rule => "1", uid => "22"} |--- priority_rule. Attributes: {rule => "1", uid => "23"} |--- priority_rule. Attributes: {rule => "1", uid => "24"} |--- priority_rule. Attributes: {rule => "1", uid => "25"} |--- priority_rule. Attributes: {rule => "1", uid => "26"} |--- separator_specification. Attributes: {rule => "1", uid => "27"} |--- separator_specification. Attributes: {rule => "1", uid => "28"} |--- priority_rule. Attributes: {rule => "1", uid => "29"} |--- priority_rule. Attributes: {rule => "1", uid => "30"} |--- quantified_rule. Attributes: {rule => "1", uid => "31"} |--- priority_rule. Attributes: {rule => "1", uid => "32"} |--- priority_rule. Attributes: {rule => "1", uid => "33"} |--- priority_rule. Attributes: {rule => "1", uid => "34"} |--- priority_rule. Attributes: {rule => "1", uid => "35"} |--- priority_rule. Attributes: {rule => "1", uid => "36"} |--- priority_rule. Attributes: {rule => "1", uid => "37"} |--- priority_rule. Attributes: {rule => "1", uid => "38"} |--- priority_rule. Attributes: {rule => "1", uid => "39"} |--- priority_rule. Attributes: {rule => "1", uid => "40"} |--- priority_rule. Attributes: {rule => "1", uid => "41"} |--- priority_rule. Attributes: {rule => "1", uid => "42"} |--- priority_rule. Attributes: {rule => "1", uid => "43"} |--- priority_rule. Attributes: {rule => "1", uid => "44"} |--- priority_rule. Attributes: {rule => "1", uid => "45"} |--- priority_rule. Attributes: {rule => "1", uid => "46"} |--- priority_rule. Attributes: {rule => "1", uid => "47"} |--- priority_rule. Attributes: {rule => "1", uid => "48"} |--- priority_rule. Attributes: {rule => "1", uid => "49"} |--- lhs. Attributes: {rule => "1", uid => "50"} |--- priority_rule. Attributes: {rule => "1", uid => "51"} |--- priority_rule. Attributes: {rule => "1", uid => "52"} |--- priority_rule. Attributes: {rule => "1", uid => "53"} |--- priority_rule. Attributes: {rule => "1", uid => "54"} |--- priority_rule. Attributes: {rule => "1", uid => "55"} |--- priority_rule. Attributes: {rule => "1", uid => "56"} |--- priority_rule. Attributes: {rule => "1", uid => "57"} |--- priority_rule. Attributes: {rule => "1", uid => "58"} |--- priority_rule. Attributes: {rule => "1", uid => "59"} |--- priority_rule. Attributes: {rule => "1", uid => "60"} |--- priority_rule. Attributes: {rule => "1", uid => "61"} |--- quantified_rule. Attributes: {rule => "1", uid => "62"} |--- priority_rule. Attributes: {rule => "1", uid => "63"} |--- priority_rule. Attributes: {rule => "1", uid => "64"} |--- priority_rule. Attributes: {rule => "1", uid => "65"} |--- priority_rule. Attributes: {rule => "1", uid => "66"} |--- quantified_rule. Attributes: {rule => "1", uid => "67"} |--- priority_rule. Attributes: {rule => "1", uid => "68"} |--- priority_rule. Attributes: {rule => "1", uid => "69"} |--- priority_rule. Attributes: {rule => "1", uid => "70"} |--- priority_rule. Attributes: {rule => "1", uid => "71"} |--- priority_rule. Attributes: {rule => "1", uid => "72"} |--- priority_rule. Attributes: {rule => "1", uid => "73"} |--- priority_rule. Attributes: {rule => "1", uid => "74"} |--- discard_rule. Attributes: {rule => "1", uid => "75"} |--- quantified_rule. Attributes: {rule => "1", uid => "76"} |--- discard_rule. Attributes: {rule => "1", uid => "77"} |--- priority_rule. Attributes: {rule => "1", uid => "78"} |--- priority_rule. Attributes: {rule => "1", uid => "79"} |--- priority_rule. Attributes: {rule => "1", uid => "80"} |--- quantified_rule. Attributes: {rule => "1", uid => "81"} |--- priority_rule. Attributes: {rule => "1", uid => "82"} |--- priority_rule. Attributes: {rule => "1", uid => "83"} |--- priority_rule. Attributes: {rule => "1", uid => "84"} |--- priority_rule. Attributes: {rule => "1", uid => "85"} |--- priority_rule. Attributes: {rule => "1", uid => "86"} |--- priority_rule. Attributes: {rule => "1", uid => "87"} |--- priority_rule. Attributes: {rule => "1", uid => "88"} |--- priority_rule. Attributes: {rule => "1", uid => "89"} |--- priority_rule. Attributes: {rule => "1", uid => "90"} |--- priority_rule. Attributes: {rule => "1", uid => "91"} |--- quantified_rule. Attributes: {rule => "1", uid => "92"} |--- priority_rule. Attributes: {rule => "1", uid => "93"} |--- priority_rule. Attributes: {rule => "1", uid => "94"} |--- priority_rule. Attributes: {rule => "1", uid => "95"} |--- quantified_rule. Attributes: {rule => "1", uid => "96"} |--- quantified_rule. Attributes: {rule => "1", uid => "97"} |--- quantified_rule. Attributes: {rule => "1", uid => "98"} |--- priority_rule. Attributes: {rule => "1", uid => "99"} |--- separator_specification. Attributes: {rule => "1", uid => "100"} |--- quantified_rule. Attributes: {rule => "1", uid => "101"} |--- priority_rule. Attributes: {rule => "1", uid => "102"} |--- priority_rule. Attributes: {rule => "1", uid => "103"} |--- quantified_rule. Attributes: {rule => "1", uid => "104"} |--- priority_rule. Attributes: {rule => "1", uid => "105"} |--- priority_rule. Attributes: {rule => "1", uid => "106"} |--- priority_rule. Attributes: {rule => "1", uid => "107"} |--- priority_rule. Attributes: {rule => "1", uid => "108"} |--- priority_rule. Attributes: {rule => "1", uid => "109"} |--- bracketed_name. Attributes: {rule => "1", uid => "110"} |--- priority_rule. Attributes: {rule => "1", uid => "111"} |--- priority_rule. Attributes: {rule => "1", uid => "112"} |--- priority_rule. Attributes: {rule => "1", uid => "113"} |--- priority_rule. Attributes: {rule => "1", uid => "114"} |--- priority_rule. Attributes: {rule => "1", uid => "115"} |--- quantified_rule. Attributes: {rule => "1", uid => "116"} |--- priority_rule. Attributes: {rule => "1", uid => "117"} |--- quantified_rule. Attributes: {rule => "1", uid => "118"} |--- priority_rule. Attributes: {rule => "1", uid => "119"} |--- priority_rule. Attributes: {rule => "1", uid => "120"} |--- priority_rule. Attributes: {rule => "1", uid => "121"} |--- priority_rule. Attributes: {rule => "1", uid => "122"} |--- priority_rule. Attributes: {rule => "1", uid => "123"} |--- priority_rule. Attributes: {rule => "1", uid => "124"} |--- quantified_rule. Attributes: {rule => "1", uid => "125"} |--- priority_rule. Attributes: {rule => "1", uid => "126"} |--- priority_rule. Attributes: {rule => "1", uid => "127"} |--- priority_rule. Attributes: {rule => "1", uid => "128"} |--- priority_rule. Attributes: {rule => "1", uid => "129"} |--- quantified_rule. Attributes: {rule => "1", uid => "130"} Tree-DAG_Node-1.35/t/read.tree.t0000644000175000017500000000301015003107566014353 0ustar ronronuse strict; use warnings; use warnings qw(FATAL utf8); # Fatalize encoding glitches. use File::Spec; use File::Temp; use File::Slurper 'read_lines'; use Test::More; # ------------------------------------------------ sub process { my($node, $file_name) = @_; # The EXLOCK option is for BSD-based systems. my($temp_dir) = File::Temp -> newdir('temp.XXXX', CLEANUP => 1, EXLOCK => 0, TMPDIR => 1); my($temp_dir_name) = $temp_dir -> dirname; my($test_file_name) = File::Spec -> catfile($temp_dir_name, "$file_name.txt"); my($input_file_name) = File::Spec -> catfile('t', "$file_name.txt"); my($root) = $node -> read_tree($input_file_name); my($no_attr) = $file_name =~ /without/ ? 1 : 0; open(my $fh, '> :encoding(utf-8)', $test_file_name); print $fh "$_\n" for @{$root -> tree2string({no_attributes => $no_attr})}; close $fh; # Ensure inter-OS compatability. my(@expected) = map{s/\r$//g; $_} read_lines($input_file_name); my(@got) = map{s/\r$//g; $_} read_lines($test_file_name); is(join('', @expected), join('', @got), "\u$file_name attributes: Output tree matches shipped tree"); } # End of process. # ------------------------------------------------ BEGIN {use_ok('Tree::DAG_Node'); } my($node) = Tree::DAG_Node -> new; isa_ok($node, 'Tree::DAG_Node', 'new() returned correct object type'); my($sample_file_name); for (qw/utf8 with without/) { $sample_file_name = "tree.$_.attributes"; process($node, $sample_file_name); } process($node, 'metag.cooked.tree'); done_testing; Tree-DAG_Node-1.35/t/00.versions.t0000644000175000017500000000112115010317477014573 0ustar ronron#/usr/bin/env perl use strict; use warnings; # I tried 'require'-ing modules but that did not work. use Tree::DAG_Node; # For the version #. use Test::More; use ExtUtils::MakeMaker; use File::Slurper; use strict; use utf8; use warnings; # ---------------------- pass('All external modules loaded'); my(@modules) = qw / ExtUtils::MakeMaker File::Slurper strict utf8 warnings /; diag "Testing Tree::DAG_Node V $Tree::DAG_Node::VERSION"; for my $module (@modules) { no strict 'refs'; my($ver) = ${$module . '::VERSION'} || 'N/A'; diag "Using $module V $ver"; } done_testing; Tree-DAG_Node-1.35/t/tree.utf8.attributes.txt0000644000175000017500000000202715002622700017065 0ustar ronronRoot. Attributes: {} |--- Â. Attributes: {# => "ÂÂ"} | |--- â. Attributes: {# => "ââ"} | | |--- É. Attributes: {# => "ÉÉ"} | |--- ä. Attributes: {# => "ää"} | |--- é. Attributes: {# => "éé"} | |--- Ñ. Attributes: {# => "ÑÑ"} | |--- ñ. Attributes: {# => "ññ"} | |--- Ô. Attributes: {# => "ÔÔ"} | |--- ô. Attributes: {# => "ôô"} | |--- ô. Attributes: {# => "ôô"} |--- ß. Attributes: {# => "ßß"} |--- ®. Attributes: {# => "®®"} | |--- ©. Attributes: {# => "©©"} |--- £. Attributes: {# => "££"} |--- €. Attributes: {# => "€€"} |--- √. Attributes: {# => "√√"} |--- ×xX. Attributes: {# => "×xX×xX"} |--- í. Attributes: {# => "íí"} |--- ú. Attributes: {# => "úú"} |--- «. Attributes: {# => "««"} |--- ». Attributes: {# => "»»"} Tree-DAG_Node-1.35/t/load.t0000644000175000017500000000024514106404517013427 0ustar ronronuse strict; use warnings; use Test::More; # ------------- BEGIN{ use_ok('Tree::DAG_Node'); } my($count) = 1; # Counting the use_ok above. done_testing($count); Tree-DAG_Node-1.35/t/00.versions.tx0000644000175000017500000000077314106404517014774 0ustar ronron#/usr/bin/env perl use strict; use warnings; # I tried 'require'-ing modules but that did not work. use <: $module_name :>; # For the version #. use Test::More; <: $module_list_1 :> # ---------------------- pass('All external modules loaded'); my(@modules) = qw / <: $module_list_2 :> /; diag "Testing <: $module_name :> V $<: $module_name :>::VERSION"; for my $module (@modules) { no strict 'refs'; my($ver) = ${$module . '::VERSION'} || 'N/A'; diag "Using $module V $ver"; } done_testing; Tree-DAG_Node-1.35/SECURITY.md0000644000175000017500000000765414772113521013665 0ustar ronronThis is the Security Policy for the Perl Tree-DAG_Node distribution. The latest version of the Security Policy can be found in the [git repository for Tree-DAG_Node](https://github.com/ronsavage/Tree-DAG_Node). This text is based on the CPAN Security Group's Guidelines for Adding a Security Policy to Perl Distributions (version 1.1.0) https://security.metacpan.org/docs/guides/security-policy-for-authors.html # How to Report a Security Vulnerability Security vulnerabilities can be reported by e-mail to the current project maintainers at . Please include as many details as possible, including code samples or test cases, so that we can reproduce the issue. Check that your report does not expose any sensitive data, such as passwords, tokens, or personal information. If you would like any help with triaging the issue, or if the issue is being actively exploited, please copy the report to the CPAN Security Group (CPANSec) at . Please *do not* use the public issue reporting system on RT or GitHub issues for reporting security vulnerabilities. Please do not disclose the security vulnerability in public forums until past any proposed date for public disclosure, or it has been made public by the maintainers or CPANSec. That includes patches or pull requests. For more information, see [Report a Security Issue](https://security.metacpan.org/docs/report.html) on the CPANSec website. ## Response to Reports The maintainer(s) aim to acknowledge your security report as soon as possible. However, this project is maintained by a single person in their spare time, and they cannot guarantee a rapid response. If you have not received a response from them within a week, then please send a reminder to them and copy the report to CPANSec at . Please note that the initial response to your report will be an acknowledgement, with a possible query for more information. It will not necessarily include any fixes for the issue. The project maintainer(s) may forward this issue to the security contacts for other projects where we believe it is relevant. This may include embedded libraries, system libraries, prerequisite modules or downstream software that uses this software. They may also forward this issue to CPANSec. # Which Software This Policy Applies To Any security vulnerabilities in Tree-DAG_Node are covered by this policy. Security vulnerabilities are considered anything that allows users to execute unauthorised code, access unauthorised resources, or to have an adverse impact on accessibility or performance of a system. Security vulnerabilities in upstream software (embedded libraries, prerequisite modules or system libraries, or in Perl), are not covered by this policy unless they affect Tree-DAG_Node, or Tree-DAG_Node can be used to exploit vulnerabilities in them. Security vulnerabilities in downstream software (any software that uses Tree-DAG_Node, or plugins to it that are not included with the Tree-DAG_Node distribution) are not covered by this policy. ## Supported Versions of Tree-DAG_Node The maintainer(s) will release security fixes for the latest version of Tree-DAG_Node. Note that the Tree-DAG_Node project only supports major versions of Perl released in the past ten (10) years, even though Tree-DAG_Node will run on older versions of Perl. If a security fix requires the maintainers to increase the minimum version of Perl that is supported, then they may do so. # Installation and Usage Issues The distribution metadata specifies minimum versions of prerequisites that are required for Tree-DAG_Node to work. However, some of these prerequisites may have security vulnerabilities, and you should ensure that you are using up-to-date versions of these prerequisites. Where security vulnerabilities are known, the metadata may indicate newer versions as recommended. ## Usage Please see the software documentation for further information.