Commits

shl...@52c325ad-5fd0-0310-8a0f-c43feede02cc  committed 2e4afc7

Started implementing File::Dir::Dumper::Scanner.

It does the actual traversal.

  • Participants
  • Parent commits 7b978aa

Comments (0)

Files changed (5)

File File-Dir-Dumper/MANIFEST

 inc/Test/Run/Builder.pm
 lib/File/Dir/Dumper/Base.pm
 lib/File/Dir/Dumper.pm
+lib/File/Dir/Dumper/Scanner.pm
 lib/File/Dir/Dumper/Stream/JSON/Reader.pm
 lib/File/Dir/Dumper/Stream/JSON/Writer.pm
 Makefile.PL
 README
 t/00-load.t
 t/boilerplate.t
+t/dumper.t
+t/lib/File/Find/Object/TreeCreate.pm
 t/pod-coverage.t
 t/pod.t
+t/sample-data/placeholder.txt
 t/test-stream.t

File File-Dir-Dumper/lib/File/Dir/Dumper/Scanner.pm

+package File::Dir::Dumper::Scanner;
+
+use warnings;
+use strict;
+
+use base 'File::Dir::Dumper::Base';
+
+use Carp;
+
+use File::Find::Object;
+
+use POSIX qw(strftime);
+
+__PACKAGE__->mk_accessors(
+    qw(
+    _file_find
+    _queue
+    _last_result
+    )
+);
+
+=head1 NAME
+
+File::Dir::Dumper::Scanner - scans a directory and returns a stream of Perl
+hash-refs
+
+=head1 VERSION
+
+Version 0.0.1
+
+=cut
+
+our $VERSION = '0.0.1';
+
+=head1 SYNOPSIS
+
+    use File::Dir::Dumper::Scanner;
+
+    my $writer = File::Dir::Dumper::Scanner->new(
+        {
+            dir => $dir_pathname
+        }
+    );
+
+    while (defined(my $token = File::Dir::Dumper::Scanner->fetch()))
+    {
+    }
+
+=head1 METHODS
+
+=head2 $self->new({ dir => $dir_path})
+
+Scans the directory $dir_path.
+
+=head2 my $hash_ref = $self->fetch()
+
+Outputs the next token as a hash ref.
+
+=cut
+
+sub _init
+{
+    my $self = shift;
+    my $args = shift;
+
+    my $dir_to_dump = $args->{dir};
+
+    $self->_file_find(
+        File::Find::Object->new(
+            {
+                followlink => 0,
+            },
+            $dir_to_dump,
+        )
+    );
+
+    $self->_queue([]);
+
+    push @{$self->_queue()}, { type => "header", dir_to_dump => $dir_to_dump};
+    
+    return;
+}
+
+sub fetch
+{
+    my $self = shift;
+
+    if (! @{$self->_queue()})
+    {
+        $self->_populate_queue();
+    }
+
+    return shift(@{$self->_queue()});
+}
+
+sub _populate_queue
+{
+    my $self = shift;
+
+    my $result = $self->_file_find->next_obj();
+
+    my $last_result = $self->_last_result();
+
+    if (! $last_result)
+    {
+        push @{$self->_queue()}, { type => "dir", depth => 0 };
+    }
+    else
+    {
+        if (! $result->is_dir())
+        {
+            my @stat = stat($result->path());
+            push @{$self->_queue()},
+                {
+                    type => "file",
+                    filename => $result->basename(),
+                    mtime => strftime("%Y-%m-%dT%H:%M:%S", localtime($stat[9])),
+                    depth => scalar(@{$result->full_components()}),
+                };
+        }
+    }
+
+    $self->_last_result($result);
+}
+
+=head1 AUTHOR
+
+Shlomi Fish, C<< <shlomif@cpan.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-file-dir-dumper at rt.cpan.org>, or through
+the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=File-Dir-Dumper>.  I will be notified, and then you'll
+automatically be notified of progress on your bug as I make changes.
+
+
+
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc File::Dir::Dumper
+
+
+You can also look for information at:
+
+=over 4
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Dir-Dumper>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/File-Dir-Dumper>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/File-Dir-Dumper>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/File-Dir-Dumper>
+
+=back
+
+
+=head1 ACKNOWLEDGEMENTS
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 Shlomi Fish, all rights reserved.
+
+This program is released under the following license: MIT/X11 Licence.
+
+=cut
+
+1; # End of File::Dir::Dumper

File File-Dir-Dumper/t/dumper.t

