view release on metacpan or  search on metacpan

lib/Sidef/Types/Glob/File.pm  view on Meta::CPAN

package Sidef::Types::Glob::File;

use utf8;
use 5.016;

use parent qw(
  Sidef::Types::String::String
);

require Encode;
require File::Spec;

use Sidef::Types::Number::Number;

sub new {
    my (undef, $file) = @_;
    if (@_ > 2) {
        shift(@_);
        $file = File::Spec->catfile(map { "$_" } @_);
    }
    elsif (ref($file) && ref($file) ne 'SCALAR') {
        $file = "$file";
    }
    bless \$file, __PACKAGE__;
}

*call = \&new;

sub get_value { ${$_[0]} }
sub to_file   { $_[0] }

{
    no strict 'refs';
    require Fcntl;

    my %cache;
    foreach my $name (@Fcntl::EXPORT, @Fcntl::EXPORT_OK) {
        ($name =~ /^[A-Z]/ and defined(&{'Fcntl::' . $name})) or next;
        *{__PACKAGE__ . '::' . $name} = sub {
            $cache{$name} //= Sidef::Types::Number::Number::_set_int(&{'Fcntl::' . $name});
        };
    }
}

sub size {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    Sidef::Types::Number::Number::_set_int(-s "$self");
}

sub md5 {
    ref($_[0]) || shift(@_);
    state $x = require Digest::MD5;
    open my $fh, '<:raw', "$_[0]" or return undef;
    my $o = Digest::MD5->new;
    $o->addfile($fh);
    Sidef::Types::String::String->new(scalar $o->hexdigest);
}

sub sha1 {
    ref($_[0]) || shift(@_);
    state $x = require Digest::SHA;
    open my $fh, '<:raw', "$_[0]" or return undef;
    my $o = Digest::SHA->new(1);
    $o->addfile($fh);
    Sidef::Types::String::String->new(scalar $o->hexdigest);
}

sub sha256 {
    ref($_[0]) || shift(@_);
    state $x = require Digest::SHA;
    open my $fh, '<:raw', "$_[0]" or return undef;
    my $o = Digest::SHA->new(256);
    $o->addfile($fh);
    Sidef::Types::String::String->new(scalar $o->hexdigest);
}

sub sha512 {
    ref($_[0]) || shift(@_);
    state $x = require Digest::SHA;
    open my $fh, '<:raw', "$_[0]" or return undef;
    my $o = Digest::SHA->new(512);
    $o->addfile($fh);
    Sidef::Types::String::String->new(scalar $o->hexdigest);
}

sub compare {
    ref($_[0]) || shift(@_);
    my ($self, $file) = @_;
    state $x = require File::Compare;
    my $cmp = File::Compare::compare("$self", "$file");

        $cmp < 0 ? Sidef::Types::Number::Number::MONE
      : $cmp > 0 ? Sidef::Types::Number::Number::ONE
      :            Sidef::Types::Number::Number::ZERO;
}

sub mktemp {
    my ($self, %opts) = @_;
    state $x = require File::Temp;
    my ($fh, $file) = File::Temp::tempfile(%opts);
    Sidef::Types::Glob::FileHandle->new($fh, __PACKAGE__->new($file));
}

*make_tmp  = \&mktemp;
*make_temp = \&mktemp;

sub exists {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    (-e "$self") ? (Sidef::Types::Bool::Bool::TRUE) : (Sidef::Types::Bool::Bool::FALSE);
}

sub is_empty {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    (-z "$self") ? (Sidef::Types::Bool::Bool::TRUE) : (Sidef::Types::Bool::Bool::FALSE);
}

sub is_directory {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    (-d "$self") ? (Sidef::Types::Bool::Bool::TRUE) : (Sidef::Types::Bool::Bool::FALSE);
}

*is_dir = \&is_directory;

sub is_link {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    (-l "$self") ? (Sidef::Types::Bool::Bool::TRUE) : (Sidef::Types::Bool::Bool::FALSE);
}

sub readlink {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    my $link   = "$self";
    my $class  = (-d $link) ? 'Sidef::Types::Glob::Dir' : __PACKAGE__;
    $class->new(CORE::readlink($link));
}

*read_link = \&readlink;

sub is_socket {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    (-S "$self") ? (Sidef::Types::Bool::Bool::TRUE) : (Sidef::Types::Bool::Bool::FALSE);
}

sub is_block {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    (-b "$self") ? (Sidef::Types::Bool::Bool::TRUE) : (Sidef::Types::Bool::Bool::FALSE);
}

sub is_char_device {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    (-c "$self") ? (Sidef::Types::Bool::Bool::TRUE) : (Sidef::Types::Bool::Bool::FALSE);
}

lib/Sidef/Types/Glob/File.pm  view on Meta::CPAN

}

sub is_owned {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    (-o "$self") ? (Sidef::Types::Bool::Bool::TRUE) : (Sidef::Types::Bool::Bool::FALSE);
}

sub is_real_readable {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    (-R "$self") ? (Sidef::Types::Bool::Bool::TRUE) : (Sidef::Types::Bool::Bool::FALSE);
}

sub is_real_writeable {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    (-W "$self") ? (Sidef::Types::Bool::Bool::TRUE) : (Sidef::Types::Bool::Bool::FALSE);
}

