libsharyanto-string-util-perl 0.26-1 / usr / share / perl5 / SHARYANTO / String / Util.pm

package SHARYANTO::String::Util;

use 5.010001;
use strict;
use warnings;

our $VERSION = '0.26'; # VERSION

use Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
                       ltrim
                       rtrim
                       trim
                       ltrim_lines
                       rtrim_lines
                       trim_lines
                       trim_blank_lines
                       ellipsis
                       indent
                       linenum
                       pad
                       qqquote
               );

sub ltrim {
    my $str = shift;
    $str =~ s/\A\s+//s;
    $str;
}

sub rtrim {
    my $str = shift;
    $str =~ s/\s+\z//s;
    $str;
}

sub trim {
    my $str = shift;
    $str =~ s/\A\s+//s;
    $str =~ s/\s+\z//s;
    $str;
}

sub ltrim_lines {
    my $str = shift;
    $str =~ s/^[ \t]+//mg; # XXX other unicode non-newline spaces
    $str;
}

sub rtrim_lines {
    my $str = shift;
    $str =~ s/[ \t]+$//mg;
    $str;
}

sub trim_lines {
    my $str = shift;
    $str =~ s/^[ \t]+//mg;
    $str =~ s/[ \t]+$//mg;
    $str;
}

sub trim_blank_lines {
    local $_ = shift;
    return $_ unless defined;
    s/\A(?:\n\s*)+//;
    s/(?:\n\s*){2,}\z/\n/;
    $_;
}

sub ellipsis {
    my ($str, $maxlen, $ellipsis) = @_;
    $maxlen   //= 80;
    $ellipsis //= "...";

    if (length($str) <= $maxlen) {
        return $str;
    } else {
        return substr($str, 0, $maxlen-length($ellipsis)) . $ellipsis;
    }
}

sub indent {
    my ($indent, $str, $opts) = @_;
    $opts //= {};

    if ($opts->{indent_blank_lines} // 1) {
        $str =~ s/^/$indent/mg;
    } else {
        $str =~ s/^([^\r\n]*\S[^\r\n]*)/$indent$1/mg;
    }
    $str;
}

sub linenum {
    my ($str, $opts) = @_;
    $opts //= {};
    $opts->{width}      //= 4;
    $opts->{zeropad}    //= 0;
    $opts->{skip_empty} //= 1;

    my $i = 0;
    $str =~ s/^(([\t ]*\S)?.*)/
        sprintf(join("",
                     "%",
                     ($opts->{zeropad} && !($opts->{skip_empty}
                                                && !defined($2)) ? "0" : ""),
                     $opts->{width}, "s",
                     "|%s"),
                ++$i && $opts->{skip_empty} && !defined($2) ? "" : $i,
                $1)/meg;

    $str;
}

sub pad {
    my ($text, $width, $which, $padchar, $is_trunc) = @_;
    if ($which) {
        $which = substr($which, 0, 1);
    } else {
        $which = "r";
    }
    $padchar //= " ";

    my $w = length($text);
    if ($is_trunc && $w > $width) {
        $text = substr($text, 0, $width, 1);
    } else {
        if ($which eq 'l') {
            $text = ($padchar x ($width-$w)) . $text;
        } elsif ($which eq 'c') {
            my $n = int(($width-$w)/2);
            $text = ($padchar x $n) . $text . ($padchar x ($width-$w-$n));
        } else {
            $text .= ($padchar x ($width-$w));
        }
    }
    $text;
}

# BEGIN COPY PASTE FROM Data::Dump
my %esc = (
    "\a" => "\\a",
    "\b" => "\\b",
    "\t" => "\\t",
    "\n" => "\\n",
    "\f" => "\\f",
    "\r" => "\\r",
    "\e" => "\\e",
);

