File Coverage

blib/lib/Mojo/File.pm

Criterion	Covered	Total	%
statement	161	161	100.0
branch	62	68	91.1
condition	30	34	88.2
subroutine	53	53	100.0
pod	34	34	100.0
total	340	350	97.1

package Mojo::File;
use Mojo::Base -strict;
use overload '@{}' => sub { shift->to_array }, bool => sub {1}, '""' => sub { ${$_[0]} }, fallback => 1;

use Carp                  qw(croak);
use Cwd                   qw(getcwd);
use Exporter              qw(import);
use File::Basename        ();
use File::Copy            qw(copy move);
use File::Path            ();
use File::Spec::Functions qw(abs2rel canonpath catfile file_name_is_absolute rel2abs splitdir);
use File::stat            ();
use File::Temp            ();
use IO::File              ();
use Mojo::Collection;
use Mojo::Util qw(decode encode);

our @EXPORT_OK = ('curfile', 'path', 'tempdir', 'tempfile');

sub basename { File::Basename::basename ${shift()}, @_ }

sub child { $_[0]->new(${shift()}, @_) }

sub chmod {
  my ($self, $mode) = @_;
  chmod $mode, $$self or croak qq{Can't chmod file "$$self": $!};
  return $self;
}

sub copy_to {
  my ($self, $to) = @_;
  copy($$self, $to) or croak qq{Can't copy file "$$self" to "$to": $!};
  return $self->new(-d $to ? ($to, File::Basename::basename $self) : $to);
}

sub curfile { __PACKAGE__->new(Cwd::realpath((caller)[1])) }

sub dirname { $_[0]->new(scalar File::Basename::dirname ${$_[0]}) }

sub download {
  my ($self, $url, $options) = (shift, shift, shift // {});
  my $ua = $options->{ua}
    || do { require Mojo::UserAgent; Mojo::UserAgent->new(max_redirects => 10, max_response_size => 0) };
  my $tx = _download_error($ua->transactor->download($ua->head($url => $options->{headers} // {}), $$self));
  return $tx ? !!_download_error($ua->start($tx)) : 1;
}

sub extname { shift->basename =~ /.+\.([^.]+)$/ ? $1 : '' }

sub is_abs { file_name_is_absolute ${shift()} }

sub list {
  my ($self, $options) = (shift, shift // {});

  return Mojo::Collection->new unless -d $$self;
  opendir(my $dir, $$self) or croak qq{Can't open directory "$$self": $!};
  my @files = grep { $_ ne '.' && $_ ne '..' } readdir $dir;
  @files = grep { !/^\./ } @files unless $options->{hidden};
  @files = map  { catfile $$self, $_ } @files;
  @files = grep { !-d } @files unless $options->{dir};

  return Mojo::Collection->new(map { $self->new($_) } sort @files);
}

sub list_tree {
  my ($self, $options) = (shift, shift // {});
  return Mojo::Collection->new unless -d $$self;

  my (@results, $walk);
  $walk = sub {
    my ($path, $depth) = @_;
    opendir my $dh, $path or return;
    my @names = sort grep { $_ ne '.' && $_ ne '..' } readdir $dh;
    @names = grep { !/^\./ } @names unless $options->{hidden};
    for my $name (@names) {
      my $child  = $self->new($path, $name);
      my $is_dir = -d $$child;
      push @results, $child if $options->{dir} || !$is_dir;
      __SUB__->($$child, $depth + 1)
        if $is_dir && !-l $$child && (!$options->{max_depth} || $depth + 1 < $options->{max_depth});
    }
  };
  $walk->($$self, 0);

  return Mojo::Collection->new(@results);
}

sub lstat { File::stat::lstat(${shift()}) }

sub make_path {
  my $self = shift;
  File::Path::make_path $$self, @_;
  return $self;
}

sub move_to {
  my ($self, $to) = @_;
  move($$self, $to) or croak qq{Can't move file "$$self" to "$to": $!};
  return $self->new(-d $to ? ($to, File::Basename::basename $self) : $to);
}

sub new {
  my $class = shift;
  croak 'Invalid path' if grep { !defined } @_;
  my $value = @_ == 1 ? $_[0] : @_ > 1 ? catfile @_ : canonpath getcwd;
  return bless \$value, ref $class || $class;
}

sub open {
  my $self   = shift;
  my $handle = IO::File->new;
  $handle->open($$self, @_) or croak qq{Can't open file "$$self": $!};
  return $handle;
}

sub path { __PACKAGE__->new(@_) }

sub realpath { $_[0]->new(Cwd::realpath ${$_[0]}) }

sub remove {
  my ($self, $mode) = @_;
  unlink $$self or croak qq{Can't remove file "$$self": $!} if -e $$self;
  return $self;
}

sub remove_tree {
  my $self = shift;
  File::Path::remove_tree $$self, @_;
  return $self;
}

sub sibling {
  my $self = shift;
  return $self->new(scalar File::Basename::dirname($self), @_);
}

sub slurp {
  my ($self, $encoding) = @_;

  CORE::open my $file, '<', $$self or croak qq{Can't open file "$$self": $!};
  my $ret = my $content = '';
  while ($ret = $file->sysread(my $buffer, 131072, 0)) { $content .= $buffer }
  croak qq{Can't read from file "$$self": $!} unless defined $ret;

  return $encoding ? decode($encoding, $content) : $content;
}

sub spew {
  my ($self, $content, $encoding) = @_;
  $content = encode($encoding, $content) if $encoding;
  CORE::open my $file, '>', $$self or croak qq{Can't open file "$$self": $!};
  ($file->syswrite($content) // -1) == length $content or croak qq{Can't write to file "$$self": $!};
  return $self;
}

sub spurt { shift->spew(join '', @_) }

sub stat { File::stat::stat(${shift()}) }

sub tap { shift->Mojo::Base::tap(@_) }

sub tempdir { __PACKAGE__->new(File::Temp->newdir(@_)) }

sub tempfile { __PACKAGE__->new(File::Temp->new(@_)) }

sub to_abs { $_[0]->new(rel2abs ${$_[0]}) }

sub to_array { [splitdir ${shift()}] }

sub to_rel { $_[0]->new(abs2rel(${$_[0]}, $_[1])) }

sub to_string {"${$_[0]}"}

sub touch {
  my $self = shift;
  $self->open('>') unless -e $$self;
  utime undef, undef, $$self or croak qq{Can't touch file "$$self": $!};
  return $self;
}

sub with_roles { shift->Mojo::Base::with_roles(@_) }

sub _download_error {
  my $tx = shift;

  return $tx unless my $err = $tx->error;
  return undef if $err->{message} eq 'Download complete' || $err->{message} eq 'Download incomplete';
  croak "$err->{code} response: $err->{message}" if $err->{code};
  croak "Download error: $err->{message}";
}

1;

=encoding utf8

=head1 NAME

Mojo::File - File system paths

=head1 SYNOPSIS

  use Mojo::File;

  # Portably deal with file system paths
  my $path = Mojo::File->new('/home/sri/.vimrc');
  say $path->slurp;
  say $path->dirname;
  say $path->basename;
  say $path->extname;
  say $path->sibling('.bashrc');

  # Use the alternative constructor
  use Mojo::File qw(path);
  my $path = path('/tmp/foo/bar')->make_path;
  $path->child('test.txt')->spew('Hello Mojo!');

=head1 DESCRIPTION

L is a scalar-based container for file system paths that provides a friendly API for dealing with different
operating systems.

  # Access scalar directly to manipulate path
  my $path = Mojo::File->new('/home/sri/test');
  $$path .= '.txt';

=head1 FUNCTIONS

L implements the following functions, which can be imported individually.

=head2 curfile

  my $path = curfile;

Construct a new scalar-based L object for the absolute path to the current source file.

=head2 path

  my $path = path;
  my $path = path('/home/sri/.vimrc');
  my $path = path('/home', 'sri', '.vimrc');
  my $path = path(File::Temp->newdir);

Construct a new scalar-based L object, defaults to using the current working directory.

  # "foo/bar/baz.txt" (on UNIX)
  path('foo', 'bar', 'baz.txt');

=head2 tempdir

  my $path = tempdir;
  my $path = tempdir('tempXXXXX');

Construct a new scalar-based L object for a temporary directory with L.

  # Longer version
  my $path = path(File::Temp->newdir('tempXXXXX'));

=head2 tempfile

  my $path = tempfile;
  my $path = tempfile(DIR => '/tmp');

Construct a new scalar-based L object for a temporary file with L.

  # Longer version
  my $path = path(File::Temp->new(DIR => '/tmp'));

=head1 METHODS

L implements the following methods.

=head2 basename

  my $name = $path->basename;
  my $name = $path->basename('.txt');

Return the last level of the path with L.

  # ".vimrc" (on UNIX)
  path('/home/sri/.vimrc')->basename;

  # "test" (on UNIX)
  path('/home/sri/test.txt')->basename('.txt');

=head2 child

  my $child = $path->child('.vimrc');

Return a new L object relative to the path.

  # "/home/sri/.vimrc" (on UNIX)
  path('/home')->child('sri', '.vimrc');

=head2 chmod

  $path = $path->chmod(0644);

Change file permissions.

=head2 copy_to

  my $destination = $path->copy_to('/home/sri');
  my $destination = $path->copy_to('/home/sri/.vimrc.backup');

Copy file with L and return the destination as a L object.

=head2 dirname

  my $name = $path->dirname;

Return all but the last level of the path with L as a L object.

  # "/home/sri" (on UNIX)
  path('/home/sri/.vimrc')->dirname;

=head2 download

  my $bool = $path->download('https://example.com/test.tar.gz');
  my $bool = $path->download('https://example.com/test.tar.gz', {headers => {Accept => '*/*'}});
  my $bool = $path->download('https://example.com/test.tar.gz', {ua => Mojo::UserAgent->new});

Download file from URL, returns true once the file has been downloaded completely. Incomplete downloads are resumed.
Follows C<10> redirects by default and does not limit the size of the response, which will be streamed memory
efficiently. Note that this method is B and might change without warning!

=head2 extname

  my $ext = $path->extname;

Return file extension of the path.

  # "js"
  path('/home/sri/test.js')->extname;

=head2 is_abs

  my $bool = $path->is_abs;

Check if the path is absolute.

  # True (on UNIX)
  path('/home/sri/.vimrc')->is_abs;

  # False (on UNIX)
  path('.vimrc')->is_abs;

=head2 list

  my $collection = $path->list;
  my $collection = $path->list({hidden => 1});

List all files in the directory and return a L object containing the results as L
objects. The list does not include C<.> and C<..>.

  # List files
  say for path('/home/sri/myapp')->list->each;

These options are currently available:

=over 2

=item dir

  dir => 1

Include directories.

=item hidden

  hidden => 1

Include hidden files.

=back

=head2 list_tree

  my $collection = $path->list_tree;
  my $collection = $path->list_tree({hidden => 1});

List all files recursively in the directory and return a L object containing the results as
L objects. The list does not include C<.> and C<..>, and symbolic links to directories are not followed.

  # List all templates
  say for path('/home/sri/myapp/templates')->list_tree->each;

These options are currently available:

=over 2

=item dir

  dir => 1

Include directories.

=item hidden

  hidden => 1

Include hidden files and directories.

=item max_depth

  max_depth => 3

Maximum number of levels to descend when searching for files.

=back

=head2 lstat

  my $stat = $path->lstat;

Return a L object for the symlink.

  # Get symlink size
  say path('/usr/sbin/sendmail')->lstat->size;

  # Get symlink modification time
  say path('/usr/sbin/sendmail')->lstat->mtime;

=head2 make_path

  $path = $path->make_path;
  $path = $path->make_path({mode => 0711});

Create the directories if they don't already exist, any additional arguments are passed through to L.

=head2 move_to

  my $destination = $path->move_to('/home/sri');
  my $destination = $path->move_to('/home/sri/.vimrc.backup');

Move file with L and return the destination as a L object.

=head2 new

  my $path = Mojo::File->new;
  my $path = Mojo::File->new('/home/sri/.vimrc');
  my $path = Mojo::File->new('/home', 'sri', '.vimrc');
  my $path = Mojo::File->new(File::Temp->new);
  my $path = Mojo::File->new(File::Temp->newdir);

Construct a new L object, defaults to using the current working directory.

  # "foo/bar/baz.txt" (on UNIX)
  Mojo::File->new('foo', 'bar', 'baz.txt');

=head2 open

  my $handle = $path->open('+<');
  my $handle = $path->open('r+');
  my $handle = $path->open(O_RDWR);
  my $handle = $path->open('<:encoding(UTF-8)');

Open file with L.

  # Combine "fcntl.h" constants
  use Fcntl qw(O_CREAT O_EXCL O_RDWR);
  my $handle = path('/home/sri/test.pl')->open(O_RDWR | O_CREAT | O_EXCL);

=head2 realpath

  my $realpath = $path->realpath;

Resolve the path with L and return the result as a L object.

=head2 remove

  $path = $path->remove;

Delete file.

=head2 remove_tree

  $path = $path->remove_tree;
  $path = $path->remove_tree({keep_root => 1});

Delete this directory and any files and subdirectories it may contain, any additional arguments are passed through to
L.

=head2 sibling

  my $sibling = $path->sibling('.vimrc');

Return a new L object relative to the directory part of the path.

  # "/home/sri/.vimrc" (on UNIX)
  path('/home/sri/.bashrc')->sibling('.vimrc');

  # "/home/sri/.ssh/known_hosts" (on UNIX)
  path('/home/sri/.bashrc')->sibling('.ssh', 'known_hosts');

=head2 slurp

  my $bytes = $path->slurp;
  my $chars = $path->slurp('UTF-8');

Read all data at once from the file. If an encoding is provided, an attempt will be made to decode the content.

=head2 spew

  $path = $path->spew($bytes);
  $path = $path->spew($chars, 'UTF-8');

Write all data at once to the file. If an encoding is provided, an attempt to encode the content will be made prior to
writing.

=head2 spurt

  $path = $path->spurt(@bytes);

Alias for L that writes multiple chunks of bytes.

=head2 stat

  my $stat = $path->stat;

Return a L object for the path.

  # Get file size
  say path('/home/sri/.bashrc')->stat->size;

  # Get file modification time
  say path('/home/sri/.bashrc')->stat->mtime;

=head2 tap

  $path = $path->tap(sub {...});

Alias for L.

=head2 to_abs

  my $absolute = $path->to_abs;

Return absolute path as a L object, the path does not need to exist on the file system.

=head2 to_array

  my $parts = $path->to_array;

Split the path on directory separators.

  # "home:sri:.vimrc" (on UNIX)
  join ':', @{path('/home/sri/.vimrc')->to_array};

=head2 to_rel

  my $relative = $path->to_rel('/some/base/path');

Return a relative path from the original path to the destination path as a L object.

  # "sri/.vimrc" (on UNIX)
  path('/home/sri/.vimrc')->to_rel('/home');

=head2 to_string

  my $str = $path->to_string;

Stringify the path.

=head2 touch

  $path = $path->touch;

Create file if it does not exist or change the modification and access time to the current time.

  # Safely read file
  say path('.bashrc')->touch->slurp;

=head2 with_roles

  my $new_class = Mojo::File->with_roles('Mojo::File::Role::One');
  my $new_class = Mojo::File->with_roles('+One', '+Two');
  $path         = $path->with_roles('+One', '+Two');

Alias for L.

=head1 OPERATORS

L overloads the following operators.

=head2 array

  my @parts = @$path;

Alias for L.

=head2 bool

  my $bool = !!$path;

Always true.

=head2 stringify

  my $str = "$path";

Alias for L.

=head1 SEE ALSO

L, L, L.

=cut