File Coverage

blib/lib/RapidApp/Module/Tree.pm
Criterion Covered Total %
statement 70 151 46.3
branch 38 108 35.1
condition 11 51 21.5
subroutine 11 18 61.1
pod 0 14 0.0
total 130 342 38.0


line stmt bran cond sub pod time code
1             package RapidApp::Module::Tree;
2              
3 4     4   2087 use strict;
  4         11  
  4         107  
4 4     4   20 use warnings;
  4         11  
  4         96  
5              
6 4     4   19 use Moose;
  4         9  
  4         22  
7             extends 'RapidApp::Module::ExtComponent';
8              
9 4     4   21714 use RapidApp::Util qw(:all);
  4         9  
  4         9987  
10              
11              
12             has 'add_button_text' => ( is => 'ro', isa => 'Str', default => 'Add' );
13             has 'add_button_iconCls' => ( is => 'ro', isa => 'Str', default => 'ra-icon-add' );
14             has 'delete_button_text' => ( is => 'ro', isa => 'Str', default => 'Delete' );
15             has 'delete_button_iconCls' => ( is => 'ro', isa => 'Str', default => 'ra-icon-delete' );
16              
17             has 'use_contextmenu' => ( is => 'ro', isa => 'Bool', default => 0 );
18             has 'no_dragdrop_menu' => ( is => 'ro', isa => 'Bool', default => 0 );
19             has 'setup_tbar' => ( is => 'ro', isa => 'Bool', default => 0 );
20             has 'no_recursive_delete' => ( is => 'ro', isa => 'Bool', default => 1 );
21             has 'no_recursive_copy' => ( is => 'ro', isa => 'Bool', default => 1 );
22              
23             # Double-pane tree - useful for drag/drop
24             has 'double_tree' => ( is => 'ro', isa => 'Bool', default => 0 );
25              
26             #Controls if nodes can drag/drop between nodes as well as into (append) nodes
27             has 'ddAppendOnly' => ( is => 'ro', isa => 'Bool', default => 1 );
28              
29             has 'extra_node_actions' => ( is => 'ro', isa => 'Maybe[ArrayRef]', lazy => 1, default => undef );
30              
31             has 'node_types', is => 'ro', isa => 'Maybe[ArrayRef[HashRef]]', default => undef, traits => ['ExtProp'];
32              
33              
34             sub BUILD {
35 4     4 0 12 my $self = shift;
36 4 50       125 $self->apply_extconfig(
    50          
    50          
    50          
    50          
    50          
    50          
37             xtype => 'apptree',
38             border => \0,
39             layout => 'fit',
40             #containerScroll => \1,
41             #autoScroll => \1,
42             animate => \1,
43             useArrows => \1,
44             use_contextmenu => jstrue($self->use_contextmenu) ? \1 : \0,
45             no_dragdrop_menu => jstrue($self->no_dragdrop_menu) ? \1 : \0,
46             setup_tbar => jstrue($self->setup_tbar) ? \1 : \0,
47             no_recursive_delete => jstrue($self->no_recursive_delete) ? \1 : \0,
48             no_recursive_copy => jstrue($self->no_recursive_copy) ? \1 : \0,
49             double_tree => jstrue($self->double_tree) ? \1 : \0,
50             ddAppendOnly => jstrue($self->ddAppendOnly) ? \1 : \0,
51             );
52            
53 4 50       135 $self->apply_extconfig( extra_node_actions => $self->extra_node_actions ) if ($self->extra_node_actions);
54            
55 4         124 $self->apply_extconfig(
56             add_node_text => $self->add_button_text,
57             add_node_iconCls => $self->add_button_iconCls,
58             delete_node_text => $self->delete_button_text,
59             delete_node_iconCls => $self->delete_button_iconCls
60             );
61            
62 4         129 $self->apply_actions( nodes => 'call_fetch_nodes' );
63 4 50       58 $self->apply_actions( node => 'call_fetch_node' ) if ($self->can('fetch_node'));
64            
65 4 50       27 if($self->op_available('add_node')) {
66 0         0 $self->apply_actions( add => 'call_add_node' );
67 0         0 $self->apply_extconfig( add_node_url => $self->suburl('add') );
68             }
69            
70 4 50       26 if($self->op_available('delete_node')) {
71 0         0 $self->apply_actions( delete => 'call_delete_node' );
72 0         0 $self->apply_extconfig( delete_node_url => $self->suburl('delete') );
73             }
74            
75 4 50       17 if($self->op_available('rename_node')) {
76 0         0 $self->apply_actions( rename => 'call_rename_node' );
77 0         0 $self->apply_extconfig( rename_node_url => $self->suburl('rename') );
78             }
79            
80 4 50       16 if($self->op_available('copy_node')) {
81 0         0 $self->apply_actions( copy => 'call_copy_node' );
82 0         0 $self->apply_extconfig( copy_node_url => $self->suburl('copy') );
83             }
84            
85 4 50       15 if($self->op_available('move_node')) {
86 0         0 $self->apply_actions( move => 'call_move_node' );
87 0         0 $self->apply_extconfig( move_node_url => $self->suburl('move') );
88             }
89            
90 4 50       17 if($self->op_available('expand_node')) {
91 0         0 $self->apply_actions( expand => 'call_expand_node' );
92 0         0 $self->apply_extconfig( expand_node_url => $self->suburl('expand') );
93             }
94            
95 4         52 $self->add_ONREQUEST_calls('init_onreq');
96             }
97              
98             # New: this method is provided so subclass can hook/override
99             sub op_available {
100 24     24 0 48 my ($self, $op_name) = @_;
101 24         187 $self->can($op_name)
102             }
103              
104              
105             around 'content' => sub {
106             my $orig = shift;
107             my $self = shift;
108            
109             my $content = $self->$orig(@_);
110            
111             return $content unless ($self->double_tree);
112              
113             my $cfg = {
114             xtype => 'container',
115            
116             #Emulate border layout:
117             style => { 'background-color' => '#f0f0f0' },
118            
119             layout => 'hbox',
120             layoutConfig => {
121             align => 'stretch',
122             pack => 'start'
123             },
124            
125             items => [
126             {
127             %$content,
128             flex => \1,
129             hideBorders => \1,
130             margins => {
131             top => 0,
132             right => 5,
133             bottom => 0,
134             left => 0
135             },
136             },
137             {
138             %$content,
139             id => $content->{id} . '2',
140             flex => \1,
141             hideBorders => \1,
142             }
143             ]
144             };
145            
146             my @p = qw/tabTitle tabIconCls/;
147             $content->{$_} and $cfg->{$_} = $content->{$_} for (@p);
148            
149             return $cfg
150             };
151              
152              
153              
154             sub init_onreq {
155 11     11 0 27 my $self = shift;
156            
157 11 50       273 $self->apply_extconfig(
158             id => $self->instance_id,
159             dataUrl => $self->suburl('/nodes'),
160             rootVisible => $self->show_root_node ? \1 : \0,
161             root => $self->root_node,
162             tbar => $self->tbar,
163             );
164            
165 11 100       83 my $node = $self->init_jump_to_node or return;
166              
167 1         30 $self->add_listener(
168             afterrender => RapidApp::JSONFunc->new( raw => 1, func =>
169             'function(tree) {' .
170             'Ext.ux.RapidApp.AppTree.jump_to_node_id(tree,"' . $node . '");' .
171             '}'
172             )
173             );
174             }
175              
176              
177             sub init_jump_to_node {
178 11     11 0 27 my $self = shift;
179            
180 11         17 my $node;
181 11 50       271 $node = $self->root_node_name if ($self->show_root_node);
182 11 100       43 $node = $self->c->req->params->{node} if ($self->c->req->params->{node});
183            
184 11         872 return $node;
185             }
186              
187             # If set to true, child nodes are automatically fetched recursively:
188             has 'fetch_nodes_deep', is => 'ro', isa => 'Bool', default => 0;
189              
190             # Auto-sets 'expanded' on nodes with child nodes (only applies to children nodes
191             # loaded within 'call_fetch_nodes' because of 'fetch_nodes_deep' being set to true)
192             has 'default_expanded', is => 'ro', isa => 'Bool', default => 0;
193              
194              
195             ##
196             ##
197             ## fetch_nodes(node_path) [Required]
198             ## method to fetch the tree dataUrl, first argument is the node path
199             has 'fetch_nodes' => ( is => 'ro', default => sub { return []; } );
200             ##
201              
202              
203             ##
204             ## show_root_node
205             ## whether or not to show the root node
206             has 'show_root_node' => ( is => 'ro', default => 0 );
207             ##
208              
209             ##
210             ## root_node_name
211             ## Name of the root node (default 'root')
212             has 'root_node_name' => ( is => 'ro', default => 'root' );
213             ##
214              
215              
216             ##
217             ## root_node_text
218             ## text of the root node
219             has 'root_node_text' => ( is => 'ro', lazy => 1, default => sub { (shift)->root_node_name; } );
220             ##
221              
222             ##
223             ## add_nodes: define as a method to support adding to the tree
224             ##
225              
226              
227             sub apply_path_specific_node_opts {
228 1     1 0 3 my $self = shift;
229 1         2 my $node = shift; #<-- path of a parent node
230 1         2 my $n = shift;
231            
232 1 50       4 return undef unless (exists $n->{id});
233            
234             die "Invalid node definition: id can't be the same as the parent node ($node): " . Dumper($n)
235 1 50       3 if($n->{id} eq $node);
236            
237             # The id should be a fully qualified '/' delim path prefixed with the (parent) node
238             # path ($node supplied to this function). If it is not, assume it is a relative path
239             # and prefix it automatically:
240 1 50       23 $n->{id} = $node . '/' . $n->{id} unless ($n->{id} =~ /^\Q${node}\E/);
241            
242             # This is (imo) an ExtJS bug. It fixes the problem where empty nodes are automatically
243             # made "leaf" nodes and get a stupid, non-folder default icon
244             # http://www.sencha.com/forum/showthread.php?92553-Async-tree-make-empty-nodes-appear-as-quot-nodes-quot-not-quot-leaves-quot&p=441294&viewfull=1#post441294
245 1 50       6 $n->{cls} = 'x-tree-node-collapsed' unless (exists $n->{cls});
246            
247             # legacy:
248 1 50 33     5 $n->{expanded} = \1 if ($n->{expand} and ! exists $n->{expanded});
249            
250 1 50 33     3 $n->{leaf} = \1 if (exists $n->{allowChildren} and ! jstrue($n->{allowChildren}));
251            
252 1 50 33     4 $n->{loaded} = \1 if(jstrue($n->{leaf}) and ! exists $n->{loaded});
253              
254 1         4 return $n;
255             }
256              
257             # Absolute maximum levels deep the whole tree can be
258             has 'max_node_path_depth', is => 'ro', isa => 'Int', default => 100;
259              
260             # Max nested/recursive *single request* fetch depth that will be allowed. The tree can possibly
261             # be deeper than this value, but it wouldn't be fetch-able in a single request
262             has 'max_recursive_fetch_depth', is => 'ro', isa => 'Int', default => 3;
263              
264             our $DEEP_FETCH_DEPTH = 0;
265              
266             sub call_fetch_nodes {
267 1     1 0 3 my $self = shift;
268 1   33     7 my $node = shift || $self->c->req->params->{node};
269            
270 1         72 my @node_pth = split(/\//,$node);
271 1 50       29 die usererr "max_node_path_depth (" . $self->max_node_path_depth . ") exceeded ($node)"
272             if (scalar(@node_pth) > $self->max_node_path_depth);
273            
274             #Track recursive depth:
275 1         3 local $DEEP_FETCH_DEPTH = $DEEP_FETCH_DEPTH + 1;
276            
277             # It shouldn't be possible to exceed 'max_recursive_fetch_depth':
278 1 50       29 die "call_fetch_nodes deep recursion stopped at depth $DEEP_FETCH_DEPTH ($node)!!"
279             if($DEEP_FETCH_DEPTH > $self->max_recursive_fetch_depth);
280            
281            
282             ######
283             ######
284 1         8 my $nodes = clone($self->fetch_nodes($node));
285             ######
286             ######
287            
288             # -- New: automatically test/exclude nodes according to 'require_role'
289             @$nodes = grep {
290 1 50       38 ! $_->{require_role} or
291             $self->role_checker->($self->c,$_->{require_role})
292 1 50       6 } @$nodes if ($self->role_checker);
293             # --
294            
295 1 50       5 die "Error: 'fetch_nodes()' was supposed to return an ArrayRef, but instead it returned: " . Dumper($nodes)
296             unless (ref($nodes) eq 'ARRAY');
297            
298 1         3 my %seen_id = ();
299            
300 1         3 foreach my $n (@$nodes) {
301             die "Invalid node definition: duplicate id ($n->{id}): " . Dumper($n)
302 1 50 33     8 if($n->{id} && $seen_id{$n->{id}}++);
303            
304 1         10 $self->prepare_node($n,$node);
305             }
306            
307 1         18 return $nodes;
308             }
309              
310             sub prepare_node {
311 1     1 0 3 my ($self, $n, $parent) = @_;
312            
313 1 50 33     7 if (jstrue($n->{leaf}) or (exists $n->{allowChildren} and ! jstrue($n->{allowChildren}))) {
      33        
314 0 0       0 $n->{loaded} = \1 unless (exists $n->{loaded});
315 0         0 return $n;
316             }
317            
318 1 50       5 if($parent) {
319 1 50       6 $self->apply_path_specific_node_opts($parent,$n) or return $n;
320             }
321            
322             ## If we've gotten this far, it means the current node can contain child nodes
323            
324 1         2 my $recurse = 0;
325             $recurse = 1 if (
326             ( $self->fetch_nodes_deep or jstrue($n->{expanded}) )
327             and ! exists $n->{children}
328             and ! jstrue($n->{loaded})
329 1 0 33     33 and $DEEP_FETCH_DEPTH < $self->max_recursive_fetch_depth
      33        
      33        
      33        
330             );
331            
332 1 50       4 if($recurse) { # Pre-fetch child nodes automatically:
333 0         0 my $children = $self->call_fetch_nodes($n->{id});
334 0 0       0 if(@$children > 0) {
335 0         0 $n->{children} = $children;
336 0 0 0     0 $n->{expanded} = \1 if ($self->default_expanded and ! exists $n->{expanded});
337             }
338             else {
339             # Set loaded to true if this node is empty (prevents being initialized with a +/- toggle):
340 0 0       0 $n->{loaded} = \1 unless (exists $n->{loaded});
341             }
342             }
343            
344             # WARNING: note that setting 'children' of a node to an empty array will prevent subsequent
345             # ajax loading of the node's children (should any exist later)
346            
347             $n
348 1         3 }
349              
350              
351             sub call_fetch_node {
352 0     0 0   my $self = shift;
353 0           my $node = $self->c->req->params->{node};
354 0           my $n = $self->fetch_node($node);
355 0           $self->prepare_node($n);
356 0           $n
357             }
358              
359             sub call_add_node {
360 0     0 0   my $self = shift;
361 0           my $params = clone($self->c->req->params);
362 0           my $name = $params->{name};
363 0           my $node = $params->{node};
364 0           my $data = $self->add_node($name,$node,$params);
365            
366             # The config/params of the created node should have been returned in the 'child' key:
367 0 0         if ($data->{child}) {
368 0           my $n = $data->{child};
369 0 0         die "id was not returned in 'child'" unless (exists $n->{id});
370 0           $self->apply_path_specific_node_opts($node,$n);
371            
372             # Assume the new node doesn't have any children yet and force to loaded/expanded:
373             # (todo: it is conceivable that a new node might be created with children, add support for this in the future)
374 0           $n->{loaded} = \1;
375 0           $n->{expanded} = \1;
376             }
377            
378 0           return $data;
379             }
380              
381             sub call_delete_node {
382 0     0 0   my $self = shift;
383 0           my $name = $self->c->req->params->{name};
384 0           my $node = $self->c->req->params->{node};
385 0           my $recursive = $self->c->req->params->{recursive};
386 0           return $self->delete_node($node,$recursive);
387             }
388              
389             sub call_rename_node {
390 0     0 0   my $self = shift;
391 0           my $params = clone($self->c->req->params);
392 0           my $name = $params->{name};
393 0           my $node = $params->{node};
394 0           return $self->rename_node($node,$name,$params);
395             }
396              
397             sub call_expand_node {
398 0     0 0   my $self = shift;
399 0 0         my $node = shift; $node = $self->c->req->params->{node} unless (defined $node);
  0            
400 0 0         my $expanded = shift; $expanded = $self->c->req->params->{expanded} unless (defined $expanded);
  0            
401            
402             # -- Handle optional batched updates:
403 0 0 0       if (ref($node) eq 'ARRAY' or ref($expanded) eq 'ARRAY') {
404 0 0 0       die "batch expand_node update data mismatch" unless (
      0        
405             ref($node) eq 'ARRAY' and
406             ref($expanded) eq 'ARRAY' and
407             scalar @$node == scalar @$expanded #<-- both should be arrays of equal length
408             );
409            
410 0           my $num = scalar @$node;
411            
412 0           for(my $i = 0; $i < $num; $i++) {
413 0           $self->call_expand_node($node->[$i],$expanded->[$i]);
414             };
415            
416             # Note: we don't actually check if this was successful on each call above...
417             # Currently we can't really do anything about it if it didn't work, the info is
418             # not important enough to subject the client to remediations/complexity. This should
419             # probably be handled properly in the future, though
420             return {
421 0           msg => 'Set Expanded State of ' . $num . ' nodes',
422             success => \1,
423             };
424             }
425             # --
426            
427 0 0 0       $expanded = 0 if ($expanded eq '0' || $expanded eq 'false');
428             return {
429 0 0         msg => 'Set Expanded',
    0          
430             success => \1,
431             } if ( $self->expand_node($node,$expanded ? 1 : 0) );
432            
433             # Doesn't do anything, informational only:
434             return {
435 0           msg => 'note: expand_node did not return true',
436             success => \0,
437             }
438             }
439              
440             sub call_copy_node {
441 0     0 0   my $self = shift;
442 0           my $node = $self->c->req->params->{node};
443 0           my $target = $self->c->req->params->{target};
444 0           my $name = $self->c->req->params->{name};
445            
446             # point and point_node will be defined for positional information, if
447             # a node is dragged in-between 2 nodes (point above/below instead of append)
448             # point_node is undef if point is append
449 0           my $point_node = $self->c->req->params->{point_node};
450 0           my $point = $self->c->req->params->{point};
451            
452 0           my $data = $self->copy_node($node,$target,$point,$point_node,$name);
453            
454 0 0 0       die "copy_node() returned invalid data" unless (ref($data) eq 'HASH' and $data->{child});
455            
456             # The config/params of the created node should have been returned in the 'child' key:
457 0 0         if ($data->{child}) {
458 0           my $n = $data->{child};
459 0 0         die "id was not returned in 'child'" unless (exists $n->{id});
460 0           $self->apply_path_specific_node_opts($target,$n);
461            
462             ## Assume the new node doesn't have any children yet and force to loaded/expanded:
463             ## (todo: it is conceivable that a new node might be created with children, add support for this in the future)
464             #$n->{loaded} = \1;
465             #$n->{expanded} = \1;
466             }
467            
468             # Setting this so it can be picked up in javascript to add the new child next to
469             # the copied node instead of within it (this logic was borrowed from add originally
470             # and extended for copy) TODO: clean up this API
471 0           $data->{child_after} = \1;
472            
473 0           return $data;
474             }
475              
476             sub call_move_node {
477 0     0 0   my $self = shift;
478 0           my $node = $self->c->req->params->{node};
479 0           my $target = $self->c->req->params->{target};
480            
481             # point and point_node will be defined for positional information, if
482             # a node is dragged in-between 2 nodes (point above/below instead of append)
483             # point_node is undef if point is append
484 0           my $point_node = $self->c->req->params->{point_node};
485 0           my $point = $self->c->req->params->{point};
486            
487             return {
488 0 0         msg => 'Moved',
489             success => \1,
490             } if ( $self->move_node($node,$target,$point,$point_node) );
491            
492 0           die usererr "Move failed!";
493             }
494              
495              
496             has 'root_node' => ( is => 'ro', lazy => 1, default => sub {
497             my $self = shift;
498             return {
499             nodeType => 'async',
500             id => $self->root_node_name,
501             text => $self->root_node_text,
502             draggable => \0
503             };
504             });
505              
506              
507              
508             # Note: the client JavaScript (AppTree) handles setup of the tbar by default, however,
509             # it can be overridden in the tbar attribute. The commented out lines are being left for reference
510             has 'tbar', is => 'ro', lazy => 1, default => sub { undef };
511              
512             #has 'tbar' => ( is => 'ro', lazy => 1, default => sub {
513             # my $self = shift;
514             # return undef;
515             # return ['->'];
516             #
517             # my $tbar = [];
518             #
519             # push @$tbar, $self->delete_button if ($self->can('delete_node'));
520             # push @$tbar, $self->add_button if ($self->can('add_node'));
521             #
522             # return undef unless (scalar @$tbar > 0);
523             #
524             # unshift @$tbar, '->';
525             #
526             # return $tbar;
527             #});
528             #
529             #
530             #sub add_button {
531             # my $self = shift;
532             #
533             # return RapidApp::JSONFunc->new(
534             # func => 'new Ext.Button',
535             # parm => {
536             # text => $self->add_button_text,
537             # iconCls => $self->add_button_iconCls,
538             # handler => RapidApp::JSONFunc->new(
539             # raw => 1,
540             # func => 'function(btn) { ' .
541             # 'var tree = btn.ownerCt.ownerCt;'.
542             # 'tree.nodeAdd();' .
543             # #'tree.nodeAdd(tree.activeNonLeafNode());' .
544             # '}'
545             # )
546             # });
547             #}
548             #
549             #
550             #sub delete_button {
551             # my $self = shift;
552             #
553             # return RapidApp::JSONFunc->new(
554             # func => 'new Ext.Button',
555             # parm => {
556             # tooltip => $self->delete_button_text,
557             # iconCls => $self->delete_button_iconCls,
558             # handler => RapidApp::JSONFunc->new(
559             # raw => 1,
560             # func => 'function(btn) { ' .
561             # 'var tree = btn.ownerCt.ownerCt;'.
562             # 'tree.nodeDelete(tree.getSelectionModel().getSelectedNode());' .
563             # #'Ext.ux.RapidApp.AppTree.del(tree,"' . $self->suburl('/delete') . '");' .
564             #
565             # '}'
566             # )
567             # });
568             #}
569             #
570              
571              
572              
573             #### --------------------- ####
574              
575              
576             #no Moose;
577             #__PACKAGE__->meta->make_immutable;
578             1;