add a proof-of-concept version of Mojo::File for easier decision making

mojolicious · Jan 2, 2017 · e4f7a5b · e4f7a5b
1 parent 62aa528
commit e4f7a5b
Show file tree

Hide file tree

Showing 5 changed files with 151 additions and 10 deletions.
diff --git a/lib/Mojo/Asset/File.pm b/lib/Mojo/Asset/File.pm
@@ -4,9 +4,9 @@ use Mojo::Base 'Mojo::Asset';
 use Carp 'croak';
 use Errno 'EEXIST';
 use Fcntl qw(O_APPEND O_CREAT O_EXCL O_RDONLY O_RDWR);
-use File::Copy 'move';
-use File::Spec::Functions 'catfile';
+use File::Spec;
 use IO::File;
+use Mojo::File;
 use Mojo::Util 'md5_sum';
 
 has [qw(cleanup path)];
@@ -22,7 +22,7 @@ has handle => sub {
   }
 
   # Open new or temporary file
-  my $base = catfile $self->tmpdir, 'mojo.tmp';
+  my $base = Mojo::File->new($self->tmpdir, 'mojo.tmp')->to_string;
   my $name = $path // $base;
   until ($handle->open($name, O_APPEND | O_CREAT | O_EXCL | O_RDWR)) {
     croak qq{Can't open file "$name": $!} if defined $path || $! != $!{EEXIST};
@@ -35,7 +35,7 @@ has handle => sub {
 
   return $handle;
 };
-has tmpdir => sub { $ENV{MOJO_TMPDIR} || File::Spec::Functions::tmpdir };
+has tmpdir => sub { $ENV{MOJO_TMPDIR} || File::Spec->tmpdir };
 
 sub DESTROY {
   my $self = shift;
@@ -113,8 +113,7 @@ sub move_to {
   delete $self->{handle};
 
   # Move file and prevent clean up
-  my $from = $self->path;
-  move($from, $to) or croak qq{Can't move file "$from" to "$to": $!};
+  Mojo::File->new($self->path)->move_to($to);
   return $self->path($to)->cleanup(0);
 }
 

diff --git a/lib/Mojo/File.pm b/lib/Mojo/File.pm
@@ -0,0 +1,77 @@
+package Mojo::File;
+use Mojo::Base -strict;
+use overload
+  '@{}'    => sub { shift->to_array },
+  bool     => sub {1},
+  '""'     => sub { ${$_[0]} },
+  fallback => 1;
+
+use Carp 'croak';
+use Cwd qw(abs_path getcwd);
+use Exporter 'import';
+use File::Basename ();
+use File::Copy     ();
+use File::Path     ();
+use File::Spec;
+use File::Temp ();
+use Mojo::Util;
+use Scalar::Util 'blessed';
+
+our @EXPORT_OK = ('path', 'tempdir');
+
+sub basename { path(File::Basename::basename ${shift()}) }
+
+sub child { path(shift()->to_string, @_) }
+
+sub dirname { path(File::Basename::dirname ${shift()}) }
+
+sub make_path {
+  my $self = shift;
+  File::Path::make_path $$self, @_
+    or croak qq{Can't make directory "$$self": $!};
+  return $self;
+}
+
+sub move_to {
+  my ($self, $to) = @_;
+  File::Copy::move($$self, $to)
+    or croak qq{Can't move file "$$self" to "$to": $!};
+  return path($to);
+}
+
+sub new {
+  my $class = shift;
+  my $self = bless \my $dummy, ref $class || $class;
+
+  unless (@_) { $$self = getcwd }
+
+  elsif (blessed $_[0] && $_[0]->isa('File::Temp::Dir')) { $$self = $_[0] }
+
+  else { $$self = File::Spec->catfile(@_) }
+
+  return $self;
+}
+
+sub path { __PACKAGE__->new(@_) }
+
+sub slurp { Mojo::Util::slurp ${shift()} }
+
+sub spurt {
+  my $self = shift;
+  Mojo::Util::spurt shift, $$self;
+  return $self;
+}
+
+sub tap { shift->Mojo::Base::tap(@_) }
+
+sub tempdir { path(File::Temp->newdir(@_)) }
+
+sub to_abs { path(abs_path ${shift()}) }
+
+sub to_array { [File::Spec->splitdir(${shift()})] }
+
+sub to_rel { path(File::Spec->abs2rel(${shift()}, shift)) }
+
+sub to_string {"${$_[0]}"}
+
+1;
diff --git a/lib/Mojo/IOLoop/Server.pm b/lib/Mojo/IOLoop/Server.pm
@@ -2,9 +2,8 @@ package Mojo::IOLoop::Server;
 use Mojo::Base 'Mojo::EventEmitter';
 
 use Carp 'croak';
-use File::Basename 'dirname';
-use File::Spec::Functions 'catfile';
 use IO::Socket::IP;
+use Mojo::File 'path';
 use Mojo::IOLoop;
 use Scalar::Util 'weaken';
 use Socket qw(IPPROTO_TCP TCP_NODELAY);
@@ -18,8 +17,8 @@ use constant TLS_WRITE => TLS ? IO::Socket::SSL::SSL_WANT_WRITE() : 0;
 
 # To regenerate the certificate run this command (18.04.2012)
 # openssl req -new -x509 -keyout server.key -out server.crt -nodes -days 7300
-my $CERT = catfile dirname(__FILE__), 'resources', 'server.crt';
-my $KEY  = catfile dirname(__FILE__), 'resources', 'server.key';
+my $CERT = path(__FILE__)->dirname->child('resources', 'server.crt')->to_string;
+my $KEY  = path(__FILE__)->dirname->child('resources', 'server.key')->to_string;
 
 has reactor => sub { Mojo::IOLoop->singleton->reactor };
 

diff --git a/lib/ojo.pm b/lib/ojo.pm
@@ -5,6 +5,7 @@ use Benchmark qw(timeit timestr :hireswallclock);
 use Mojo::ByteStream 'b';
 use Mojo::Collection 'c';
 use Mojo::DOM;
+use Mojo::File 'path';
 use Mojo::JSON 'j';
 use Mojo::Util qw(dumper monkey_patch);
 
@@ -28,6 +29,7 @@ sub import {
     b => \&b,
     c => \&c,
     d => sub { _request($ua, 'DELETE', @_) },
+    f => \&path,
     g => sub { _request($ua, 'GET',    @_) },
     h => sub { _request($ua, 'HEAD',   @_) },
     j => \&j,
@@ -122,6 +124,12 @@ Turn list into a L<Mojo::Collection> object.
 Perform C<DELETE> request with L<Mojo::UserAgent/"delete"> and return resulting
 L<Mojo::Message::Response> object.
 
+=head2 f
+
+  my $path = f('/home/sri/foo.txt');
+
+Turn string into a L<Mojo::File> object.
+
 =head2 g
 
   my $res = g('example.com');

diff --git a/t/mojo/file.t b/t/mojo/file.t
@@ -0,0 +1,58 @@
+use Mojo::Base -strict;
+
+use Test::More;
+use Cwd qw(abs_path getcwd);
+use File::Basename qw(basename dirname);
+use File::Spec::Functions qw(abs2rel catfile splitdir);
+use Mojo::File qw(path tempdir);
+
+# Constructor
+is(Mojo::File->new, getcwd(), 'same path');
+is path(), getcwd(), 'same path';
+is path()->to_string, getcwd(), 'same path';
+is path('/foo/bar'), catfile('/foo/bar'), 'same path';
+is path('foo', 'bar', 'baz'), catfile('foo', 'bar', 'baz'), 'same path';
+
+# Children
+is path('foo', 'bar')->child('baz', 'yada'),
+  catfile(catfile('foo', 'bar'), 'baz', 'yada'), 'same path';
+
+# Array
+is_deeply path('foo', 'bar')->to_array, [splitdir catfile('foo', 'bar')],
+  'same structure';
+is_deeply [@{path('foo', 'bar')}], [splitdir catfile('foo', 'bar')],
+  'same structure';
+
+# Absolute
+is path('file.t')->to_abs, abs_path('file.t'), 'same path';
+
+# Relative
+is path('test.txt')->to_abs->to_rel(getcwd),
+  abs2rel(abs_path('test.txt'), getcwd), 'same path';
+
+# Basename
+is path('file.t')->to_abs->basename, basename(abs_path 'file.t'), 'same path';
+
+# Dirname
+is path('file.t')->to_abs->dirname, dirname(abs_path 'file.t'), 'same path';
+
+# Temporary directory
+my $dir  = tempdir;
+my $path = "$dir";
+ok -d $path, 'directory exists';
+undef $dir;
+ok !-d $path, 'directory does not exist anymore';
+
+# Make path
+$dir = tempdir;
+my $subdir = $dir->child('foo', 'bar');
+ok !-d $subdir, 'directory does not exist anymore';
+$subdir->make_path;
+ok -d $subdir, 'directory exists';
+
+# I/O
+$dir = tempdir;
+my $file = $dir->child('test.txt')->spurt('just works!');
+is $file->slurp, 'just works!', 'right content';
+
+done_testing();