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->rel2abs(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';