local-lib5/lib/perl5/Tree/Simple/Visitor/LoadDirectoryTree.pm

   1
   2 package Tree::Simple::Visitor::LoadDirectoryTree;
   3
   4 use strict;
   5 use warnings;
   6
   7 our $VERSION = '0.02';
   8
   9 use File::Spec;
  10 use Scalar::Util qw(blessed);
  11
  12 use base qw(Tree::Simple::Visitor);
  13
  14 sub new {
  15     my ($_class) = @_;
  16     my $class = ref($_class) || $_class;
  17     my $visitor = {};
  18     bless($visitor, $class);
  19     $visitor->_init();
  20     return $visitor;
  21 }
  22
  23 sub _init {
  24     my ($self) = @_;
  25     $self->{sort_function} = undef;
  26     $self->SUPER::_init();
  27 }
  28
  29 # pre-built sort functions
  30 sub SORT_FILES_FIRST {
  31     return sub ($$$) {
  32         my ($path, $left, $right) = @_;
  33         $left  = File::Spec->catdir($path, $left);
  34         $right = File::Spec->catdir($path, $right);
  35         return ((-d $left && -f $right) ? 1 :       # file beats directory
  36                 (-d $right && -f $left) ? -1 :    # file beats directory
  37                     (lc($left) cmp lc($right)))     # otherwise just sort 'em
  38     }
  39 }
  40
  41 sub SORT_DIRS_FIRST {
  42     return sub ($$$) {
  43         my ($path, $left, $right) = @_;
  44         $left  = File::Spec->catdir($path, $left);
  45         $right = File::Spec->catdir($path, $right);
  46         return ((-d $left && -f $right) ? -1 :      # directory beats file
  47                 (-d $right && -f $left) ? 1 :     # directory beats file
  48                     (lc($left) cmp lc($right)))     # otherwise just sort 'em
  49     }
  50 }
  51
  52 sub setSortStyle {
  53     my ($self, $sort_function) = @_;
  54         (defined($sort_function) && ref($sort_function) eq "CODE")
  55                 || die "Insufficient Arguments : sort function argument must be a subroutine reference";
  56     $self->{sort_function} = $sort_function;
  57 }
  58
  59 sub visit {
  60         my ($self, $tree) = @_;
  61         (blessed($tree) && $tree->isa("Tree::Simple"))
  62                 || die "Insufficient Arguments : You must supply a valid Tree::Simple object";
  63     # it must be a leaf
  64     ($tree->isLeaf()) || die "Illegal Operation : The tree must be a leaf node to load a directory";
  65     # check that our directory is valid
  66     my $root_dir = $tree->getNodeValue();
  67     (-e $root_dir && -d $root_dir)
  68         || die "Incorrect Type : The tree's node value must be a valid directory";
  69     # and load it recursively
  70     $self->_recursiveLoad($tree, $root_dir);
  71 }
  72
  73 sub _recursiveLoad {
  74         my ($self, $t, $path) = @_;
  75     # get a node filter if we have one
  76     my $filter = $self->getNodeFilter();
  77
  78     # get the contents of the directory
  79     opendir(DIR, $path) || die "IO Error : Could not open directory : $!";
  80     # avoid the . and .. symbolic links
  81     my @dir_contents = grep {
  82                         $_ ne File::Spec->curdir() && $_ ne File::Spec->updir()
  83                         } readdir(DIR);
  84     close(DIR);
  85
  86     # sort them if we need to with full paths
  87     @dir_contents = sort {
  88                         $self->{sort_function}->($path, $a, $b)
  89                     } @dir_contents if $self->{sort_function};
  90
  91     # now traverse ...
  92         foreach my $item (@dir_contents) {
  93         # filter based on the item name
  94         $filter->($item) || next if defined($filter);
  95         # get the full path for checking
  96         # the item type and recursion
  97         my $full_path = File::Spec->catdir($path, $item);
  98                 if (-d $full_path) {
  99             my $new_tree = $t->new($item);
 100             $t->addChild($new_tree);
 101             $self->_recursiveLoad($new_tree, $full_path);
 102                 }
 103                 elsif (-f $full_path) {
 104             $t->addChild($t->new($item));
 105                 }
 106         }
 107 }
 108
 109 1;
 110
 111 __END__
 112
 113 =head1 NAME
 114
 115 Tree::Simple::Visitor::LoadDirectoryTree - A Visitor for loading the contents of a directory into a Tree::Simple object
 116
 117 =head1 SYNOPSIS
 118
 119   use Tree::Simple::Visitor::LoadDirectoryTree;
 120
 121   # create a Tree::Simple object whose
 122   # node is path to a directory
 123   my $tree = Tree::Simple->new("./");
 124
 125   # create an instance of our visitor
 126   my $visitor = Tree::Simple::Visitor::LoadDirectoryTree->new();
 127
 128   # set the directory sorting style
 129   $visitor->setSortStyle($visitor->SORT_FILES_FIRST);
 130
 131   # create node filter to filter
 132   # out certain files and directories
 133   $visitor->setNodeFilter(sub {
 134       my ($item) = @_;
 135       return 0 if $item =~ /CVS/;
 136       return 1;
 137   });
 138
 139   # pass the visitor to a Tree::Simple object
 140   $tree->accept($visitor);
 141
 142   # the tree now mirrors the structure of the directory
 143
 144 =head1 DESCRIPTION
 145
 146 This visitor can be used to load a directory tree into a Tree::Simple hierarchy.
 147
 148 =head1 METHODS
 149
 150 =over 4
 151
 152 =item B<new>
 153
 154 There are no arguments to the constructor the object will be in its default state. You can use the C<setNodeFilter> and C<setSortStyle> methods to customize its behavior.
 155
 156 =item B<setNodeFilter ($filter_function)>
 157
 158 This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to filter the tree nodes as they are created. The function is given the current directory or file being added to the tree, and it is expected to return either true (C<1>) of false (C<0>) to determine if that directory should be traversed or file added to the tree.
 159
 160 =item B<setSortStyle ($sort_function)>
 161
 162 This method accepts a CODE reference as its C<$sort_function> argument and throws an exception if it is not a code reference. This function is used to sort the individual levels of the directory tree right before it is added to the tree being built. The function is passed the the current path, followed by the two items being sorted. The reason for passing the path in is so that sorting operations can be performed on the entire path if desired.
 163
 164 Two pre-built functions are supplied and described below.
 165
 166 =over 4
 167
 168 =item B<SORT_FILES_FIRST>
 169
 170 This sorting function will sort files before directories, so that files are sorted alphabetically first in the list followed by directories sorted alphabetically. Here is example of how that would look:
 171
 172     Tree/
 173         Simple.pm
 174         Simple/
 175             Visitor.pm
 176             VisitorFactory.pm
 177             Visitor/
 178                 PathToRoot.pm
 179
 180 =item B<SORT_DIRS_FIRST>
 181
 182 This sorting function will sort directories before files, so that directories are sorted alphabetically first in the list followed by files sorted alphabetically. Here is example of how that would look:
 183
 184     Tree/
 185         Simple/
 186             Visitor/
 187                 PathToRoot.pm
 188             Visitor.pm
 189             VisitorFactory.pm
 190         Simple.pm
 191
 192 =back
 193
 194 =item B<visit ($tree)>
 195
 196 This is the method that is used by Tree::Simple's C<accept> method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise.
 197
 198 The node value of the C<$tree> argument (gotten by calling C<getNodeValue>) is considered the root directory from which we begin our traversal. We use File::Spec to keep our paths cross-platform, but it is expected that you will feed in a valid path for your OS. If the path either does not exist, or is not a directory, then an exception is thrown.
 199
 200 The C<$tree> argument which is passed to C<visit> must be a leaf node. This is because this Visitor will create all the sub-nodes for this tree. If the tree is not a leaf, an exception is thrown. We do not require the tree to be a root though, and this Visitor will not affect any nodes above the C<$tree> argument.
 201
 202 =back
 203
 204 =head1 BUGS
 205
 206 None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it.
 207
 208 =head1 CODE COVERAGE
 209
 210 See the B<CODE COVERAGE> section in L<Tree::Simple::VisitorFactory> for more inforamtion.
 211
 212 =head1 SEE ALSO
 213
 214 These Visitor classes are all subclasses of B<Tree::Simple::Visitor>, which can be found in the B<Tree::Simple> module, you should refer to that module for more information.
 215
 216 =head1 AUTHOR
 217
 218 stevan little, E<lt>stevan@iinteractive.comE<gt>
 219
 220 =head1 COPYRIGHT AND LICENSE
 221
 222 Copyright 2004, 2005 by Infinity Interactive, Inc.
 223
 224 L<http://www.iinteractive.com>
 225
 226 This library is free software; you can redistribute it and/or modify
 227 it under the same terms as Perl itself.
 228
 229 =cut
 230