File Coverage

blib/lib/Tree/Simple/Visitor/Sort.pm
Criterion Covered Total %
statement 54 54 100.0
branch 12 12 100.0
condition 7 9 77.7
subroutine 21 21 100.0
pod 8 8 100.0
total 102 104 98.0


line stmt bran cond sub pod time code
1             package Tree::Simple::Visitor::Sort;
2              
3 1     1   16914 use strict;
  1         2  
  1         22  
4 1     1   3 use warnings;
  1         1  
  1         31  
5              
6             our $VERSION = '0.15';
7              
8 1     1   3 use Scalar::Util qw(blessed);
  1         1  
  1         85  
9              
10 1     1   4 use base qw(Tree::Simple::Visitor);
  1         1  
  1         428  
11              
12             sub new {
13 5     5 1 3808 my ($_class) = @_;
14 5   33     20 my $class = ref($_class) || $_class;
15 5         5 my $visitor = {};
16 5         6 bless($visitor, $class);
17 5         8 $visitor->_init();
18 5         23 return $visitor;
19             }
20              
21             sub _init {
22 5     5   5 my ($self) = @_;
23 5         9 $self->{sort_function} = undef;
24 5         12 $self->SUPER::_init();
25             }
26              
27 2     2 1 1101 sub REVERSE { sub ($$) { $_[1]->getNodeValue() cmp $_[0]->getNodeValue() }};
  10     10   15  
28 2     2 1 42 sub NUMERIC { sub ($$) { $_[0]->getNodeValue() <=> $_[1]->getNodeValue() }};
  1     1   3  
29 2     2 1 394 sub REVERSE_NUMERIC { sub ($$) { $_[1]->getNodeValue() <=> $_[0]->getNodeValue() }};
  1     1   3  
30 2     2 1 391 sub ALPHABETICAL { sub ($$) { lc($_[0]->getNodeValue()) cmp lc($_[1]->getNodeValue()) }};
  1     1   2  
31 2     2 1 398 sub REVERSE_ALPHABETICAL { sub ($$) { lc($_[1]->getNodeValue()) cmp lc($_[0]->getNodeValue()) }};
  1     1   3  
32              
33             sub setSortFunction {
34 4     4 1 895 my ($self, $sort_function) = @_;
35 4 100 100     36 (defined($sort_function) && ref($sort_function) eq "CODE")
36             || die "Insufficient Arguments : You must supply a CODE reference for the sort function";
37 1         3 $self->{sort_function} = $sort_function;
38             }
39              
40             sub visit {
41 8     8 1 4107 my ($self, $tree) = @_;
42 8 100 100     70 (blessed($tree) && $tree->isa("Tree::Simple"))
43             || die "Insufficient Arguments : You must supply a valid Tree::Simple object";
44              
45             # No childs, nothing to sort
46 4 100       10 return if $tree->isLeaf();
47              
48 3         17 my $sort_function;
49 3 100       10 if ($self->{sort_function}) {
50 1         1 $sort_function = $self->{sort_function};
51             }
52             else {
53             # get the node filter
54 2         8 my $filter_func = $self->getNodeFilter();
55 2 100       8 if ($filter_func) {
56 1     5   3 $sort_function = sub { $filter_func->($a) cmp $filter_func->($b) };
  5         7  
57             }
58             else {
59 1     11   3 $sort_function = sub { $a->getNodeValue() cmp $b->getNodeValue() };
  11         14  
60             }
61             }
62              
63             # otherwise sort them
64 3         5 $self->_sortTree($sort_function, $tree);
65             }
66              
67             sub _sortTree {
68 16     16   63 my ($self, $sort_function, $tree) = @_;
69              
70             # sort children, using the sort filter
71 16         20 my @childs = sort { $sort_function->($a, $b) } $tree->getAllChildren();
  26         93  
72              
73             # Create the new sequence
74 16         96 foreach my $child (@childs) {
75             # get the removed child
76 39         137 $child = $tree->removeChild($child);
77             # and be sure that is the one
78             # we re-insert
79 39         2510 $tree->addChild($child);
80             # only sort the child if
81             # it is not a leaf
82 39 100       1876 $self->_sortTree($sort_function, $child) unless $child->isLeaf();
83             }
84             }
85              
86             1;
87              
88             __END__