Sidef

 view release on metacpan or  search on metacpan

lib/Sidef/Types/String/String.pm  view on Meta::CPAN

        }

        $self;
    }

    sub crypt {
        my ($self, $salt) = @_;
        $self->new(crypt($$self, "$salt"));
    }

    sub bin {
        my ($self) = @_;
        Sidef::Types::Number::Number->new($$self || '0', 2);
    }

    sub oct {
        my ($self) = @_;
        Sidef::Types::Number::Number->new($$self || '0', 8);
    }

    sub hex {
        my ($self) = @_;
        Sidef::Types::Number::Number->new($$self || '0', 16);
    }

    sub hexlify {
        my ($self) = @_;
        my $r = CORE::unpack("H*", $$self);
        bless \$r;
    }

    *ascii2hex = \&hexlify;

    sub unhexlify {
        my ($self) = @_;
        my $r = CORE::pack("H*", $$self);
        bless \$r;
    }

    *hex2ascii = \&unhexlify;

    sub ascii2bin {
        my ($self) = @_;
        my $r = CORE::unpack("B*", $$self);
        bless \$r;
    }

    sub bin2ascii {
        my ($self) = @_;
        my $r = CORE::pack("B*", $$self);
        bless \$r;
    }

    sub ascii2bits {
        my ($self) = @_;
        Sidef::Types::Array::Array->new(
                      [map { $_ ? Sidef::Types::Number::Number::ONE : Sidef::Types::Number::Number::ZERO } CORE::split(//, scalar CORE::unpack("B*", $$self))]);
    }

    sub decode_base64 {
        state $x = require MIME::Base64;
        bless \(my $value = MIME::Base64::decode_base64(${$_[0]}));
    }

    *base64_decode = \&decode_base64;

    sub encode_base64 {
        state $x = require MIME::Base64;
        bless \(my $value = MIME::Base64::encode_base64(${$_[0]}));
    }

    *base64_encode = \&encode_base64;

    sub md5 {
        state $x = require Digest::MD5;
        bless \(my $value = Digest::MD5::md5_hex(${$_[0]}));
    }

    sub sha1 {
        state $x = require Digest::SHA;
        bless \(my $value = Digest::SHA::sha1_hex(${$_[0]}));
    }

    sub sha256 {
        state $x = require Digest::SHA;
        bless \(my $value = Digest::SHA::sha256_hex(${$_[0]}));
    }

    sub sha512 {
        state $x = require Digest::SHA;
        bless \(my $value = Digest::SHA::sha512_hex(${$_[0]}));
    }

    sub parse_quotewords {
        my ($self, $delim, $keep) = @_;
        $delim //= ' ';
        state $x = require Text::ParseWords;
        my @words = map { bless \$_ } Text::ParseWords::parse_line("$delim", ($keep ? 1 : 0), $$self);
        Sidef::Types::Array::Array->new(\@words);
    }

    sub extract_bracketed {
        my ($self, $brackets) = @_;
        state $x = require Text::Balanced;
        my @results = Text::Balanced::extract_bracketed($$self, "$brackets");
        map { bless \$_ } @results;
    }

    sub extract_delimited {
        my ($self, $delim) = @_;
        state $x = require Text::Balanced;
        my @results = Text::Balanced::extract_delimited($$self, "$delim");
        map { bless \$_ } @results;
    }

    sub extract_codeblock {
        my ($self, $delim) = @_;
        state $x = require Text::Balanced;
        my @results = Text::Balanced::extract_codeblock($$self, "$delim");
        map { bless \$_ } @results;
    }

    sub extract_quotelike {
        my ($self) = @_;
        state $x = require Text::Balanced;
        my @results = Text::Balanced::extract_quotelike($$self);
        map { bless \$_ } @results;
    }

    sub extract_tagged {
        my ($self) = @_;
        state $x = require Text::Balanced;
        my @results = Text::Balanced::extract_tagged($$self);
        map { bless \$_ } @results;
    }

    sub substr {
        my ($self, $offs, $len) = @_;
        bless \(
                my $t = (
                         defined($len)
                         ? CORE::substr($$self, CORE::int($offs), CORE::int($len))
                         : CORE::substr($$self, CORE::int($offs))
                        )
               );
    }

    *substring = \&substr;
    *slice     = \&substr;

    sub insert {
        my ($self, $string, $pos, $len) = @_;
        my $copy_str = "$$self";
        CORE::substr($copy_str, CORE::int($pos), (defined($len) ? CORE::int($len) : 0), "$string");
        bless \$copy_str;
    }

    sub join {
        my ($self, @rest) = @_;
        bless \(my $value = CORE::join($$self, @rest));
    }

    sub clear {
        state $x = bless \(my $str = '');
    }

    sub is_empty {
        my ($self) = @_;
        ($$self eq '')
          ? (Sidef::Types::Bool::Bool::TRUE)
          : (Sidef::Types::Bool::Bool::FALSE);
    }

    sub is_lowercase {
        my ($self) = @_;
        ($$self =~ /^[[:lower:]]+\z/)
          ? (Sidef::Types::Bool::Bool::TRUE)
          : (Sidef::Types::Bool::Bool::FALSE);
    }

    *is_lc = \&is_lowercase;

    sub is_uppercase {
        my ($self) = @_;
        ($$self =~ /^[[:upper:]]+\z/)
          ? (Sidef::Types::Bool::Bool::TRUE)
          : (Sidef::Types::Bool::Bool::FALSE);
    }

    *is_uc = \&is_uppercase;

    sub is_ascii {

lib/Sidef/Types/String/String.pm  view on Meta::CPAN

    sub sub {
        my ($self, $regex, $str) = @_;

        ref($str) eq 'Sidef::Types::Block::Block'
          && return $self->esub($regex, $str);

        my $search = _string_or_regex($regex);
        my $value  = "$str";

        $self->new($$self =~ s{$search}{$value}r);
    }

    *replace = \⊂

    sub gsub {
        my ($self, $regex, $str) = @_;

        ref($str) eq 'Sidef::Types::Block::Block'
          && return $self->gesub($regex, $str);

        my $search = _string_or_regex($regex);
        my $value  = "$str";
        $self->new($$self =~ s{$search}{$value}gr);
    }

    *replace_all = \&gsub;

    sub _get_captures {
        my ($string) = @_;
        map { bless \(my $t = CORE::substr($string, $-[$_], $+[$_] - $-[$_])) } 1 .. $#{-};
    }

    sub esub {
        my ($self, $regex, $block) = @_;

        my $search = _string_or_regex($regex);

        if (ref($block) eq 'Sidef::Types::Block::Block') {
            return $self->new($$self =~ s{$search}{$block->run(_get_captures($$self))}er);
        }

        $self->new($$self =~ s{$search}{"$block"}eer);
    }

    sub gesub {
        my ($self, $regex, $block) = @_;

        my $search = _string_or_regex($regex);

        if (ref($block) eq 'Sidef::Types::Block::Block') {
            my $value = $$self;
            return $self->new($value =~ s{$search}{$block->run(_get_captures($value))}ger);
        }

        my $value = "$block";
        $self->new($$self =~ s{$search}{$value}geer);
    }

    sub glob {
        my ($self) = @_;
        state $x = require Encode;
        Sidef::Types::Array::Array->new([map { bless \(my $value = Encode::decode_utf8($_)) } CORE::glob($$self)]);
    }

    sub quotemeta {
        my ($self) = @_;
        $self->new(CORE::quotemeta($$self));
    }

    *escape = \&quotemeta;

    sub scan {
        my ($self, $regex) = @_;
        my $str = $$self;
        Sidef::Types::Array::Array->new([map { bless \$_ } $str =~ /$regex->{regex}/g]);
    }

    sub collect {
        my ($self, $regex) = @_;
        my $str = $$self;
        my @matches;
        while ($str =~ /$regex->{regex}/g) {
            push @matches, Sidef::Types::Array::Array->new([_get_captures($str)]);
        }
        Sidef::Types::Array::Array->new(\@matches);
    }

    *findall  = \&collect;
    *find_all = \&collect;

    sub slices {
        my ($self, $n) = @_;
        $n = CORE::int($n);
        $n > 0 or return Sidef::Types::Array::Array->new;
        Sidef::Types::Array::Array->new([map { bless \$_ } unpack('(a' . $n . ')*', $$self)]);
    }

    sub each_slice {
        my ($self, $n, $block) = @_;

        $n = CORE::int($n);
        $n > 0 or return $self;

        my $len = length($$self);
        for (my $i = 0 ; $i < $len ; $i += $n) {
            $block->run(bless \(my $str = CORE::substr($$self, $i, $n)));
        }

        $self;
    }

    sub cons {
        my ($self, $n) = @_;
        $n = CORE::int($n);
        $n > 0 or return Sidef::Types::Array::Array->new;
        my @strings;
        foreach my $i (0 .. CORE::length($$self) - $n) {
            push @strings, bless \(my $str = CORE::substr($$self, $i, $n));
        }
        Sidef::Types::Array::Array->new(\@strings);
    }

lib/Sidef/Types/String/String.pm  view on Meta::CPAN

    }

    sub begins_with {
        my ($self, $string) = @_;

        $string = "$string";

        CORE::length($$self) < (my $len = CORE::length($string))
          && return (Sidef::Types::Bool::Bool::FALSE);

        CORE::substr($$self, 0, $len) eq $string
          && return (Sidef::Types::Bool::Bool::TRUE);

        Sidef::Types::Bool::Bool::FALSE;
    }

    *starts_with = \&begins_with;

    sub ends_with {
        my ($self, $string) = @_;

        $string = "$string";

        CORE::length($$self) < (my $len = CORE::length($string))
          && return (Sidef::Types::Bool::Bool::FALSE);

        CORE::substr($$self, -$len) eq $string
          && return (Sidef::Types::Bool::Bool::TRUE);

        Sidef::Types::Bool::Bool::FALSE;
    }

    sub looks_like_number {
        my ($self) = @_;
        Scalar::Util::looks_like_number($$self)
          ? (Sidef::Types::Bool::Bool::TRUE)
          : (Sidef::Types::Bool::Bool::FALSE);
    }

    *is_numeric = \&looks_like_number;

    sub is_palindrome {
        my ($self) = @_;
        $$self eq CORE::reverse(${$self})
          ? (Sidef::Types::Bool::Bool::TRUE)
          : (Sidef::Types::Bool::Bool::FALSE);
    }

    sub warn {
        my ($self) = @_;
        warn $$self;
    }

    sub die {
        my ($self) = @_;
        die $$self;
    }

    sub encode {
        my ($self, $enc) = @_;
        state $x = require Encode;
        $self->new(Encode::encode("$enc", $$self));
    }

    sub decode {
        my ($self, $enc) = @_;
        state $x = require Encode;
        $self->new(Encode::decode("$enc", $$self));
    }

    sub encode_utf8 {
        my ($self) = @_;
        state $x = require Encode;
        $self->new(Encode::encode_utf8($$self));
    }

    sub decode_utf8 {
        my ($self) = @_;
        state $x = require Encode;
        $self->new(Encode::decode_utf8($$self));
    }

    sub deflate {
        my ($self) = @_;
        state $x = require IO::Compress::RawDeflate;
        my $input = $$self;
        IO::Compress::RawDeflate::rawdeflate(\$input => \my $output)
          or CORE::die("String.deflate failed: $IO::Compress::RawDeflate::RawDeflateError");
        bless \$output;
    }

    sub inflate {
        my ($self) = @_;
        state $x = require IO::Uncompress::RawInflate;
        my $input = $$self;
        IO::Uncompress::RawInflate::rawinflate(\$input => \my $output)
          or CORE::die("String.inflate failed: $IO::Uncompress::RawInflate::RawInflateError");
        bless \$output;
    }

    sub gzip {
        my ($self) = @_;
        state $x = require IO::Compress::Gzip;
        my $input = $$self;
        IO::Compress::Gzip::gzip(\$input => \my $output)
          or CORE::die("String.gzip failed: $IO::Compress::Gzip::GzipError");
        bless \$output;
    }

    sub gunzip {
        my ($self) = @_;
        state $x = require IO::Uncompress::Gunzip;
        my $input = $$self;
        IO::Uncompress::Gunzip::gunzip(\$input => \my $output)
          or CORE::die("String.gunzip failed: $IO::Uncompress::Gunzip::GunzipError");
        bless \$output;
    }

    sub from_json {
        my ($self) = @_;
        state $x = require JSON;
        Sidef::Types::Perl::Perl->to_sidef(scalar JSON::from_json($$self));
    }

    sub _require {
        my ($self) = @_;

        my $name = $$self;
        eval { require(($name . '.pm') =~ s{::}{/}gr) };

        if ($@) {
            CORE::die CORE::substr($@, 0, CORE::rindex($@, ' at ')), "\n";
        }

        $name;
    }

    sub require {
        my ($self) = @_;
        Sidef::Module::OO->__NEW__($self->_require);
    }

    sub frequire {
        my ($self) = @_;
        Sidef::Module::Func->__NEW__($self->_require);
    }

    sub use {
        my ($self) = @_;
        eval("use $$self");
        $@ ? Sidef::Types::Bool::Bool::FALSE : Sidef::Types::Bool::Bool::TRUE;
    }

    sub run {
        my ($method, $self, @args) = @_;
        $self->$$method(@args);
    }

    sub unescape {
        my ($self) = @_;
        $self->new($$self =~ s{\\(.)}{$1}grs);
    }

    sub _bwt_sort {
        my ($s, $LOOKAHEAD_LEN) = @_;    # O(n * LOOKAHEAD_LEN) space (fast)

        $LOOKAHEAD_LEN //= 128;

        my $len      = CORE::length($s);
        my $double_s = $s . $s;            # Pre-compute doubled string

        # Schwartzian transform with optimized sorting
        return [
            map { $_->[1] }
            sort {
                ($a->[0] cmp $b->[0])
                  || do {
                    my ($cmp, $s_len) = (0, $LOOKAHEAD_LEN << 2);
                    while (1) {
                        ($cmp = CORE::substr($double_s, $a->[1], $s_len) cmp CORE::substr($double_s, $b->[1], $s_len)) && last;
                        $s_len <<= 1;