PHP::Strings - Implement some of PHP's string functions.

    use PHP::Strings;

    my $slashed = addcslashes( $not_escaped, $charlist );
    my $wordcount = str_word_count( $string );
    my @words     = str_word_count( $string, 1 );
    my %positions = str_word_count( $string, 2 );
    my $clean = strip_tags( $html, '<a><b><i><u>' );
    my $unslashed = stripcslashes( '\a\b\f\n\r\xae' );

    use PHP::Strings qw( str_pad addcslashes );

    use PHP::Strings qw( :str_pad );
    # This grabs str_pad, STR_PAD_LEFT, STR_PAD_BOTH, STR_PAD_RIGHT.

    use PHP::Strings qw( :all );

    my $slashed = addcslashes( $not_escaped, $charlist );

    my $split = chunk_split( $body [, $chunklen [, $end ] ] );

    $body =~ s/(.{$chunklen})/$1$end/sg;
    $body .= $end;

   Mode  Return value
   ----  ------------
    0    Return hash of byte values and frequencies.
    1    As for 0, but hash does not contain bytes with frequency of 0.
    2    As for 0, but hash only contains bytes with frequency of 0.
    3    Return string composed of used byte-values.
    4    Return string composed of unused byte-values.

    my %freq = count_chars( $string, 1 );

    my $wordcount = str_word_count( $string );
    my @words     = str_word_count( $string, 1 );
    my %positions = str_word_count( $string, 2 );

    my $wordcount = () = $string =~ m/(\S+)/g;

    my @words = $string =~ m/(\S+)/g;

    my $clean = strip_tags( $html, '<a><b><i><u>' );
