Commits

shl...@6f433eb9-a002-0410-945b-ee5462c261ee  committed 7f1a678

Merged from the experimental-optimizations-1 branch.

Merged from:

svn+ssh://nanardon.zarb.org/home/svn/File-Find-Object/branches/experimental-optimizations-1 .

  • Participants
  • Parent commits 74e1db1

Comments (0)

Files changed (6)

     'module_name' => "File::Find::Object",
     'requires' =>
     {
-        'Class::Accessor' => 0,
+        'Class::XSAccessor' => 0,
     },
     'license' => "perl",
 );
+    - Converted the accessor generator to Class::XSAccessor instead
+    of Class::Accessor. After consulting Devel::NYTProf, it seemed that
+    the majority of the time of a simple File-Find-Object scan was spent
+    in Class::Accessor. Hopefully, this will make F-F-O run faster.
+    - A small optimization - added a flag to $self with whether the stack
+    is full or not. This is used inside _top_it() and _is_top().
+    - A small optimization - implemented _current directly instead of
+    a _top / _non_top version - saved 2.5 seconds of runtime.
+    - A small optimization - got rid of _current_components_copy() (which
+    was useless because _current_components already returns a dynamic
+    reference) and replaced all calls with calls to _current_components().
+    - A small optimization - ->dir() instead of ->_dir_copy() for 
+    a function whose return value is dereferenced and flatted.
+    - A small optimization - now caching the results of _current_components
+    inside an accessor and updating it upon every change.
+    - A small optimization - now caching the results of _current_path()
+    upon every modification of _current_components, so File::Spec->catfile()
+    won't be called excessively.
+    - Optimization/Refactoring - changed the actions() handling so instead
+    of having the indices, we calculate an array of master actions at
+    start that correspond with the depth() parameter, and then assign it for
+    each PathComponent object in turn based on $top. This is instead of 
+    the indexes and explicit calculations etc., which was both messier
+    and slower.
+    - Optimization/Refactoring - renamed _current_components() to
+    _curr_comps() and _current_path to _curr_path() to make them
+    shorter and faster. Added a comment explaining what they are.
+    - Optimization/Refactoring - optimized _calc_current_item_obj.
+    - Optimization - removed an _is_top() conditional in _recurse() that
+    was likely not to be evaluated, by re-arranging the order of _mystat
+    call. Now _mystat is not an action, but rather called explicitly.
+    _is_top() is now PODded-out because it's not used.
+
 0.1.5 - Sat Jan  3 17:17:31 IST 2009
     - Unified the two calls to stat() (and several calls to other file
     operators) in order to reduce the number of system calls/disk accesses
     VERSION_FROM => 'lib/File/Find/Object.pm',
     PREREQ_PM =>
     {
-        'Class::Accessor' => 0,
+        'Class::XSAccessor' => 0,
     },
     PL_FILES => {},
 );

File lib/File/Find/Object.pm

 
 use File::Spec;
 
-
 sub new {
     my ($class, $top, $from, $index) = @_;
 
     my $self = {};
     bless $self, $class;
 
-    $self->_dir($top->_current_components_copy());
+    $self->_dir([ @{$top->_curr_comps()} ]);
     $self->_stat_ret($top->_top_stat_copy());
 
     $self->idx($index);
 
     $from->_dir($self->_dir_copy());
 
-    $self->_reset_actions();
+    $top->_fill_actions($self);
+
+    push @{$top->_curr_comps()}, "";
 
     return $top->_open_dir() ? $self : undef;
 }
             $top->_father($self)->_next_traverse_to()
        )))
     {
-        $self->_reset_actions();
+        $top->_curr_comps()->[-1] = $self->_curr_file();
+        $top->_calc_curr_path();
+
+        $top->_fill_actions($self);
+        $top->_mystat();
+
         return 1;
-    } else {
+    }
+    else {
         return 0;
     }
 }
 
 use Fcntl ':mode';
 
-__PACKAGE__->mk_accessors(qw(
-    _dir_stack
-    item_obj
-    _targets
-    _target_index
-    _top_stat
-));
-
 sub _get_options_ids
 {
     my $class = shift;
     )];
 }
 
