[Catalyst-commits] r8903 - in trunk/Catalyst-Model-File: .
lib/Catalyst/Model t
ash at dev.catalyst.perl.org
ash at dev.catalyst.perl.org
Wed Dec 17 22:28:51 GMT 2008
Author: ash
Date: 2008-12-17 22:28:51 +0000 (Wed, 17 Dec 2008)
New Revision: 8903
Added:
trunk/Catalyst-Model-File/Changes
trunk/Catalyst-Model-File/t/07stat.t
Modified:
trunk/Catalyst-Model-File/Makefile.PL
trunk/Catalyst-Model-File/lib/Catalyst/Model/File.pm
trunk/Catalyst-Model-File/t/05cd.t
Log:
Fix issue with stat (and other operations) on results of ->list
Added: trunk/Catalyst-Model-File/Changes
===================================================================
--- trunk/Catalyst-Model-File/Changes (rev 0)
+++ trunk/Catalyst-Model-File/Changes 2008-12-17 22:28:51 UTC (rev 8903)
@@ -0,0 +1,3 @@
+0.07 -
++ Make the return from list stringify relative to cwd, but make operations
+ (open, stat, etc.) work on the actual file
Modified: trunk/Catalyst-Model-File/Makefile.PL
===================================================================
--- trunk/Catalyst-Model-File/Makefile.PL 2008-12-17 18:45:17 UTC (rev 8902)
+++ trunk/Catalyst-Model-File/Makefile.PL 2008-12-17 22:28:51 UTC (rev 8903)
@@ -2,8 +2,7 @@
name 'Catalyst-Model-File';
all_from 'lib/Catalyst/Model/File.pm';
-
-requires 'perl' => '5.8.1';
+perl_version '5.8.1';
requires 'Catalyst' => '5.69';
requires 'Catalyst::Component::InstancePerContext' => 0;
requires 'Path::Class';
Modified: trunk/Catalyst-Model-File/lib/Catalyst/Model/File.pm
===================================================================
--- trunk/Catalyst-Model-File/lib/Catalyst/Model/File.pm 2008-12-17 18:45:17 UTC (rev 8902)
+++ trunk/Catalyst-Model-File/lib/Catalyst/Model/File.pm 2008-12-17 22:28:51 UTC (rev 8903)
@@ -11,7 +11,7 @@
use Path::Class ();
use IO::File;
-our $VERSION = 0.06;
+our $VERSION = 0.07;
=head1 NAME
@@ -78,7 +78,8 @@
$mdl->list(mode => 'both')
-To only get files/dirs directly under the current dir specify a C<recurse> option of 0.
+To only get files/dirs directly under the current dir specify a C<recurse>
+option of 0.
Please note: the exact order in which files and directories are listed will
change from OS to OS.
@@ -97,14 +98,14 @@
if ($opt{recurse}) {
$self->{_dir}->recurse(callback => sub {
my ($entry) = @_;
- push @files, $entry->relative($self->{_dir})
+ push @files, $entry
if !$entry->is_dir && $opt{file}
|| $entry->is_dir && $opt{dir};
});
- return @files;
+ return map { $self->_rebless($_) } @files;
}
- @files = map {$_->relative($self->{_dir}) } $self->{_dir}->children;
+ @files = map { $self->_rebless($_) } $self->{_dir}->children;
return @files if $opt{dir} && $opt{file};
@@ -114,6 +115,21 @@
}
+sub _rebless {
+ my ($self, $entity) = @_;
+
+ $entity = $entity->absolute($self->{root_dir});
+ if ($entity->is_dir) {
+ bless $entity, 'Catalyst::Model::File::Dir';
+ }
+ else {
+ bless $entity, 'Catalyst::Model::File::File';
+ }
+
+ $entity->{stringify_as} = $entity->relative($self->{_dir})->stringify;
+ return $entity;
+}
+
=head2 change_dir
=head2 cd
@@ -197,7 +213,9 @@
=head2 $self->file($file)
-Returns an L<Path::Class::File> object of $file (which can be a string or a Class::Path::File object,) or undef if the file is an invalid path - i.e. outside the directory structure specified in the config.
+Returns an L<Path::Class::File> object of $file (which can be a string or a
+Class::Path::File object,) or undef if the file is an invalid path - i.e.
+outside the directory structure specified in the config.
=cut
@@ -220,12 +238,12 @@
Shortcut to $self->file($file)->slurp.
-In a scalar context, returns the contents of $file in a string. In a list context,
-returns the lines of $file (according to how $/ is set) as a list. If the file can't be
-read, this method will throw an exception.
+In a scalar context, returns the contents of $file in a string. In a list
+context, returns the lines of $file (according to how $/ is set) as a list. If
+the file can't be read, this method will throw an exception.
-If you want "chomp()" run on each line of the file, pass a true value for the "chomp" or
-"chomped" parameters:
+If you want "chomp()" run on each line of the file, pass a true value for the
+"chomp" or "chomped" parameters:
my @lines = $self->slurp($file, chomp => 1);
@@ -240,7 +258,8 @@
=head2 $self->splat($file, PRINT_ARGS)
-Does a print to C<$file> with the specified C<PRINT_ARGS>. Does the same as C<$self->file->openw->print(@_)>
+Does a print to C<$file> with the specified C<PRINT_ARGS>. Does the same as
+C<$self->file->openw->print(@_)>
=cut
@@ -250,7 +269,53 @@
$file->openw->print(@_);
}
+package #
+ Catalyst::Model::File::File;
+use base 'Path::Class::File';
+sub stringify {
+ return $_[0]->{stringify_as} || $_[0]->abs_stringify;
+}
+sub abs_stringify {
+ Path::Class::File::stringify(shift)
+}
+
+# All these would probably be better done with Moose or something, but i'm lazy
+sub open {
+ my $s = shift;
+ local $s->{stringify_as};
+ return $s->SUPER::open(@_);
+}
+
+sub touch {
+ my $s = shift;
+ local $s->{stringify_as};
+ return $s->SUPER::touch(@_);
+}
+
+sub remove {
+ my $s = shift;
+ local $s->{stringify_as};
+ return $s->SUPER::touch(@_);
+}
+
+sub stat {
+ my $s = shift;
+ local $s->{stringify_as};
+ return $s->SUPER::stat(@_);
+}
+sub lstat {
+ my $s = shift;
+ local $s->{stringify_as};
+ return $s->SUPER::lstat(@_);
+}
+
+ at Catalyst::Model::File::Dir::ISA = 'Path::Class::Dir';
+sub Catalyst::Model::File::Dir::stringify {
+ return $_[0]->{stringify_as}
+ || Path::Class::Dir::stringify($_[0]);
+}
+
=head1 AUTHOR
Ash Berlin, C<ash at cpan.org>
Modified: trunk/Catalyst-Model-File/t/05cd.t
===================================================================
--- trunk/Catalyst-Model-File/t/05cd.t 2008-12-17 18:45:17 UTC (rev 8902)
+++ trunk/Catalyst-Model-File/t/05cd.t 2008-12-17 22:28:51 UTC (rev 8903)
@@ -30,21 +30,21 @@
$model->cd('sub', 'dir');
-is(Path::Class::dir('/sub/dir'), $model->pwd, "pwd is correct");
+is($model->pwd, Path::Class::dir('/sub/dir'), "pwd is correct");
-is_deeply([
- Path::Class::file('file.txt')
- ],
- [ $model->list ], "list right after cd");
+is_deeply(
+ [ $model->list ],
+ [ Path::Class::file('file.txt') ],
+ "list right after cd");
$model->cd('..', 'foo');
-is(Path::Class::dir('/sub/foo'), $model->pwd, "pwd right after cd('..')");
+is($model->pwd, Path::Class::dir('/sub/foo'), "pwd right after cd('..')");
-is(Path::Class::dir('/sub'), $model->parent->pwd, "Parent right");
-is(Path::Class::dir('/'), $model->parent->pwd, "Parent right");
-is(Path::Class::dir('/'), $model->parent->pwd, "Parent doesn't go out of root");
+is($model->parent->pwd, Path::Class::dir('/sub'), "Parent right");
+is($model->parent->pwd, Path::Class::dir('/'), "Parent right");
+is($model->parent->pwd, Path::Class::dir('/'), "Parent doesn't go out of root");
is_deeply([
Path::Class::file('sub/dir/file.txt')
Added: trunk/Catalyst-Model-File/t/07stat.t
===================================================================
--- trunk/Catalyst-Model-File/t/07stat.t (rev 0)
+++ trunk/Catalyst-Model-File/t/07stat.t 2008-12-17 22:28:51 UTC (rev 8903)
@@ -0,0 +1,40 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+plan tests => 5;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+
+$ENV{MODEL_FILE_DIR} = $FindBin::Bin . '/store';
+{
+ require Path::Class;
+ Path::Class::dir($ENV{MODEL_FILE_DIR})->rmtree;
+}
+
+use_ok('Catalyst::Model::File');
+use_ok('TestApp');
+
+
+ok(-d $ENV{MODEL_FILE_DIR}, 'Store directory exists');
+
+open my $fh, '>>', $ENV{MODEL_FILE_DIR} . '/foo1';
+print $fh '1234';
+close $fh;
+
+my $model = TestApp->model('File');
+
+my @files_from_model = sort $model->list(
+ mode => 'files',
+);
+
+for my $file (@files_from_model) {
+ my $st = $file->stat;
+ ok(defined $st && $st->isa('File::stat'), 'Stat works on file from model');
+ ok(defined $st && $st->size == 4, 'Got correct size from stat');
+}
+
+$model->{root_dir}->rmtree;
More information about the Catalyst-commits
mailing list