# put a string value in double quotes
sub qqquote {
  local($_) = $_[0];
  # If there are many '"' we might want to use qq() instead
  s/([\\\"\@\$])/\\$1/g;
  return qq("$_") unless /[^\040-\176]/;  # fast exit

  s/([\a\b\t\n\f\r\e])/$esc{$1}/g;

  # no need for 3 digits in escape for these
  s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;

  s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
  s/([^\040-\176])/sprintf('\\x{%X}',ord($1))/eg;

  return qq("$_");
}
# END COPY PASTE FROM Data::Dump

1;
# ABSTRACT: String utilities

__END__

=pod

=encoding utf-8

=head1 NAME

SHARYANTO::String::Util - String utilities

=head1 DESCRIPTION

=head1 FUNCTIONS

=head2 ltrim($str) => STR

Trim whitespaces (including newlines) at the beginning of string. Equivalent to:

 $str =~ s/\A\s+//s;

=head2 ltrim_lines($str) => STR

Trim whitespaces (not including newlines) at the beginning of each line of
string. Equivalent to:

 $str =~ s/^\s+//mg;

=head2 rtrim($str) => STR

Trim whitespaces (including newlines) at the end of string. Equivalent to:

 $str =~ s/[ \t]+\z//s;

=head2 rtrim_lines($str) => STR

Trim whitespaces (not including newlines) at the end of each line of
string. Equivalent to:

 $str =~ s/[ \t]+$//mg;

=head2 trim($str) => STR

ltrim + rtrim.

=head2 trim_lines($str) => STR

ltrim_lines + rtrim_lines.

=head2 trim_blank_lines($str) => STR

Trim blank lines at the beginning and the end. Won't trim blank lines in the
middle. Blank lines include lines with only whitespaces in them.

=head2 ellipsis($str[, $maxlen, $ellipsis]) => STR

Return $str unmodified if $str's length is less than $maxlen (default 80).
Otherwise cut $str to ($maxlen - length($ellipsis)) and append $ellipsis
(default '...') at the end.

=head2 indent($indent, $str, \%opts) => STR

Indent every line in $str with $indent. Example:

 indent('  ', "one\ntwo\nthree") # "  one\n  two\n  three"

%opts is optional. Known options:

=over 4

=item * indent_blank_lines => BOOL (default 1)

If set to false, does not indent blank lines (i.e., lines containing only zero
or more whitespaces).

=back

=head2 linenum($str, \%opts) => STR

Add line numbers. For example:

     1|line1
     2|line2
      |
     4|line4

Known options:

=over 4

=item * width => INT (default: 4)

=item * zeropad => BOOL (default: 0)

If turned on, will output something like:

  0001|line1
  0002|line2
      |
  0004|line4

=item * skip_empty => BOOL (default: 1)

If set to false, keep printing line number even if line is empty:

     1|line1
     2|line2
     3|
     4|line4

=back

=head2 pad($text, $width[, $which[, $padchar[, $truncate]]]) => STR

Return C<$text> padded with C<$padchar> to C<$width> columns. C<$which> is
either "r" or "right" for padding on the right (the default if not specified),
"l" or "left" for padding on the right, or "c" or "center" or "centre" for
left+right padding to center the text.

C<$padchar> is whitespace if not specified. It should be string having the width
of 1 column.

=head2 qqquote($str) => STR

Quote or encode C<$str> to the Perl double quote (C<qq>) literal representation
of the string. Example:

 say qqquote("a");        # => "a"
 say qqquote("a\n");      # => "a\n"
 say qqquote('"');        # => "\""
 say qqquote('$foo');     # => "\$foo"

This code is taken from C<quote()> in L<Data::Dump>. Maybe I didn't look more
closely, but I couldn't a module that provides a function to do something like
this. L<String::Escape>, for example, provides C<qqbackslash> but it does not
escape C<$>.


None are exported by default, but they are exportable.

=head1 SEE ALSO

L<SHARYANTO>

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/SHARYANTO-String-Util>.

=head1 SOURCE

Source repository is at L<HASH(0x353ed90)>.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website
https://rt.cpan.org/Public/Dist/Display.html?Name=SHARYANTO-String-Util

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

Steven Haryanto <stevenharyanto@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Steven Haryanto.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut