view release on metacpan or  search on metacpan

lib/Acme/Pythonic/Functions.pm  view on Meta::CPAN

            print $a[$i];
        }
        if ($i != $#a) {
            print ", ";
        } else {
            print "]\n";
        }
    }
}

# String-Functions

sub endswith {

    checkArgs(2, @_);

    if ($_[0] =~ /\Q$_[1]\E$/) {
        return 1;
    }
    else {
        return 0;
    }
}


sub lstrip {

    checkArgs(1, @_);

    my $a = $_[0];

    $a =~ s/^\s+//;

    return $a;
}


sub isdigit {

    checkArgs(1, @_);

    if($_[0] =~ /\D/) {
        return 0;
    }
    else {
        return 1;
    }
}


sub lstrip2 {

    checkArgs(2, @_);

    my ($a, $b) = @_;

    if($a !~ /^\Q$b\E/) {
        return $a;
    }

    if (length($b) > length($a)) {
        return $a;
    }

    return substr($a, length($b));
}


sub replace {

    my $nrargs = @_;

    if($nrargs < 3 || $nrargs > 4) {
        croak "Error: Function 'replace()' takes either 3 or 4 arguments ($nrargs given),";
    }

    my $count = 0;

    if($nrargs == 4) {
        $count = pop(@_);
    }

    unless (isdigit($count)) {
        carp "Warning: Argument 4 of function 'replace()' should be a number; assuming 0,";
        $count = 0;
    }

    my ($all, $old, $new) = @_;

    if ($count == 0) {
        $all =~ s/\Q$old\E/$new/g;
        return $all;
    }

    for (1 .. $count) {
        $all =~ s/\Q$old\E/$new/;
    }

    return $all;
}


sub rstrip {

    checkArgs(1, @_);

    my $a = $_[0];

    $a =~ s/\s+$//;

    return $a;
}


sub rstrip2 {

    checkArgs(2, @_);

    my ($a, $b) = @_;

    if($a !~ /\Q$b\E$/) {
        return $a;
    }

    if (length($b) > length($a)) {
        return $a;
    }

    return substr($a, 0, length($a) - length($b));
}


sub startswith {

    checkArgs(2, @_);

    if ($_[0] =~ /^\Q$_[1]\E/) {
        return 1;
    }
    else {
        return 0;
    }
}


sub strip {

    checkArgs(1, @_);

    my $a = $_[0];

    $a =~ s/^\s+//;
    $a =~ s/\s+$//;

    return $a;
}

# List-Functions

sub append {

    if($#_ < 1) {
        carp "Warning: Not enough arguments for 'append()',";
    }

    return @_;
}

sub extend {

    if($#_ < 1) {
        carp "Warning: Not enough arguments for 'extend()',";
    }

    return @_;
}


sub insert {

    if($#_ < 1) {
        carp "Warning: Not enough arguments for 'insert()'; nothing inserted,";
        return @_;
    }

    my $a = pop;
    my $b = pop;

    if($b =~ /\D/) {

lib/Acme/Pythonic/Functions.pm  view on Meta::CPAN

    if ($mode eq "s") {

        if ($lenarg != 3) {
            croak "Error: 'isin()' in mode 's' takes exactly 3 arguments ($lenarg given),";
        }

        if ($_[0] =~ m/\Q$_[1]\E/) {
            return 1;
        }
        return 0;
    }

    if ($mode eq "l") {
        my $a = pop;
        for (@_) {
            if ($_ eq $a) {
                return 1;
            }
        }
        return 0;
    }

    # Only mode 'h' is left by now.

    if ($lenarg % 2) {
        croak "Error: Unsuitable arguments to 'isin()' in 'h'-mode,";
    }

    my $key = pop;
    my %hash = @_;

    if (exists $hash{$key}) {
        return 1;
    }
    else {
        return 0;
    }
}

sub len {

    my $lenarg = @_;

    if ($lenarg < 2) {
        croak "Error: 'len()' takes at least 2 arguments ($lenarg given),";
    }

    my $mode = pop;

    if ($mode ne "s" && $mode ne "l" && $mode ne "h") {
        croak "Error: Last argument to 'len()' must be 's', 'l' or 'h',";
    }

    if ($mode eq "s") {

        if ($lenarg != 2) {
            croak "Error: 'len()' in mode 's' takes exactly 2 arguments ($lenarg given),";
        }

        return length($_[0]);
    }

    if ($mode eq "l") {
        return $lenarg - 1;
    }

    # Only mode 'h' is left by now.

    if (! $lenarg % 2) {
        croak "Error: Unsuitable arguments to 'isin()' in 'h'-mode,";
    }

    return ($lenarg - 1) / 2;
}


# File-related-Functions

sub isdir {

    checkArgs(1, @_);

    if(-d $_[0]) {
        return 1;
    }
    else {
        return 0;
    }
}

sub isfile {

    checkArgs(1, @_);

    if(-f $_[0]) {
        return 1;
    }
    else {
        return 0;
    }
}

sub readfile {

    checkArgs(1, @_);

    my $file = shift;

    open(FH, "<$file") or croak "Error reading file '$file',";
    my @a = <FH>; # Gulp !
    close(FH);

    return @a;
}


sub writefile {

    if($#_ < 1) {
        croak "Error: Function 'writefile()' needs a list to write to a file as an argument,";