sub is_real_executable {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    (-X "$self") ? (Sidef::Types::Bool::Bool::TRUE) : (Sidef::Types::Bool::Bool::FALSE);
}

sub is_real_owned {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    (-O "$self") ? (Sidef::Types::Bool::Bool::TRUE) : (Sidef::Types::Bool::Bool::FALSE);
}

sub is_binary {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    (-B "$self") ? (Sidef::Types::Bool::Bool::TRUE) : (Sidef::Types::Bool::Bool::FALSE);
}

sub is_text {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    (-T "$self") ? (Sidef::Types::Bool::Bool::TRUE) : (Sidef::Types::Bool::Bool::FALSE);
}

sub is_file {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    (-f "$self") ? (Sidef::Types::Bool::Bool::TRUE) : (Sidef::Types::Bool::Bool::FALSE);
}

sub name {
    ref($_[0]) || shift(@_);
    my ($self) = @_;
    Sidef::Types::String::String->new("$self");
}

sub basename {
    ref($_[0]) || shift(@_);
    my ($self) = @_;

    state $x = require File::Basename;
    Sidef::Types::String::String->new(File::Basename::basename("$self"));
}

*base      = \&basename;
*base_name = \&basename;

sub dirname {
    ref($_[0]) || shift(@_);
    my ($self) = @_;

    state $x = require File::Basename;
    Sidef::Types::Glob::Dir->new(File::Basename::dirname("$self"));
}

*dir      = \&dirname;
*dir_name = \&dirname;

sub is_absolute {
    ref($_[0]) || shift(@_);
    my ($self) = @_;

    File::Spec->file_name_is_absolute("$self")
      ? (Sidef::Types::Bool::Bool::TRUE)
      : (Sidef::Types::Bool::Bool::FALSE);
}

*is_abs = \&is_absolute;

sub abs_name {
    my $class = ref($_[0]) || shift(@_);
    my ($self, $base) = @_;
    $class->new(Encode::decode_utf8(File::Spec->rel2abs(Encode::encode_utf8("$self"), defined($base) ? Encode::encode_utf8("$base") : ())));
}

*abs     = \&abs_name;
*absname = \&abs_name;
*rel2abs = \&abs_name;

sub rel_name {
    my $class = ref($_[0]) || shift(@_);
    my ($self, $base) = @_;
    $class->new(Encode::decode_utf8(File::Spec->abs2rel(Encode::encode_utf8("$self"), defined($base) ? Encode::encode_utf8("$base") : ())));
}

*rel     = \&rel_name;
*relname = \&rel_name;
*abs2rel = \&rel_name;

sub abs_path {
    my $class = ref($_[0]) || shift(@_);
    my ($self) = @_;

    state $x = require Cwd;
    $class->new(Encode::decode_utf8(Cwd::abs_path("$self")));
}

*realpath = \&abs_path;

sub rename {
    ref($_[0]) || shift(@_);
    my ($self, $file) = @_;

    CORE::rename("$self", "$file")
      ? (Sidef::Types::Bool::Bool::TRUE)
      : (Sidef::Types::Bool::Bool::FALSE);
}

sub move {
    ref($_[0]) || shift(@_);
    my ($self, $file) = @_;

    state $x = require File::Copy;
    File::Copy::move("$self", "$file")
      ? (Sidef::Types::Bool::Bool::TRUE)
      : (Sidef::Types::Bool::Bool::FALSE);
}

*mv = \&move;

sub copy {
    ref($_[0]) || shift(@_);
    my ($self, $file) = @_;

    state $x = require File::Copy;
    File::Copy::copy("$self", "$file")
      ? (Sidef::Types::Bool::Bool::TRUE)
      : (Sidef::Types::Bool::Bool::FALSE);
}

*cp = \©

sub edit {
    ref($_[0]) || shift(@_);
    my ($self, $code) = @_;

    my @lines;
    open(my $fh, '+<:utf8', "$self") || return (Sidef::Types::Bool::Bool::FALSE);
    while (defined(my $line = <$fh>)) {
        push @lines, $code->run(Sidef::Types::String::String->new($line));
    }

    truncate($fh, 0) || return undef;
    seek($fh, 0, 0)  || return undef;

    do {
        local $, = q{};
        local $\ = q{};
        (print $fh @lines) || return undef;
        close $fh;
      }
      ? (Sidef::Types::Bool::Bool::TRUE)
      : (Sidef::Types::Bool::Bool::FALSE);
}

sub read {
    ref($_[0]) || shift(@_);
    my ($self, $mode) = @_;

    $mode = defined($mode) ? "$mode" : 'utf8';
    open(my $fh, "<:$mode", "$self") || return undef;

    local $/;
    Sidef::Types::String::String->new(scalar <$fh>);
}

sub write {
    ref($_[0]) || shift(@_);
    my ($self, $string, $mode) = @_;

    $mode = defined($mode) ? "$mode" : 'utf8';
    open(my $fh, ">:$mode", "$self") || return undef;

    (print $fh "$string") || return undef;

    (close $fh)
      ? (Sidef::Types::Bool::Bool::TRUE)
      : (Sidef::Types::Bool::Bool::FALSE);
}

sub append {
    ref($_[0]) || shift(@_);
    my ($self, $string, $mode) = @_;

    $mode = defined($mode) ? "$mode" : 'utf8';