-__PACKAGE__->mk_accessors(@{__PACKAGE__->_get_options_ids()});
+# _curr_comps are the components (comps) of the master object's current path.
+# _curr_path is the concatenated path itself.
+
+use Class::XSAccessor
+    accessors => {
+        (map { $_ => $_ } 
+        (qw(
+            _curr_comps
+            _curr_path
+            _def_actions
+            _dir_stack
+            item_obj
+            _targets
+            _target_index
+            _top_stat
+            ), 
+            @{__PACKAGE__->_get_options_ids()}
+        )
+        )
+    }
+    ;
 
 # This is a variation of the Conditional-to-Inheritance refactoring - 
 # we have two methods - one if _is_top is true
                 my $non = "_non_top_$m";
                 sub {
                     my $self = shift;
-                    return $self->_is_top()
-                        ? $self->$top(@_)
-                        : $self->$non(@_)
+                    return exists($self->{_st})
+                        ? $self->$non(@_)
+                        : $self->$top(@_)
                         ;
                 };
             };
 
 __PACKAGE__->_top_it([qw(
     _check_subdir_helper
-    _current
     _father_components
     _me_die
     )]
 );
 
 __PACKAGE__->_make_copy_methods([qw(
-    _current_components
     _top_stat
     )]
 );
 sub new {
     my ($class, $options, @targets) = @_;
 
+    # The *existence* of a _st key inside the struct
+    # indicates that the stack is full.
+    # So now it's empty.
     my $tree = {
-        
         _dir_stack => [],
+        _curr_comps => [],
     };
 
     bless($tree, $class);
 
     foreach my $opt (@{$tree->_get_options_ids()})
     {
-        $tree->set($opt, $options->{$opt});
+        $tree->$opt($options->{$opt});
     }
     $tree->_targets(\@targets);
     $tree->_target_index(-1);
-    $tree->_reset_actions();
+
+    $tree->_calc_default_actions();
+
+    $tree->_fill_actions($tree);
 
     $tree->_last_dir_scanned(undef);
 
 #    printf STDERR "destroy `%s'\n", $self->_dir_as_string || "--";
 #}
 
-sub _top__current
+sub _current
 {
     my $self = shift;
 
-    return $self;
+    return $self->_dir_stack->[-1] || $self;
 }
 
-sub _non_top__current
-{
-    my $self = shift;
+=begin Removed
 
-    return $self->_dir_stack->[-1];
-}
+# We're removing this because it's no longer used, but may be used in the
+# future.
 
 sub _is_top
 {
     my $self = shift;
 
-    return ! @{$self->_dir_stack()};
+    return ! exists($self->{_st});
 }
 
+=end Removed
+
+=cut
+
 sub _curr_mode {
     return shift->_top_stat->[2];
 }
     return !S_ISDIR( shift->_curr_mode() );
 }
 
-sub _current_path
+# Calculates _curr_path from $self->_curr_comps().
+# Must be called whenever _curr_comps is modified.
+sub _calc_curr_path
 {
     my $self = shift;
 
-    return File::Spec->catfile(@{$self->_current_components_copy()});
+    $self->_curr_path(File::Spec->catfile(@{$self->_curr_comps()}));
+
+    return;
 }
 
 sub _calc_current_item_obj {
     my $self = shift;
 
-    my $components = $self->_current_components_copy();
-    my $base = shift(@$components);
-    my $stat = $self->_top_stat_copy();
+    my @comps = @{$self->_curr_comps()};
 
-    my $path = $self->_current_path();
+    my $ret =
+    {
+        path => scalar($self->_curr_path()),
+        dir_components => \@comps,
+        base => shift(@comps),
+        stat_ret => scalar($self->_top_stat_copy()),
+    };
 
-    my @basename = ();
     if ($self->_curr_not_a_dir())
     {
-        @basename = (basename => pop(@$components));
+        $ret->{basename} = pop(@comps);
     }
 
-    return File::Find::Object::Result->new(
-        {
-            @basename,
-            path => $path,
-            dir_components => $components,
-            base => $base,
-            stat_ret => $stat,
-        }
-    );
+    return File::Find::Object::Result->new($ret);
 }
 
 sub _calc_next_obj {
 {
     my $self = shift; 
 
-    return $self->_curr_file($self->_calc_next_target());
+    my $target = $self->_curr_file($self->_calc_next_target());
+    @{$self->_curr_comps()} = ($target);
+    $self->_calc_curr_path();
+
+    return $target;
 }
 
 sub _move_next
     {
         if (-e $self->_move_to_next_target())
         {
-            $self->_reset_actions();
+            $self->_fill_actions($self);
+            $self->_mystat();
+            $self->_stat_ret($self->_top_stat_copy());
             return 1;
         }
     }
 
     my $father = $self->_current_father;
 
+    my $st = $self->_dir_stack();
+
     if ($self eq $father)
     {
-        @{$self->_dir_stack()} = ();
+        @$st = ();
+        delete($self->{_st});
     }
     else
     {
-        while (scalar(@{$self->_dir_stack()}) != $father->idx() + 1)
+        splice(@$st, $father->idx()+1);
+        splice(@{$self->_curr_comps()}, $father->idx()+2);
+        
+        # If depth is false, then we no longer need the _curr_path
+        # of the directories above the previously-set value, because we 
+        # already traversed them.
+        if ($self->depth())
         {
-            $self->_pop_item();
+            $self->_calc_curr_path();
         }
     }
 
     return 0;
 }
 