You really want L<HTML::Scrubber>.

    my $unslashed = stripcslashes( '\a\b\f\n\r\xae' );

    http://rt.cpan.org/NoAuth/ReportBug.html?Queue=PHP-Strings
    ( shorter URL: http://xrl.us/4at )

    bug-php-strings@rt.cpan.org

package PHP::Strings;
#line 1 Strings.tt
# vim: ft=perl
use strict;
use warnings FATAL => 'all';
our $VERSION = '0.28';

use base qw( Exporter );
use Carp qw( croak );
use vars qw( %EXPORT_TAGS @EXPORT @EXPORT_OK @badeggs );
use Params::Validate qw( :all );
use Scalar::Util qw( looks_like_number );

use constant STRING => {
    type => SCALAR,
};
use constant INTEGER => {
    type => SCALAR,
    regex => qr{^\d+$}
};
use constant NUMBER => {
    type => SCALAR,
    callbacks => {
        'is a number' => sub {
            defined $_[0] and looks_like_number $_[0]
        }
    },
};

sub NUMBER_RANGE ($$) {
    my ($min, $max) = @_;
    return {
        %{+INTEGER},
        callbacks => {
            "Number between $min and $max" => sub {
                $_[0] =~ /^\d+$/ and $min <= $_[0] and $_[0] <= $max
            }
        }
    };
}

sub death
{
    local $_ = shift;
    s/^=.*$//gm;
    s/^\n+//g;
    s/\n+$//g;
    croak "\n$_\n\n";
}

@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;

BEGIN { $EXPORT_TAGS{addcslashes} = [ qw(
    addcslashes 
) ] }

#line 0 fns/addcslashes.fn
sub addcslashes
{
    my ($str, $charlist) = validate_pos( @_,
        STRING, STRING,
    );

    my @patterns = split /(.\.\..)/, $charlist;
    for (@patterns) {
        if ( m/ \A (.)\.\.(.) \z /x ) {
            if ( ord $1 > ord $2 ) {
                $_ = "\Q$1$2.";
            } else {
                $_ = "\Q$1\E-\Q$2\E";
            }
        } else {
            $_ = "\Q$_";
        }
    }
    my $tr = join '', @patterns;
    $str =~ s/([$tr])/\\$1/g;

    return $str;
}

sub addslashes {
    death(<<'EODEATH');

=pod

B<PHP::Strings::addslashes WILL NOT BE IMPLEMENTED>.

Returns a string with backslashes before characters that need to be
quoted in SQL queries. You should never need this function. I mean,
never.

L<DBI>, the standard method of accessing databases with perl, does all
this for you. It provides by a C<quote> method to escape anything, and
it provides placeholders and bind values so you don't even have to worry
about escaping. In PHP, PEAR DB also provides this facility.

L<DBI> is also aware that some databases don't escape in this method,
such as mssql which uses doubled characters to escape (like some
versions of BASIC). This function doesn't.

The less said about PHP's C<magic_quotes> "feature", the better.


=cut

EODEATH
}



BEGIN { push @badeggs, "addslashes" };

sub bin2hex {
    death(<<'EODEATH');

=pod

B<PHP::Strings::bin2hex WILL NOT BE IMPLEMENTED>.

This is trivially implemented using L<pack|perlfunc/"pack">.

    my $hex = unpack "H*", $data;


=cut

EODEATH
}



BEGIN { push @badeggs, "bin2hex" };

# No fn export due to clash with reserved perl keyword.

# No fn export due to clash with reserved perl keyword.

BEGIN { $EXPORT_TAGS{chunk_split} = [ qw(
    chunk_split 
) ] }

#line 0 fns/chunk_split.fn
sub chunk_split
{
    my ( $body, $chunklen, $end ) = validate_pos( @_,
        STRING,
        { %{+INTEGER}, optional => 1, default => 76 },
        { %{+STRING}, optional => 1, default => "\r\n" },
    );

    $body =~ s/(.{$chunklen})/$1$end/sg;
    $body .= $end;

    return $body;
}

sub convert_cyr_string {
    death(<<'EODEATH');

=pod

B<PHP::Strings::convert_cyr_string WILL NOT BE IMPLEMENTED>.

Perl has the L<Encode> module to convert between character encodings.

=cut

EODEATH
}



BEGIN { push @badeggs, "convert_cyr_string" };

BEGIN { $EXPORT_TAGS{count_chars} = [ qw(
    count_chars 
) ] }

#line 0 fns/count_chars.fn
sub count_chars
{
    my ( $input, $mode ) = validate_pos( @_,
        STRING,
        {
            %{+NUMBER_RANGE( 0, 4 )},
            optional => 1,
            default => 0
        },
    );

    if ( $mode < 3 ) # Frequency
    {
        use bytes;
        my %freq;
        @freq{0..255} = (0) x 256 if $mode != 1;
        $freq{ord $_}++ for split //, $input;
        if ( $mode == 2 ) {
            $freq{$_} and delete $freq{$_} for keys %freq;
        }
        return %freq;
    }
    else
    {
        my %freq = count_chars( $input, $mode-2 );
        return join '', map chr, sort keys %freq;
    }

    croak "Reached a line we should not have.";
}

sub crc32 {
    death(<<'EODEATH');

=pod

B<PHP::Strings::crc32 WILL NOT BE IMPLEMENTED>.

See the L<String::CRC32> module.


=cut

EODEATH
}



BEGIN { push @badeggs, "crc32" };

# No fn export due to clash with reserved perl keyword.

sub echo {
    death(<<'EODEATH');

=pod

B<PHP::Strings::echo WILL NOT BE IMPLEMENTED>.

See L<perlfunc/"print">.

=cut

EODEATH
}



BEGIN { push @badeggs, "echo" };

sub explode {
    death(<<'EODEATH');

=pod

B<PHP::Strings::explode WILL NOT BE IMPLEMENTED>.

Use the C<\Q> regex metachar and L<split|perlfunc/"split">.

    my @pieces = split /\Q$separator/, $string, $limit;

See L<perlfunc/"split"> for more details.

Note that C<split //> will split between every character, rather than
returning false. Note also that C<split "..."> is the same as
C<split /.../> which means to split everywhere three characters are
matched. The first argument to C<split> is always a regex.


=cut

EODEATH
}



BEGIN { push @badeggs, "explode" };

sub fprintf {
    death(<<'EODEATH');

=pod

B<PHP::Strings::fprintf WILL NOT BE IMPLEMENTED>.

Perl's L<printf|perlfunc/"printf"> can be told to which file handle to
print.

    printf FILEHANDLE $format, @args;

See L<perlfunc/"printf"> and L<perlfunc/"print"> for details.


=cut

EODEATH
}



BEGIN { push @badeggs, "fprintf" };

sub get_html_translation_table {
    death(<<'EODEATH');

=pod

B<PHP::Strings::get_html_translation_table WILL NOT BE IMPLEMENTED>.

Use the L<HTML::Entities> module to escape and unescape characters.

=cut

EODEATH
}



BEGIN { push @badeggs, "get_html_translation_table" };

sub hebrev {
    death(<<'EODEATH');

=pod

B<PHP::Strings::hebrev WILL NOT BE IMPLEMENTED>.

Use the L<Encode> module to convert between character encodings.

=cut

EODEATH
}



BEGIN { push @badeggs, "hebrev" };

sub hebrevc {
    death(<<'EODEATH');

=pod

B<PHP::Strings::hebrevc WILL NOT BE IMPLEMENTED>.

Use the L<Encode> module to convert between character encodings.

=cut

EODEATH
}



BEGIN { push @badeggs, "hebrevc" };

sub html_entity_decode {
    death(<<'EODEATH');

=pod

B<PHP::Strings::html_entity_decode WILL NOT BE IMPLEMENTED>.

Use the L<HTML::Entities> module to decode character entities.

=cut

EODEATH
}



BEGIN { push @badeggs, "html_entity_decode" };

sub htmlentities {
    death(<<'EODEATH');

=pod

B<PHP::Strings::htmlentities WILL NOT BE IMPLEMENTED>.

Use the L<HTML::Entities> module to encode character entities.

=cut

EODEATH
}



BEGIN { push @badeggs, "htmlentities" };

sub htmlspecialchars {
    death(<<'EODEATH');

=pod

B<PHP::Strings::htmlspecialchars WILL NOT BE IMPLEMENTED>.

Use the L<HTML::Entities> module to encode character entities.

=cut

EODEATH
}



BEGIN { push @badeggs, "htmlspecialchars" };

sub implode {
    death(<<'EODEATH');

=pod

B<PHP::Strings::implode WILL NOT BE IMPLEMENTED>.

See L<perlfunc/"join">. Note that join cannot accept its arguments in
either order because that's just not how Perl arrays and lists work.
Note also that the joining sequence is not optional.


=cut

EODEATH
}



BEGIN { push @badeggs, "implode" };

# No fn export due to clash with reserved perl keyword.

sub levenshtein {
    death(<<'EODEATH');

=pod

B<PHP::Strings::levenshtein WILL NOT BE IMPLEMENTED>.

I have no idea why PHP has this function.

See L<Text::Levenshtein>, L<Text::LevenshteinXS>, L<String::Approx>,
L<Text::PHraseDistance> and probably any number of other modules on
CPAN.


=cut

EODEATH
}



BEGIN { push @badeggs, "levenshtein" };

sub ltrim {
    death(<<'EODEATH');

=pod

B<PHP::Strings::ltrim WILL NOT BE IMPLEMENTED>.

As per L<perlfaq>:

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

A basic glance through L<perlretut> or L<perlreref> should give you an
idea on how to change what characters get trimmed.


=cut

EODEATH
}



BEGIN { push @badeggs, "ltrim" };

sub md5 {
    death(<<'EODEATH');

=pod

B<PHP::Strings::md5 WILL NOT BE IMPLEMENTED>.

See L<Digest::MD5> which provides a number of functions for computing
MD5 hashes from various sources and to various formats.

Note: the user notes for this function at http://www.php.net/md5 are
among the most unintentionally funny and misinformed I've read.


=cut

EODEATH
}



BEGIN { push @badeggs, "md5" };

sub md5_file {
    death(<<'EODEATH');

=pod

B<PHP::Strings::md5_file WILL NOT BE IMPLEMENTED>.

The L<Digest::MD5> module provides sufficient support.

    use Digest::MD5;

    sub md5_file
    {
        my $filename = shift;
        my $ctx = Digest::MD5->new;
        open my $fh, '<', $filename or die $!;
        binmode( $fh );
        $ctx->addfile( $fh )->digest; # or hexdigest, or b64digest
    }

Despite providing that possible implementation just above, I've chosen to
not include it as an export due to the amount of flexibility of
L<Digest::MD5> and the number of ways you may want to get your file
handle. After all, you may want to use L<Digest::SHA1>, or
L<Digest::MD4> or some other digest mechanism.

Again, I wonder why PHP has the function as they so arbitrarily
hobble it.


=cut

EODEATH
}



BEGIN { push @badeggs, "md5_file" };

sub metaphone {
    death(<<'EODEATH');

=pod

B<PHP::Strings::metaphone WILL NOT BE IMPLEMENTED>.

L<Text::Metaphone> and L<Text::DoubleMetaphone> and
L<Text::TransMetaphone> all provide metaphonic calculations.


=cut

EODEATH
}



BEGIN { push @badeggs, "metaphone" };

BEGIN { $EXPORT_TAGS{money_format} = [ qw(
    money_format 
) ] }

#line 0 fns/money_format.fn
sub money_format
{
    my ( $format, @amounts ) = validate_with(
        params => \@_,
        allow_extra => 1,
        spec => [
            {
                type => SCALAR,
            },
            NUMBER,
        ]
    );

    my $rv = _strfmon( $format, @amounts );

    return $rv;
}

sub nl2br {
    death(<<'EODEATH');

=pod

B<PHP::Strings::nl2br WILL NOT BE IMPLEMENTED>.

This is trivially implemented as:

    s,$,<br />,mg;


=cut

EODEATH
}



BEGIN { push @badeggs, "nl2br" };

sub nl_langinfo {
    death(<<'EODEATH');

=pod

B<PHP::Strings::nl_langinfo WILL NOT BE IMPLEMENTED>.

L<I18N::Langinfo> has a C<langinfo> command that corresponds to PHP's
C<nl_langinfo> function.


=cut

EODEATH
}



BEGIN { push @badeggs, "nl_langinfo" };

BEGIN { $EXPORT_TAGS{number_format} = [ qw(
    number_format 
) ] }

#line 0 fns/number_format.fn
sub number_format
{
    my ( $number, $decimals, $dec, $thousands ) = validate_pos( @_,
        NUMBER,
        { %{+NUMBER}, optional => 1 },
        { %{+STRING}, optional => 1, default => '.' },
        { %{+STRING}, optional => 1, default => ',' },
    );

    my $format = $decimals ? "%.${decimals}f" : "%d";

    my $formatted = 'XXX';

    return $formatted;
}

# No fn export due to clash with reserved perl keyword.

sub parse_str {
    death(<<'EODEATH');

=pod

B<PHP::Strings::parse_str WILL NOT BE IMPLEMENTED>.

See instead the L<CGI> and L<URI> modules which handles that sort of
thing.


=cut

EODEATH
}



BEGIN { push @badeggs, "parse_str" };

# No fn export due to clash with reserved perl keyword.

# No fn export due to clash with reserved perl keyword.

sub quoted_printable_decode {
    death(<<'EODEATH');

=pod

B<PHP::Strings::quoted_printable_decode WILL NOT BE IMPLEMENTED>.

L<MIME::QuotedPrint> provides functions for encoding and decoding
quoted-printable strings.


=cut

EODEATH
}



BEGIN { push @badeggs, "quoted_printable_decode" };

# No fn export due to clash with reserved perl keyword.

sub rtrim {
    death(<<'EODEATH');

=pod

B<PHP::Strings::rtrim WILL NOT BE IMPLEMENTED>.

Another trivial regular expression:

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

See the notes on L<"ltrim">.


=cut

EODEATH
}



BEGIN { push @badeggs, "rtrim" };

sub setlocale {
    death(<<'EODEATH');

=pod

B<PHP::Strings::setlocale WILL NOT BE IMPLEMENTED>.

C<setlocale> is provided by the L<POSIX> module.

=cut

EODEATH
}



BEGIN { push @badeggs, "setlocale" };

sub sha1 {
    death(<<'EODEATH');

=pod

B<PHP::Strings::sha1 WILL NOT BE IMPLEMENTED>.

See L<"md5">, mentally substituting L<Digest::SHA1> for L<Digest::MD5>,
although the user notes are not as funny.


=cut

EODEATH
}



BEGIN { push @badeggs, "sha1" };

sub sha1_file {
    death(<<'EODEATH');

=pod

B<PHP::Strings::sha1_file WILL NOT BE IMPLEMENTED>.

See L<"md5_file">

=cut

EODEATH
}



BEGIN { push @badeggs, "sha1_file" };

BEGIN { $EXPORT_TAGS{similar_text} = [ qw(
    similar_text 
) ] }

#line 0 fns/similar_text.fn
sub similar_text { croak "TBD" }

sub soundex {
    death(<<'EODEATH');

=pod

B<PHP::Strings::soundex WILL NOT BE IMPLEMENTED>.

See L<Text::Soundex>, which also happens to be a core module.

=cut

EODEATH
}



BEGIN { push @badeggs, "soundex" };

# No fn export due to clash with reserved perl keyword.

sub sscanf {
    death(<<'EODEATH');

=pod

B<PHP::Strings::sscanf WILL NOT BE IMPLEMENTED>.

This is a godawful function. You should be using regular expressions
instead. See L<perlretut> and L<perlre>.


=cut

EODEATH
}



BEGIN { push @badeggs, "sscanf" };

sub str_ireplace {
    death(<<'EODEATH');

=pod

B<PHP::Strings::str_ireplace WILL NOT BE IMPLEMENTED>.

Use the C<s///> operator instead. See L<perlop> and L<perlre> for
details.


=cut

EODEATH
}



BEGIN { push @badeggs, "str_ireplace" };

BEGIN { $EXPORT_TAGS{str_pad} = [ qw(
    str_pad STR_PAD_RIGHT STR_PAD_LEFT STR_PAD_BOTH 
) ] }

#line 0 fns/str_pad.fn
use constant STR_PAD_RIGHT => 1;
use constant STR_PAD_LEFT  => 2;
use constant STR_PAD_BOTH  => 3;

sub str_pad
{
    my ( $input, $length, $pad, $options ) = validate_pos( @_,
        STRING,
        INTEGER,
        { %{+STRING}, optional => 1, default => ' ' },
        { %{+INTEGER}, optional => 1, default => STR_PAD_RIGHT },
    );

    return $input if $length < length $input;

    # Work out where to place our string.
    my $start = 0;
    my $diff = $length - length $input;
    my $rv;

    if ( $options == STR_PAD_RIGHT )
    {
        my $padding = substr( $pad x $diff, 0, $diff );
        $rv = $input . $padding;
    }
    elsif ( $options == STR_PAD_LEFT )
    {
        my $padding = substr( $pad x $diff, 0, $diff );
        $rv = $padding . $input;
    }
    elsif ($options == STR_PAD_BOTH )
    {
        $rv = substr( $pad x $length, 0, $length );
        substr( $rv, $diff / 2, length $input ) = $input;
    }
    else
    {
        croak "Invalid 4th argument to str_pad";
    }

    $rv;
}

sub str_repeat {
    death(<<'EODEATH');

=pod

B<PHP::Strings::str_repeat WILL NOT BE IMPLEMENTED>.

Instead, use the C<x> operator. See L<perlop> for details.

    my $by_ten = "-=" x 10;


=cut

EODEATH
}



BEGIN { push @badeggs, "str_repeat" };

sub str_replace {
    death(<<'EODEATH');

=pod

B<PHP::Strings::str_replace WILL NOT BE IMPLEMENTED>.

See the C<s///> operator. L<perlop> and L<perlre> have details.


=cut

EODEATH
}



BEGIN { push @badeggs, "str_replace" };

sub str_rot13 {
    death(<<'EODEATH');

=pod

B<PHP::Strings::str_rot13 WILL NOT BE IMPLEMENTED>.

This is rather trivially implemented as:

    $message =~ tr/A-Za-z/N-ZA-Mn-za-m/

(As per "Programming Perl", 3rd edition, section 5.2.4.)


=cut

EODEATH
}



BEGIN { push @badeggs, "str_rot13" };

BEGIN { $EXPORT_TAGS{str_shuffle} = [ qw(
    str_shuffle 
) ] }

#line 0 fns/str_shuffle.fn
sub str_shuffle
{
    require List::Util;
    my ( $string ) = validate_pos( @_, STRING );

    return join '', List::Util::shuffle split //, $string;
}

sub str_split {
    death(<<'EODEATH');

=pod

B<PHP::Strings::str_split WILL NOT BE IMPLEMENTED>.

See L<perlfunc/"split"> for details.

    my @bits = split /(.{,$len})/, $string;


=cut

EODEATH
}



BEGIN { push @badeggs, "str_split" };

BEGIN { $EXPORT_TAGS{str_word_count} = [ qw(
    str_word_count 
) ] }

#line 0 fns/str_word_count.fn

   my @str_word_count = (

       sub { 
           my $count = () = $_[0] =~ m/(\S+)/g;
           return $count;
       },

       sub {
           my @words = $_[0] =~ m/(\S+)/g;
           return @words;
       },

       sub {
           my %words;
           while ( $_[0] =~ m/(\S+)/g )
           {
               $words{ $-[1] } = $1;
           }
           return %words;
       },
   );

   sub str_word_count
   {
       my ( $string, $format ) = validate_pos( @_,
           STRING,
           {
               %{+NUMBER_RANGE( 0, $#str_word_count )},
               default => 0,
           }
       );

       return $str_word_count[$format]->( $string );
   }

sub strcasecmp {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strcasecmp WILL NOT BE IMPLEMENTED>.

Equivalent to:

    lc($a) cmp lc($b)


=cut

EODEATH
}



BEGIN { push @badeggs, "strcasecmp" };

sub strchr {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strchr WILL NOT BE IMPLEMENTED>.

See L<"strstr">

=cut

EODEATH
}



BEGIN { push @badeggs, "strchr" };

sub strcmp {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strcmp WILL NOT BE IMPLEMENTED>.

Equivalent to:

    $a cmp $b


=cut

EODEATH
}



BEGIN { push @badeggs, "strcmp" };

sub strcoll {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strcoll WILL NOT BE IMPLEMENTED>.

Equivalent to:

    use locale;

    $a cmp $b


=cut

EODEATH
}



BEGIN { push @badeggs, "strcoll" };

sub strcspn {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strcspn WILL NOT BE IMPLEMENTED>.

Trivially equivalent to:

    my $cspn;
    $cspn = $-[0]-1 if $string =~ m/[chars]/;


=cut

EODEATH
}



BEGIN { push @badeggs, "strcspn" };

BEGIN { $EXPORT_TAGS{strip_tags} = [ qw(
    strip_tags 
) ] }

#line 0 fns/strip_tags.fn
sub strip_tags
{
    require HTML::Scrubber;
    require HTML::Entities;

    my ( $html, $allowed ) = validate_pos( @_,
        STRING,
        {
            %{+STRING},
            optional => 1,
            regex => qr{^(<\w+>)+$},
        },
    );

    my @allow = ();
    @allow = $allowed =~ /<(\w+)>/g if defined $allowed;

    my $scrubber = HTML::Scrubber->new(
        @allow ? ( allow => \@allow ) : ()
    );

    $scrubber->$_(1) for qw( comment process script style );

    $scrubber->default(
        undef,
        { '*' => 1 },
    );

    return HTML::Entities::decode_entities( $scrubber->scrub( $html ) );
}

BEGIN { $EXPORT_TAGS{stripcslashes} = [ qw(
    stripcslashes 
) ] }

#line 0 fns/stripcslashes.fn
sub stripcslashes
{
    my ($string) = validate_pos( @_, STRING );

    $string =~ s{
                        \\([abfnrtv\\?'"])
                        |
                        \\(\d\d\d)
                        |
                        \\(x[[:xdigit:]]{2})
                        |
                        \\(x[[:xdigit:]])
        }{
                if ( $+ eq 'v' ) {
                        "\013";
                } elsif (length $+ == 1) {
                        eval qq{qq/\\$+/};
                } else {
                        chr oct "0$+";
                }
        }exg ;

    return $string;
}

sub stripos {
    death(<<'EODEATH');

=pod

B<PHP::Strings::stripos WILL NOT BE IMPLEMENTED>.

Trivially implemented as:
 
    my $pos    = index( lc $haystack, lc $needle );
    my $second = index( lc $haystack, lc $needle, $pos );

Note that unlike C<stripos>, C<index> returns C<-1> if
C<$needle> is not found. This makes testing much simpler.

If you want the additional behaviour of non-strings being
converted to integers and from there to characters of
that value, then you're silly. If you want to find a
character of particular value, explicitly use the
C<< L<chr|perlfunc/"chr"> >> function:

    my $charpos = index( lc $haystack, lc chr $char );


=cut

EODEATH
}



BEGIN { push @badeggs, "stripos" };

sub stripslashes {
    death(<<'EODEATH');

=pod

B<PHP::Strings::stripslashes WILL NOT BE IMPLEMENTED>.

If you can think of a good reason for this function, you
have more imagination than I do.


=cut

EODEATH
}



BEGIN { push @badeggs, "stripslashes" };

sub stristr {
    death(<<'EODEATH');

=pod

B<PHP::Strings::stristr WILL NOT BE IMPLEMENTED>.

Use L<substr()|perlfunc/"substr"> and L<index()|perlfunc/"index"> instead.

    my $strstr = substr( $haystack, index( lc $haystack, lc $needle ) );

Or a regex:

    my ( $strstr ) = $haystack =~ /(\Q$needle\E.*$)/si;


=cut

EODEATH
}



BEGIN { push @badeggs, "stristr" };

sub strlen {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strlen WILL NOT BE IMPLEMENTED>.

See L<perldoc/"length">.


=cut

EODEATH
}



BEGIN { push @badeggs, "strlen" };

sub strnatcasecmp {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strnatcasecmp WILL NOT BE IMPLEMENTED>.

See L<Sort::Naturally>.


=cut

EODEATH
}



BEGIN { push @badeggs, "strnatcasecmp" };

sub strnatcmp {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strnatcmp WILL NOT BE IMPLEMENTED>.

See L<Sort::Naturally>.


=cut

EODEATH
}



BEGIN { push @badeggs, "strnatcmp" };

sub strncasecmp {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strncasecmp WILL NOT BE IMPLEMENTED>.

Unnecessary. Perl is smart enough. Use
L<substr|perlfunc/"substr">.


=cut

EODEATH
}



BEGIN { push @badeggs, "strncasecmp" };

sub strncmp {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strncmp WILL NOT BE IMPLEMENTED>.

Unnecessary. Perl is smart enough. Use
L<substr|perlfunc/"substr">.


=cut

EODEATH
}



BEGIN { push @badeggs, "strncmp" };

sub strpos {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strpos WILL NOT BE IMPLEMENTED>.

This function is Perl's L<index|perlfunc/"index">
function, however C<index> has a sensible return value.


=cut

EODEATH
}



BEGIN { push @badeggs, "strpos" };

sub strrchr {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strrchr WILL NOT BE IMPLEMENTED>.

See L<perlfunc/"rindex">. Note that all characters in
the C<$needle> are used: if you just want to find the
first character, then extract it.


=cut

EODEATH
}



BEGIN { push @badeggs, "strrchr" };

sub strrev {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strrev WILL NOT BE IMPLEMENTED>.

See L<perlfunc/"reverse">. Note the note about scalar
context.

    my $derf = reverse "fred";
    print scalar reverse "fred";


=cut

EODEATH
}



BEGIN { push @badeggs, "strrev" };

sub strripos {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strripos WILL NOT BE IMPLEMENTED>.

This is just getting silly.

See L<rindex|perlfunc/"rindex"> and L<lc|perlfunc/"lc">.


=cut

EODEATH
}



BEGIN { push @badeggs, "strripos" };

sub strrpos {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strrpos WILL NOT BE IMPLEMENTED>.

See L<rindex|perlfunc/"rindex">.


=cut

EODEATH
}



BEGIN { push @badeggs, "strrpos" };

sub strstr {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strstr WILL NOT BE IMPLEMENTED>.

Use L<substr()|perlfunc/"substr"> and L<index()|perlfunc/"index"> instead.

    my $strstr = substr( $haystack, index( $haystack, $needle ) );

Or a regex:

    my ( $strstr ) = $haystack =~ /(\Q$needle\E.*$)/s;


=cut

EODEATH
}



BEGIN { push @badeggs, "strstr" };

sub strtolower {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strtolower WILL NOT BE IMPLEMENTED>.

See L<perlfunc/"lc">.


=cut

EODEATH
}



BEGIN { push @badeggs, "strtolower" };

sub strtoupper {
    death(<<'EODEATH');

=pod

B<PHP::Strings::strtoupper WILL NOT BE IMPLEMENTED>.

See L<perlfunc/"uc">.


=cut

EODEATH
}



BEGIN { push @badeggs, "strtoupper" };

BEGIN { $EXPORT_TAGS{strtr} = [ qw(
    strtr 
) ] }

#line 0 fns/strtr.fn
sub _make_re_list
{
    return qr/@{[ join '|', map quotemeta, @_ ]}/;
}

sub _strtr_pairs
{
    my ( $string, $pairs ) = @_;
    my @alternates = reverse sort { length $a <=> length $b } keys %$pairs;

    # Exit quickly if we don't need to stay.
    return $string unless @alternates;

    my $regex = _make_re_list( @alternates );

    $string =~ s/($regex)/$pairs->{$1}/eg;
    
    return $string;
}

sub _strtr_tr
{
    my ( $string, $from, $to ) = @_;

    # Exit quickly if we don't need to stay.
    return $string unless length $from;

    # Ignore excess characters
    if ( length $from != length $to )
    {
        if ( length $to > length $from ) {
            substr( $to, (length $from) ) = "";
        } elsif ( length $from > length $to ) {
            substr( $from, (length $to) ) = "";
        }
    }

    eval "\$string =~ tr/$from/$to/, 1" or die $@;

    return $string;
}

sub strtr
{
    my ( $string, $from, $to ) = validate_pos( @_,
        STRING,
        STRING|HASHREF,
        {
            %{+STRING},
            optional => 1,
        },
    );

    if ( ref $from eq 'HASH' )
    {
        if ( not defined $to )
        {
            return _strtr_pairs( $string, $from );
        }
        else
        {
            croak "Parameter #3 to PHP::Strings::strtr ",
                "present when it should not be in 2-argument form.";
        }
    }
    elsif ( defined $from and not defined $to )
    {
        croak "Parameter #3 to PHP::Strings::strtr missing from".
            " 3-argument form.";
    }
    else
    {
        return _strtr_tr( $string, $from, $to );
    }
}

# No fn export due to clash with reserved perl keyword.

sub substr_compare {
    death(<<'EODEATH');

=pod

B<PHP::Strings::substr_compare WILL NOT BE IMPLEMENTED>.

Use L<substr|perlfunc/"substr"> and
L<the C<cmp> operator|perlop/"Relational Operators">.


=cut

EODEATH
}



BEGIN { push @badeggs, "substr_compare" };

sub substr_count {
    death(<<'EODEATH');

=pod

B<PHP::Strings::substr_count WILL NOT BE IMPLEMENTED>.

This is even in the FAQ.

L<http://faq.perl.org/perlfaq4.html#How_can_I_count_the_>

    my $count = () = $string =~ /regex/g;


=cut

EODEATH
}



BEGIN { push @badeggs, "substr_count" };

sub substr_replace {
    death(<<'EODEATH');

=pod

B<PHP::Strings::substr_replace WILL NOT BE IMPLEMENTED>.

See L<perlfunc/"substr">.


=cut

EODEATH
}



BEGIN { push @badeggs, "substr_replace" };

sub trim {
    death(<<'EODEATH');

=pod

B<PHP::Strings::trim WILL NOT BE IMPLEMENTED>.

Also in the FAQ.

L<http://faq.perl.org/perlfaq4.html#How_do_I_strip_blank>

See also L<"rtrim"> and L<"ltrim">.


=cut

EODEATH
}



BEGIN { push @badeggs, "trim" };

# No fn export due to clash with reserved perl keyword.

sub ucwords {
    death(<<'EODEATH');

=pod

B<PHP::Strings::ucwords WILL NOT BE IMPLEMENTED>.

Another Perl FAQ.

L<http://faq.perl.org/perlfaq4.html#How_do_I_capitalize_>


=cut

EODEATH
}



BEGIN { push @badeggs, "ucwords" };

sub vprintf {
    death(<<'EODEATH');

=pod

B<PHP::Strings::vprintf WILL NOT BE IMPLEMENTED>.

Unlike PHP, Perl isn't stupid. See L<printf|perlfunc/"printf">.


=cut

EODEATH
}



BEGIN { push @badeggs, "vprintf" };

sub vsprintf {
    death(<<'EODEATH');

=pod

B<PHP::Strings::vsprintf WILL NOT BE IMPLEMENTED>.

Unlike PHP, Perl isn't stupid. See L<sprintf|perlfunc/"sprintf">.


=cut

EODEATH
}



BEGIN { push @badeggs, "vsprintf" };

sub wordwrap {
    death(<<'EODEATH');

=pod

B<PHP::Strings::wordwrap WILL NOT BE IMPLEMENTED>.

See L<Text::Wrap>, a core module.


=cut

EODEATH
}



BEGIN { push @badeggs, "wordwrap" };
#line 214 Strings.tt

# ========================================================================

BEGIN {
    $EXPORT_TAGS{$_} = [ $_ ] for @badeggs;
}

require XSLoader;
XSLoader::load('PHP::Strings', $VERSION);

1;

__END__