File Coverage

blib/lib/TreePath.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             package TreePath;
2              
3 1     1   17061 use utf8;
  1         8  
  1         4  
4 1     1   211 use Moose;
  0            
  0            
5             with 'MooseX::Object::Pluggable';
6              
7             use Moose::Util::TypeConstraints;
8             use Config::JFDI;
9             use Carp qw/croak/;
10             use Data::Dumper;
11              
12             our $VERSION = '0.12';
13              
14             subtype MyConf => as 'HashRef';
15             coerce 'MyConf'
16             => from 'Str' => via {
17             my $conf = shift;
18             my ($jfdi_h, $jfdi) = Config::JFDI->open($conf)
19             or croak "Error (conf: $conf) : $!\n";
20             return $jfdi->get;
21             };
22              
23             has conf => ( is => 'rw',
24             isa => 'MyConf',
25             coerce => 1,
26             trigger => sub {
27             my $self = shift;
28             my $args = shift;
29              
30             # if conf exist
31             if ( defined $args->{$self->configword} ) {
32             croak "Error: Can not find " . $self->configword . " in your conf !"
33             if ( ! $args->{$self->configword});
34              
35             $self->config($args->{$self->configword});
36              
37             $self->debug($self->config->{'debug'})
38             if ( ! defined $self->debug && defined $self->config->{'debug'} );
39              
40             $self->_search_field($self->config->{backend}->{args}->{search_field})
41             if defined $self->config->{backend}->{args}->{search_field};
42             $self->_parent_field($self->config->{backend}->{args}->{parent_field})
43             if defined $self->config->{backend}->{args}->{parent_field};
44              
45             $self->_sync($self->config->{backend}->{args}->{sync})
46             if defined $self->config->{backend}->{args}->{sync};
47              
48             $self->_load_backend if ! $self->can('backend');
49             }
50             # it's a hash
51             else {
52             $self->tree($args);
53             $self->_build_tree;
54             }
55             }
56             );
57              
58              
59              
60             has config => (
61             isa => "HashRef",
62             is => "rw",
63             );
64              
65             has 'configword' => (
66             is => 'rw',
67             default => sub { __PACKAGE__ },
68             );
69              
70             has 'debug' => (
71             is => 'rw',
72             );
73              
74             has '_backend' => (
75             is => 'rw',
76             isa => 'Str',
77             );
78              
79             has '_sync' => (
80             is => 'rw',
81             isa => 'Str',
82             );
83              
84             has _plugin_ns => (
85             is => 'rw',
86             required => 1,
87             isa => 'Str',
88             default => sub{ 'Backend' },
89             );
90              
91             has _type_field => (
92             is => 'rw',
93             isa => 'Str',
94             default => sub{ 'type' },
95             );
96              
97             has _search_field => (
98             is => 'rw',
99             isa => 'Str',
100             default => sub{ 'name' },
101             );
102              
103             has _parent_field => (
104             is => 'rw',
105             isa => 'Str',
106             default => sub{ 'parent' },
107             );
108              
109             has _position_field => (
110             is => 'rw',
111             isa => 'Str',
112             default => sub{ 'position' },
113             );
114              
115             has _rules => (
116             isa => "HashRef",
117             is => "rw",
118             );
119              
120             has tree => (
121             isa => "HashRef",
122             is => "rw",
123             );
124              
125              
126             has root => (
127             isa => "HashRef",
128             is => "rw",
129             );
130              
131              
132              
133             sub _load_backend {
134             my $self = shift;
135             my $backend = $self->config->{'backend'}->{name};
136             $self->_backend($backend);
137              
138             $self->_log("Loading $backend backend ...");
139             $self->load_plugin( $backend );
140             $self->_load_tree;
141             $self->_load_rules if ( defined $self->config->{rules});
142             $self->_build_tree;
143             }
144              
145             sub reload {
146             my $self = shift;
147              
148             $self->_populate_backend(0)
149             if $self->can('_populate_backend');
150              
151             $self->_load_tree;
152             }
153              
154             sub _log{
155             my ($self, $msg ) = @_;
156              
157             return if ! $self->debug;
158              
159             say STDERR "[debug] $msg";
160             }
161              
162             # Load tree from backend
163             sub _load_tree {
164             my $self = shift;
165              
166             $self->tree($self->_load);
167             }
168              
169             # Load rules from config
170             sub _load_rules {
171             my $self = shift;
172             $self->_rules($self->config->{'rules'});
173             }
174              
175             # Build Tree (children, position, ...)
176             # parents and children become HashRef
177             sub _build_tree {
178             my $self = shift;
179              
180             my $tree = $self->tree;
181             foreach my $id ( sort keys %$tree ) {
182             my $node = $tree->{$id};
183             $node->{id} = $id;
184             my $parent = $tree->{$node->{parent}};
185             $node->{parent} = $parent;
186              
187             $self->add($parent, $node);
188             }
189             }
190              
191             # return the last node sorted by id
192             sub _last_node {
193             my $self = shift;
194              
195             my @nodes_sorted_by_id = sort { $a <=> $b } map $_->{id}, values %{$self->tree};
196             return { id => 0 } if ! defined $nodes_sorted_by_id[0];
197             return $self->tree->{$nodes_sorted_by_id[-1]};
198             }
199              
200             sub _bckd_create {
201             my $self = shift;
202             my $node = shift;
203             my $msg = shift;
204              
205             return if ( ! $self->_backend || ! $self->_sync );
206             $self->_log("[" . $self->_backend . "] CREATE " . $node->{name} . " | $msg");
207             $self->_create($node);
208             }
209              
210             sub _bckd_delete {
211             my $self = shift;
212             my $nodes = shift;
213             my $msg = shift;
214              
215             return if ( ! $self->_backend || ! $self->_sync );
216             my @nodes_name = map { $_->{$self->_search_field} } @$nodes;
217             $self->_log("[" . $self->_backend . "] DELETE @nodes_name | $msg");
218              
219             $self->_delete($nodes);
220             }
221              
222             sub _bckd_update {
223             my $self = shift;
224             my $node = shift;
225             my $msg = shift;
226              
227             return if ( ! $self->_backend || ! $self->_sync );
228             $self->_log("[" . $self->_backend . "] UPDATE " . $node->{name} . " | $msg");
229             $self->_update($node);
230             }
231              
232              
233             sub _check_rules{
234             my ($self, $node, $parent) = @_;
235              
236             return 1 if ( ! defined $self->config ||
237             ! defined $self->config->{rules} ||
238             $node->{id} == 1
239             );
240              
241             # Is node can 'link' to parent ?
242             my $rules = $self->_rules;
243             if ( defined $rules->{$node->{$self->_type_field}}) {
244             if ( defined $rules->{$node->{$self->_type_field}}->{$parent->{$self->_type_field}}) {
245             return $rules->{$node->{$self->_type_field}}->{$parent->{$self->_type_field}};
246             }
247             else { return 0 }
248             }
249             else { return 0 }
250             }
251              
252             sub _update_children_position {
253             my $self = shift;
254             my @children = @_;
255              
256             my $n=1;
257             foreach my $child ( @children ) {
258             if ( ! defined $child->{$self->_position_field} ||
259             $child->{$self->_position_field} != $n )
260             {
261             my $pos = defined $child->{$self->_position_field} ?
262             $child->{$self->_position_field} : '?';
263             my $msg = 'updating position of '. $child->{$self->_search_field} .
264             "( $pos -> $n)";
265             $child->{$self->_position_field} = $n;
266             $self->_bckd_update($child, $msg );
267             }
268             $n++;
269             }
270             }
271              
272              
273             # removes the child's father
274             sub _remove_child_father{
275             my $self = shift;
276             my $node = shift;
277              
278             my $father = $node->{parent};
279             my $key_children = $self->_key_children($node, $father);
280             my $id = 0;
281             foreach my $child ( @{$father->{$key_children}}) {
282             if ( $child->{$self->_search_field} eq $node->{$self->_search_field} &&
283             $child->{parent} eq $node->{parent} ){
284             return splice ( @{$father->{$key_children}},$id,1);
285             }
286             $id++;
287             }
288             }
289              
290              
291             sub _clone_node {
292             my $self = shift;
293             my $node = shift;
294              
295             my $clone = {};
296             foreach my $k (keys %$node) {
297             if ( $k eq 'parent'){
298             if ( $node->{'parent'}) {
299             $clone->{$self->_parent_field} = $node->{$k}->{id};
300             }
301             # is root
302             else {
303             $clone->{$self->_parent_field} = 0;
304             }
305             }
306             else { $clone->{$k} = $node->{$k} }
307             }
308             return $clone;
309             }
310              
311             sub _key_children {
312             my ($self, $node, $parent) = @_;
313              
314             my $key_children;
315             #if parent have a type
316             if ( defined $parent->{$self->_type_field}) {
317              
318             # if node have a type
319             if ( defined $node->{$self->_type_field}) {
320              
321             # if node and parent have the same type
322             if ( $node->{$self->_type_field} eq $parent->{$self->_type_field} ) {
323             $key_children = 'children';
324             }
325             else {
326             $key_children = 'children_' . $node->{$self->_type_field};
327             }
328             }
329             # else node have the same type as parent
330             else {
331             $node->{$self->_type_field} = $parent->{$self->_type_field};
332             $key_children = 'children';
333             }
334             }
335             # parent haven't type
336             else {
337             if ( defined $node->{$self->_type_field}) {
338             die 'node have a type but not the parent !';
339             }
340             else {
341             $key_children = 'children';
342             }
343             }
344             return $key_children;
345             }
346             sub search {
347             my ( $self, $args, $opts ) = @_;
348              
349             my $results = [];
350             my $tree = $self->tree;
351             foreach my $id ( sort {$a <=> $b} keys %$tree ) {
352              
353             my $found = 1;
354             foreach my $key ( keys %$args ) {
355             my $current;
356             if ( $key =~ m/(.*)\.(.*)/) {
357             # ex: parent.name
358             if ( defined $tree->{$id}->{$1} && ref($tree->{$id}->{$1})) {
359             $current = $tree->{$id}->{$1}->{$2};
360             }
361             else { next }
362             }
363             else {
364             if ( defined $tree->{$id}->{$key} ){
365             $current = $tree->{$id}->{$key};
366             }
367             else {
368             die "'$key' is not a key hash [node id:$id]";
369             }
370             }
371             my $value = $args->{$key};
372             if ( $current ne $value ) {
373             $found = 0;
374             last;
375             }
376             }
377              
378             if ( $found ){
379             if ( wantarray) {
380             push(@$results, $tree->{$id});
381             }
382             # if found and scalar context
383             else {
384             return $tree->{$id};
385             }
386             }
387             }
388              
389             return 0 if ( ! wantarray && ! $$results[0] );
390              
391             # wantarray
392             return @$results;
393             }
394              
395              
396             # ex : search_path(/A/B/C')
397             sub search_path {
398             my ( $self, $path, $opts ) = @_;
399              
400             # search by 'name' if not defined
401             $opts->{by} = $self->_search_field if ! defined $opts->{by};
402              
403             croak "path must be start by '/' !: $!\n" if ( $path !~ m|^/| );
404              
405             my $nodes = [ split m%/%, $path ];
406             $$nodes[0] = '/';
407              
408             my (@found, @not_found);
409             my $parent = '/';
410             foreach my $node ( @$nodes ) {
411             my $args = { $opts->{by} => $node, "parent\.$opts->{by}" => $parent};
412             my $result = $self->search($args, $opts);
413              
414             $parent = $result->{$opts->{by}} if $result;
415              
416             if ( $result ) {
417             push(@found, $result);
418             }
419             else {
420              
421             push(@not_found, $node);
422             }
423             }
424              
425             if ( wantarray ) {
426             return ( \@found, \@not_found );
427             }
428             else {
429             if ( $not_found[-1] ) {
430             return '';
431             }
432             else {
433             return $found[-1];
434             }
435             }
436             }
437              
438              
439             sub count {
440             my $self = shift;
441              
442             return scalar keys %{$self->tree};
443             }
444              
445             sub dump {
446             my $self = shift;
447             my $var = shift;
448              
449             $var = $self->tree if ! defined $var;
450             $Data::Dumper::Maxdepth = 3;
451             $Data::Dumper::Sortkeys = 1;
452             $Data::Dumper::Terse = 1;
453             return Dumper($var);
454             }
455              
456             sub traverse {
457             my ($self, $node, $funcref, $args) = @_;
458              
459             return 0 if ( ! $node );
460             $args ||= {};
461             $args->{_count} = 1 if ! defined ($args->{_count});
462              
463             my $nofunc = 0;
464             if ( ! $funcref ) {
465             $nofunc = 1;
466             $funcref = sub { my ($node, $args) = @_;
467             $args->{_each_nodes} = []
468             if ( ! defined $args->{_each_nodes});
469             if(defined($node)) {
470             push(@{$args->{_each_nodes}}, $node);
471             return 1;
472             }
473             }
474             }
475             # if first node
476             if ( $args->{_count} == 1 ) {
477             return 0 if ( ! &$funcref( $node, $args ) )
478             }
479              
480             my $key_children = $self->_key_children($node, $node->{parent});
481             if(defined($node->{$key_children})) {
482              
483             foreach my $child ( @{$node->{$key_children}} ) {
484             return 0 if ( ! &$funcref( $child, $args ) );
485             $args->{_count}++;
486             $self->traverse( $child, $funcref, $args );
487             }
488             }
489              
490             return $args->{_each_nodes} if $nofunc;
491             return 1;
492             }
493              
494              
495             sub del {
496             my ($self, @nodes) = @_;
497              
498             my @deleted;
499             foreach my $node ( @nodes ) {
500              
501             my $father = $node->{parent};
502              
503             $self->_remove_child_father($node);
504              
505             my $key_children = $self->_key_children($node, $node->{parent});
506             # if position field exist, recalc all children position
507             $self->_update_children_position( @{$father->{$key_children}} )
508             if ( defined $node->{$self->_position_field});
509              
510             # traverse child branches and delete it
511             my $nodes = $self->traverse($node);
512             push(@deleted,map { delete $self->tree->{$_->{id}} } @$nodes);
513             $self->_bckd_delete($nodes, "delete " . @$nodes . " node(s)");
514             }
515             return @deleted;
516             }
517              
518             # Inserts a node beneath the parent at the given position.
519             sub add {
520             my ($self, $parent, $node, $position) = @_;
521              
522             $node->{id} = $self->_last_node->{id} +1
523             if ! defined $node->{id};
524              
525             if ( ! $position && defined $node->{$self->_position_field}) {
526             $position = $node->{$self->_position_field};
527             }
528              
529             if ( ! $parent ){
530             if ( $self->root) {
531             die "root already exist !";
532             }
533             $self->root($node);
534             }
535              
536             $node->{parent} = $parent;
537              
538             # check rules
539             return 0 if ! $self->_check_rules($node, $parent);
540              
541              
542             my $is_exist_in_backend;
543             $is_exist_in_backend = 1
544             if $self->tree->{$node->{id}};
545              
546             # save node in tree
547             $self->tree->{$node->{id}} = $node;
548              
549             my $key_children;
550             my $update_children = 0;
551             # node == root
552             if ( defined $parent && $parent ) {
553             $key_children = $self->_key_children($node, $parent);
554              
555             if ( $parent ) {
556             if ( $position ) {
557             splice @{$parent->{$key_children}}, $position -1, 0, $self->tree->{$node->{id}};
558             $update_children = 1;
559             }
560             else {
561             push(@{$parent->{$key_children}}, $self->tree->{$node->{id}});
562             if ( defined ${$parent->{$key_children}}[0] && ${$parent->{$key_children}}[0]->{$self->_position_field}) {
563             $update_children = 1;
564             }
565             }
566             }
567             }
568             # add node in tree
569             $self->_bckd_create($node, 'add node ' . $node->{$self->_search_field})
570             if ! $is_exist_in_backend;
571              
572             return $self->root if ! $parent;
573              
574             # recalc position of children
575             $self->_update_children_position(@{$parent->{$key_children}}) if $update_children;
576              
577             return $node;
578             }
579              
580             sub insert_before {
581             my ($self, $sibling, $node) = @_;
582              
583             if ( ! defined $sibling->{$self->_position_field}) {
584             return $self->add($sibling->{parent}, $node, 1 );
585             }
586              
587             return $self->add($sibling->{parent}, $node, $sibling->{$self->_position_field} );
588             }
589              
590              
591             sub update {
592             my ($self, $node, $datas) = @_;
593              
594             foreach my $k ( sort keys %$datas ) {
595             next if ( ! defined $node->{$k});
596             next if ( $node->{$k} eq $datas->{$k});
597              
598             my $previous = $node->{$k};
599             my $parent = $node->{parent};
600             my $key_children = $self->_key_children($node, $parent);
601             my $children = $parent->{$key_children};
602              
603              
604             # if update 'position'
605             if ( $k eq $self->_position_field ) {
606             # delete child in parent in previous position
607             my $old = splice(@$children, $previous -1, 1);
608             # add child in parent in new positioh
609             splice(@$children,$datas->{$k} -1,0, $old);
610             $self->_update_children_position(@{$node->{parent}->{$key_children}})
611             if ( defined $node->{$self->_position_field});
612             }
613             elsif ( $k eq 'parent') {
614             my $old = $self->_remove_child_father($node);
615             my $new_parent = $datas->{$k};
616             push(@{$new_parent->{$key_children}}, $old);
617              
618             $node->{parent} = $new_parent;
619              
620             my $msg = 'updating parent of '. $node->{$self->_search_field} .
621             " ( " . $old->{name} . " -> ". $node->{parent}->{name} .")";
622              
623             $self->_bckd_update($node, $msg);
624              
625             if ( defined $node->{$self->_position_field}) {
626             $self->_update_children_position(@{$parent->{$key_children}});
627             $self->_update_children_position(@{$new_parent->{$key_children}});
628             }
629             }
630             else {
631             $node->{$k} = $datas->{$k};
632             }
633             }
634             return $node;
635             }
636              
637              
638             sub move {
639             my ($self, $node, $parent) = @_;
640              
641             return $self->update($node, { parent => $parent });
642             }
643              
644             =head1 NAME
645              
646             TreePath - Simple Tree Path!
647              
648             =head1 VERSION
649              
650              
651             =head1 SYNOPSIS
652              
653             use TreePath;
654              
655             my $tp = TreePath->new( conf => $conf );
656             my $tree = $tp->tree;
657              
658             # All nodes are hash
659             # The first is called 'root'
660             my $root = $tp->root;
661              
662             # a node can have children
663             my $children = $root->{children};
664              
665             =head1 SUBROUTINES/METHODS
666              
667             =head2 new($method => $value)
668              
669             # for now there are two backends : DBIX and File
670             $tp = TreePath->new( conf => 't/conf/treefromdbix.yml')
671              
672             # see t/conf/treepath.yml for hash structure
673             $tp = TreePath->new( datas => $datas);
674              
675             also see t/01-tpath.t
676              
677             =cut
678              
679             =head2 tree
680              
681             $tree = $tp->tree;
682              
683             =cut
684              
685             =head2 reload
686              
687             # reload tree from backend
688             $tree = $tp->reload;
689              
690             =cut
691              
692             =head2 nodes
693              
694             $root = $tp->root;
695             # $root and $tree->{1} are the same node
696              
697             This is the root node ( a simple hashref )
698             it has no parent.
699             {
700             '1' => {
701             'id' => '1',
702             'name' => '/',
703             'parent' => '0'
704             }
705             }
706              
707             $A = $tp->search( { name => 'A' } );
708             See the dump :
709              
710             {
711             'children' => [
712             {
713             'children' => 'ARRAY(0x293ce00)',
714             'id' => '3',
715             'name' => 'B',
716             'parent' => $VAR1
717             },
718             {
719             'children' => 'ARRAY(0x2fd69b0)',
720             'id' => '7',
721             'name' => 'F',
722             'parent' => $VAR1
723             }
724             ],
725             'id' => '2',
726             'name' => 'A',
727             'parent' => {
728             'children' => [
729             $VAR1
730             ],
731             'id' => '1',
732             'name' => '/',
733             'parent' => '0'
734             }
735             }
736              
737             => 'parent' is a reference on root node and 'children' is an array containing 2 nodes
738              
739             => if nodes have 'type', it's possible to 'link' some 'type' of node on some others types
740              
741             For example, A:(type1), B:(type1, parent:A), C:(type2, parent:A) becomes :
742             A:(type1, children:[B], children_type2[C])
743              
744             Each children can be ordered : { name => A, position => 2};
745              
746             It's also possible to block link with 'rules'. 'link' must be follow these rules to be applied.
747              
748             =cut
749              
750             =head2 search (hashref)
751              
752             # in scalar context return the first result
753             my $E = $tp->search( { name => 'E' } );
754              
755             # return all result in array context
756             my @allE = $tp->search( { name => 'E' } );
757              
758             # It is also possible to specify a particular field of a hash
759             my $B = $tp->search( { name => 'B', 'parent.name' => 'A'} );
760              
761             =cut
762              
763             =head2 search_path (PATH)
764              
765             # Search a path in a tree
766             # in scalar context return last node
767             my $c = $tp->search_path('/A/B/C');
768              
769             # in array context return found and not_found nodes
770             my ($found, $not_found) = $tp->search_path('/A/B/X/D/E');
771              
772             =cut
773              
774             =head2 dump
775              
776             # dump whole tree
777             print $tp->dump;
778              
779             # dump a node
780             print $tp->dump($c);;
781              
782             =cut
783              
784             =head2 count
785              
786             # return the number of nodes
787             print $tp->count;
788              
789             =cut
790              
791             =head2 traverse ($node, [\&function], [$args])
792              
793             # return an arrayref of nodes
794             my $nodes = $tp->traverse($node);
795              
796             # or use a function on each nodes
797             $tp->traverse($node, \&function, $args);
798              
799             =cut
800              
801             =head2 del ($node)
802              
803             # delete recursively all children and node
804             $deleted = $tp->del($node);
805              
806             # delete several nodes at once
807             @del = $tp->del($n1, $n2, ...);
808              
809             =cut
810              
811             =head2 add ($parent, $node)
812              
813             # add the root
814             $root = $tp->add(0, { name => '/'});
815              
816             # add a node beneath the parent at the last position.
817             $Z = $tp->add($parent, { name => 'Z' });
818              
819             # or at given position
820             $Z = $tp->add($parent, { name => 'Z', position => 2 });
821              
822             =cut
823              
824             =head2 update ($node, $datas)
825              
826             # update node with somes datas
827             $Z = $tp->update($node, { name => 'new_name' });
828              
829             # it's possible to update position
830             $X = $tp->update($node, { position => 2 });
831              
832             =cut
833              
834              
835             =head2 move ($node, $parent)
836              
837             # move a node as child of given parent
838             $Z = $tp->move($Z, $X);
839              
840             =cut
841              
842             =head2 insert_before ($sibling, $node)
843              
844             # Inserts a node beneath the parent before the given sibling.
845             $Y = $tp->insert_before($Z, { name => 'Y' });
846              
847             =cut
848              
849              
850              
851             =head1 AUTHOR
852              
853             Daniel Brosseau, C<< <dab at catapulse.org> >>
854              
855             =head1 BUGS
856              
857             Please report any bugs or feature requests to C<bug-tpath at rt.cpan.org>, or through
858             the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=TreePath>. I will be notified, and then you'll
859             automatically be notified of progress on your bug as I make changes.
860              
861              
862              
863              
864             =head1 SUPPORT
865              
866             You can find documentation for this module with the perldoc command.
867              
868             perldoc TreePath
869              
870              
871             You can also look for information at:
872              
873             =over 4
874              
875             =item * RT: CPAN's request tracker (report bugs here)
876              
877             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=TreePath>
878              
879             =item * AnnoCPAN: Annotated CPAN documentation
880              
881             L<http://annocpan.org/dist/TreePath>
882              
883             =item * CPAN Ratings
884              
885             L<http://cpanratings.perl.org/d/TreePath>
886              
887             =item * Search CPAN
888              
889             L<http://search.cpan.org/dist/TreePath/>
890              
891             =back
892              
893              
894             =head1 ACKNOWLEDGEMENTS
895              
896              
897             =head1 LICENSE AND COPYRIGHT
898              
899             Copyright 2014 Daniel Brosseau.
900              
901             This program is free software; you can redistribute it and/or modify it
902             under the terms of the the Artistic License (2.0). You may obtain a
903             copy of the full license at:
904              
905             L<http://www.perlfoundation.org/artistic_license_2_0>
906              
907             Any use, modification, and distribution of the Standard or Modified
908             Versions is governed by this Artistic License. By using, modifying or
909             distributing the Package, you accept this license. Do not use, modify,
910             or distribute the Package, if you do not accept this license.
911              
912             If your Modified Version has been derived from a Modified Version made
913             by someone other than you, you are nevertheless required to ensure that
914             your Modified Version complies with the requirements of this license.
915              
916             This license does not grant you the right to use any trademark, service
917             mark, tradename, or logo of the Copyright Holder.
918              
919             This license includes the non-exclusive, worldwide, free-of-charge
920             patent license to make, have made, use, offer to sell, sell, import and
921             otherwise transfer the Package with respect to any patent claims
922             licensable by the Copyright Holder that are necessarily infringed by the
923             Package. If you institute patent litigation (including a cross-claim or
924             counterclaim) against any party alleging that the Package constitutes
925             direct or contributory patent infringement, then this Artistic License
926             to you shall terminate on the date that such litigation is filed.
927              
928             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
929             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
930             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
931             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
932             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
933             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
934             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
935             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
936              
937              
938             =cut
939              
940             1; # End of TreePath