view release on metacpan or  search on metacpan

lib/Module/Generic/Scalar.pm  view on Meta::CPAN

    if( !CORE::length( $n ) )
    {
        warn( "No number provided to pad the string object.\n" ) if( $self->_warnings_is_enabled );
    }
    elsif( $n !~ /^\-?\d+$/ )
    {
        warn( "Number provided \"$n\" to pad string is not an integer.\n" ) if( $self->_warnings_is_enabled );
    }
    
    if( $n < 0 )
    {
        $$self .= ( "$str" x CORE::abs( $n ) );
    }
    else
    {
        CORE::substr( $$self, 0, 0 ) = ( "$str" x $n );
    }
    return( $self );
}

sub pass_error
{
    my $self = CORE::shift( @_ );
    my $addr = Scalar::Util::refaddr( $self ) || $self;
    my $opts = {};
    my $err;
    my $class;
    no strict 'refs';
    if( scalar( @_ ) )
    {
        # Either an hash defining a new error and this will be passed along to error(); or
        # an hash with a single property: { class => 'Some::ExceptionClass' }
        if( CORE::scalar( @_ ) == 1 && ref( $_[0] ) eq 'HASH' )
        {
            $opts = $_[0];
        }
        else
        {
            # $self->pass_error( $error_object, { class => 'Some::ExceptionClass' } );
            if( CORE::scalar( @_ ) > 1 && ref( $_[-1] ) eq 'HASH' )
            {
                $opts = CORE::pop( @_ );
            }
            $err = $_[0];
        }
    }
    # We set $class only if the hash provided is a one-element hash and not an error-defining hash
    $class = CORE::delete( $opts->{class} ) if( CORE::scalar( CORE::keys( %$opts ) ) == 1 && [CORE::keys( %$opts )]->[0] eq 'class' );
    
    # called with no argument, most likely from the same class to pass on an error 
    # set up earlier by another method; or
    # with an hash containing just one argument class => 'Some::ExceptionClass'
    if( !CORE::defined( $err ) && ( !CORE::scalar( @_ ) || CORE::defined( $class ) ) )
    {
        if( !CORE::defined( $ERRORS->{ $addr } ) )
        {
            warnings::warnif( "No error object provided and no previous error set either! It seems the previous method call returned a simple undef\n" );
        }
        else
        {
            $err = ( CORE::defined( $class ) ? bless( $ERRORS->{ $addr } => $class ) : $ERRORS->{ $addr } );
        }
    }
    elsif( CORE::defined( $err ) && 
           Scalar::Util::blessed( $err ) && 
           ( CORE::scalar( @_ ) == 1 || 
             ( CORE::scalar( @_ ) == 2 && CORE::defined( $class ) ) 
           ) )
    {
        $ERRORS->{ $addr } = $ERROR = ( CORE::defined( $class ) ? bless( $err => $class ) : $err );
    }
    # If the error provided is not an object, we call error to create one
    else
    {
        return( $self->error( @_ ) );
    }
    
    if( want( 'OBJECT' ) )
    {
        require Module::Generic::Null;
        my $null = Module::Generic::Null->new( $err, { debug => $ERRORS->{ $addr }, has_error => 1 });
        rreturn( $null );
    }
    return;
}

sub pos { return( $_[0]->_number( @_ > 1 ? ( CORE::pos( ${$_[0]} ) = $_[1] ) : CORE::pos( ${$_[0]} ) ) ); }

sub prepend { return( shift->substr( 0, 0, ( ( Scalar::Util::reftype( $_[0] ) // '' ) eq 'SCALAR' ? ${$_[0]} : $_[0] ) ) ); }

sub quotemeta { return( __PACKAGE__->_new( CORE::quotemeta( ${$_[0]} ) ) ); }

sub right { return( $_[0]->_new( CORE::substr( ${$_[0]}, ( CORE::int( $_[1] ) * -1 ) ) ) ); }

sub replace
{
    my( $self, $re, $replacement ) = @_;
    # Only to test if this was a regular expression. If it was the array will contain successful match, other it will be empty
    # @rv will contain the regexp matches or the result of the eval
    my @matches = ();
    my @rv = ();
    $re = CORE::defined( $re ) 
        ? ( ref( $re ) eq 'Regexp' || ref( $re ) eq 'Regexp::Common' )
            ? $re
            : qr/(?:\Q$re\E)+/
        : $re;
    # return( $$self =~ s/$re/$replacement/gs );
    @rv = $$self =~ s/$re/$replacement/gs;
    if( scalar( @{^CAPTURE} ) )
    {
        for( my $i = 0; $i < scalar( @{^CAPTURE} ); $i++ )
        {
            push( @matches, ${^CAPTURE}[$i] );
        }
    }
    # For named captures
    my $names = { %+ };
    unless( want( 'OBJECT' ) || want( 'SCALAR' ) || want( 'LIST' ) || scalar( @matches ) )
    {
        return(0);
    }
    return( Module::Generic::RegexpCapture->new( result => \@rv, capture => \@matches, name => $names ) );
}

sub reset { ${$_[0]} = ''; return( $_[0] ); }

sub reverse { return( __PACKAGE__->_new( CORE::scalar( CORE::reverse( ${$_[0]} ) ) ) ); }

sub rindex
{