-sub _pop_item
-{
+sub _calc_default_actions {
     my $self = shift;
 
-    pop(@{$self->_dir_stack()});
+    my @actions = qw(_handle_callback _recurse);
+
+    $self->_def_actions(
+        [($self->depth() ? reverse(@actions) : @actions)]
+    );
 
     return;
 }
 
-sub _calc_actions
-{
+sub _fill_actions {
     my $self = shift;
+    my $other = shift;
 
-    my @actions = qw(_handle_callback _recurse);
+    $other->_actions([ @{$self->_def_actions()} ]);
 
-    if ($self->depth())
-    {
-        @actions = reverse(@actions);
-    }
-    return ("_mystat", @actions);
+    return;
 }
 
 sub _mystat {
     my $self = shift;
 
-    $self->_top_stat([stat($self->_current_path())]);
+    $self->_top_stat([stat($self->_curr_path())]);
 
     return "SKIP";
 }
 
-sub _get_real_action
-{
-    my $self = shift;
-    my $action = shift;
-
-    return ($self->_calc_actions())[$action];
-}
-
-sub _shift_current_action
-{
+sub _next_action {
     my $self = shift;
 
-    my $action_proto = shift(@{$self->_current->_actions()});
-
-    if (!defined($action_proto))
-    {
-        return;
-    }
-    else
-    {
-        return $self->_get_real_action($action_proto);
-    }
+    return shift(@{$self->_current->_actions()});
 }
 
 sub _check_process_current {
     $self->item_obj($self->_calc_current_item_obj());
 
     if ($self->callback()) {
-        $self->callback()->($self->_current_path());
+        $self->callback()->($self->_curr_path());
     }
 
     return 1;
 {
     my $self = shift;
 
-    while (my $action = $self->_shift_current_action())
+    while (my $action = $self->_next_action())
     {
         my $status = $self->$action();
 
             scalar(@{$self->_dir_stack()})
         );
 
+    $self->{_st} = 1;
+
     return 0;
 }
 
     my $self = shift;
 
     return defined($self->filter()) ?
-        $self->filter()->($self->_current_path()) :
+        $self->filter()->($self->_curr_path()) :
         1;
 }
 
     # If current is not a directory always return 0, because we may
     # be asked to traverse single-files.
 
-    if ($self->_is_top()) {
-        # Assign to _stat_ret as well, so the _stat_ret field of the top
-        # item will be set.    
-        $self->_stat_ret($self->_top_stat_copy());
-    }
-
     if ($self->_curr_not_a_dir())
     {
         return 0;
     printf(STDERR
         "Avoid loop %s => %s\n",
             $ptr->_dir_as_string(),
-            $self->_current_path()
+            $self->_curr_path()
         );
 
     return;
     return 1;
 }
 
-sub _current_components {
-    my $self = shift;
-
-    return
-    [
-        @{$self->_father_components()},
-        $self->_current->_curr_file
-    ];
-}
-
-sub _top__father_components {
-    my $self = shift; 
-
-    return [];
-}
-
-sub _non_top__father_components
-{
-    my $self = shift;
-
-    return $self->_current_father->_dir_copy();
-}
-
 sub _open_dir {
     my $self = shift;
 
 {
     my $self = shift;
 
-    $self->_current->_dir($self->_current_components_copy());
+    $self->_current->_dir($self->_curr_comps());
 
     # _open_dir can return undef if $self->_current is not a directory.
     if ($self->_open_dir())

File lib/File/Find/Object/Base.pm

 use strict;
 use warnings;
 
-use base 'Class::Accessor';
+use Class::XSAccessor
+	accessors => {
+        (map
+            { $_ => $_ }
+            (qw(
+                _actions
+                _curr_file
+                _dir
+                _files
+                idx
+                _last_dir_scanned
+                _open_dir_ret
+                _stat_ret
+                _traverse_to
+            ))
+        ) 
+    }
+    ;
 
 use File::Spec;
 
-__PACKAGE__->mk_accessors(qw(
-    _actions
-    _curr_file
-    _dir
-    _files
-    idx
-    _last_dir_scanned
-    _open_dir_ret
-    _stat_ret
-    _traverse_to
-));
-
 # Create a _copy method that does a flat copy of an array returned by
 # a method as a reference.
 
     return shift->_stat_ret->[1];
 }
 
-sub _reset_actions
-{
-    my $self = shift;
-
-    $self->_actions([0,1,2]);
-}
-
 sub _dir_as_string
 {
     my $self = shift;
 
 File::Find::Object::Base - base class for File::Find::Object
 
-=head2 DESCRIPTION
+=head1 DESCRIPTION
 
 This is the base class for F::F::O classes. It only defines some accessors,
 and is for File::Find::Object's internal use.
 
+=head1 METHODS
+
+=head2 $self->idx()
+
+For internal use.
+
 =head1 SEE ALSO
 
 L<File::Find::Object>

File lib/File/Find/Object/Result.pm

 use strict;
 use warnings;
 
-use base 'Class::Accessor';
+use Class::XSAccessor
+    accessors => {
+        (map { $_ => $_ } (qw(
+        base
+        basename
+        path
+        dir_components
+        stat_ret
+        )))
+    }
+    ;
 
 use Fcntl qw(:mode);
 
-__PACKAGE__->mk_accessors(qw(
-    base
-    basename
-    path
-    dir_components
-    stat_ret
-));
+sub new
+{
+    my $class = shift;
+    my $self = shift;
+
+    bless $self, $class;
+
+    return $self;
+}
 
 sub is_dir
 {
 
 =head1 METHODS
 
+=head2 File::Find::Object::Result->new({%args});
+
+Initializes a new object from %args. For internal use.
+
 =head2 $result->base()
 
 Returns the base directory from which searching began.