+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+
+use POSIX qw(mktime strftime);
+use File::Path;
+
+use File::Spec;
+use lib File::Spec->catdir(File::Spec->curdir(), "t", "lib");
+
+use File::Find::Object::TreeCreate;
+
+use File::Dir::Dumper::Scanner;
+
+
+{
+    my $tree =
+    {
+        'name' => "traverse-1/",
+        'subs' =>
+        [
+            {
+                'name' => "a.doc",
+                'contents' => "This file was spotted in the wild.",
+            },            
+            {
+                'name' => "b/",
+            },
+            {
+                'name' => "foo/",
+                'subs' =>
+                [
+                    {
+                        'name' => "yet/",
+                    },
+                ],
+            },
+        ],
+    };
+
+    my $t = File::Find::Object::TreeCreate->new();
+    $t->create_tree("./t/sample-data/", $tree);
+
+    my $test_dir = "t/sample-data/traverse-1";
+
+    my $a_doc_time = mktime(1, 2, 3, 4, 5, 106);
+    utime($a_doc_time, $a_doc_time, $t->get_path("$test_dir/a.doc"));
+
+    my $scanner = File::Dir::Dumper::Scanner->new(
+        {
+            dir => $t->get_path($test_dir),
+        }
+    );
+
+    my $token;
+
+    $token = $scanner->fetch();
+
+    # TEST
+    is ($token->{type}, "header", "Token is of type header");
+
+    # TEST
+    is ($token->{dir_to_dump}, $t->get_path($test_dir), 
+        "dir_to_dump is OK."
+    );
+
+    $token = $scanner->fetch();
+
+    # TEST
+    is ($token->{type}, "dir", "type is dir");
+
+    # TEST
+    is ($token->{depth}, 0, "depth is 0");
+
+    $token = $scanner->fetch();
+
+    # TEST
+    is ($token->{type}, "file", "Type is file");
+
+    # TEST
+    is ($token->{filename}, "a.doc", "Filename is OK.");
+
+    # TEST
+    is ($token->{mtime}, 
+        strftime("%Y-%m-%dT%H:%M:%S", localtime($a_doc_time)),
+        "mtime is OK.",
+    );
+
+    # TEST
+    is ($token->{depth}, 1, "Token depth is 1");
+
+    rmtree($t->get_path($test_dir))
+}

File File-Dir-Dumper/t/lib/File/Find/Object/TreeCreate.pm

+package File::Find::Object::TreeCreate;
+
+use strict;
+use warnings;
+
+use File::Spec;
+
+sub new
+{
+    my $class = shift;
+    my $self = {};
+    bless $self, $class;
+    $self->_initialize(@_);
+    return $self;
+}
+
+sub _initialize
+{
+}
+
+sub get_path
+{
+    my $self = shift;
+    my $path = shift;
+
+    my @components;
+
+    if ($path =~ s{^\./}{})
+    {
+        push @components, File::Spec->curdir();
+    }
+    
+    my $is_dir = ($path =~ s{/$}{});
+    push @components, split(/\//, $path);
+    if ($is_dir)
+    {
+        return File::Spec->catdir(@components);
+    }
+    else
+    {
+        return File::Spec->catfile(@components);
+    }
+}
+
+sub exist
+{
+    my $self = shift;
+    return (-e $self->get_path(@_));
+}
+
+sub is_file
+{
+    my $self = shift;
+    return (-f $self->get_path(@_));
+}
+
+sub is_dir
+{
+    my $self = shift;
+    return (-d $self->get_path(@_));
+}
+
+sub cat
+{
+    my $self = shift;
+    open my $in, "<", $self->get_path(@_) or
+        return 0;
+    my $data;
+    {
+        local $/;
+        $data = <$in>;
+    }
+    close($in);
+    return $data;
+}
+
+sub ls
+{
+    my $self = shift;
+    opendir my $dir, $self->get_path(@_) or
+        return undef;
+    my @files = 
+        sort { $a cmp $b } 
+        grep { !(($_ eq ".") || ($_ eq "..")) }
+        readdir($dir);
+    closedir($dir);    
+    return \@files;
+}
+
+sub create_tree
+{
+    my ($self, $unix_init_path, $tree) = @_;
+    my $real_init_path = $self->get_path($unix_init_path);
+    return $self->_real_create_tree($real_init_path, $tree);
+}
+
+sub _real_create_tree
+{
+    my ($self, $init_path, $tree) = @_;
+    my $name = $tree->{'name'};
+    if ($name =~ s{/$}{})
+    {
+        my $dir_name = File::Spec->catfile($init_path, $name);
+        mkdir($dir_name);
+        if (exists($tree->{'subs'}))
+        {
+            foreach my $sub (@{$tree->{'subs'}})
+            {
+                $self->_real_create_tree($dir_name, $sub);
+            }
+        }
+    }
+    else
+    {
+        open my $out, ">", File::Spec->catfile($init_path, $name);
+        print {$out} +(exists($tree->{'contents'}) ? $tree->{'contents'} : "");
+        close($out);
+    }
+    return 0;
+}
+1;
+

File File-Dir-Dumper/t/sample-data/placeholder.txt

Empty file added.