view release on metacpan or  search on metacpan

lib/Apache2/API/Request.pm  view on Meta::CPAN

    my $self = shift( @_ );
    if( @_ )
    {
        my $hash = shift( @_ );
        return( $self->error( "Value provided is not a hash reference." ) ) if( ref( $hash ) ne 'HASH' );
        #my $pool = $self->pool->new;
        #my $table = APR::Table::make( $pool, 1 );
        #foreach my $k ( sort( keys( %$hash ) ) )
        #{
        #   $table->set( $k => $hash->{ $k } );
        #}
        my $r = $self->request;
        #$r->notes( $table );
        $r->pnotes( $hash );
    }
    return( $self->request->notes );
}

sub output_filters { return( shift->_try( 'request', 'output_filters', @_ ) ); }

sub param
{
    my $self = shift( @_ );
    my $name = shift( @_ ) || return;
    my $r = Apache2::API::Request::Params->new( $self->request );
    if( @_ )
    {
        return( $r->param( $name, @_ ) );
    }
    else
    {
        my $val = $r->param( $name );
        my $up = $r->upload( $name );
        # Return the Net:::API::REST::Request::Upload object if it is one
        return( $up ) if( Scalar::Util::blessed( $up ) );
        return( $val );
    }
}

sub params
{
    my $self = shift( @_ );
    return( $self->query ) if( $self->method eq 'GET' );
    # my $r = Apache2::Request->new( $self->request );
    my $r = Apache2::API::Request::Params->new( request => $self->request );
    # https://perl.apache.org/docs/1.0/guide/snippets.html#Reusing_Data_from_POST_request
    # my %params = $r->method eq 'POST' ? $r->content : $r->args;
    # Data are in pure utf8; not perl's internal, so it is up to us to decode them
    my( @params ) = $r->param;
    my( @uploads ) = $r->upload;
    my $upload_fields = {};
    # To make it easy to check if it exists
    if( scalar( @uploads ) )
    {
        @$upload_fields{ @uploads } = ( 1 ) x scalar( @uploads );
    }
    my $form = {};
    #my $io = IO::File->new( ">/tmp/form_data.txt" );
    #my $io2 = IO::File->new( ">/tmp/form_data_after_our_decoding.txt" );
    #my $raw = IO::File->new( ">/tmp/raw_form_data.txt" );
    #$io->binmode( ':utf8' );
    #$io2->binmode( ':utf8' );
    foreach my $k ( @params )
    {
        my( @values ) = $r->param( $k );
        #$raw->print( "$k => " );
        #$io->print( "$k => " );
        my $name = utf8::is_utf8( $k ) ? $k : Encode::decode_utf8( $k );
        #$io2->print( "$name => " );
        $form->{ $name } = scalar( @values ) > 1 ? \@values : $values[0];
        if( CORE::exists( $upload_fields->{ $name } ) )
        {
            my $up = $r->upload( $name );
            if( !$up )
            {
                CORE::warn( "Error: could not get the Apache2::API::Params::Upload object for this upload field \"$name\".\n" );
                next;
            }
            else
            {
                $form->{ $name } = $up;
            }
        }
        elsif( ref( $form->{ $name } ) )
        {
            #$raw->print( "[\n" );
            #$io->print( "[\n" );
            #$io2->print( "[\n" );
            for( my $i = 0; $i < scalar( @{$form->{ $name }} ); $i++ )
            {
                #$raw->print( "\t[$i]: ", $form->{ $name }->[ $i ], "\n" );
                #$io->print( "\t[$i]: ", $form->{ $name }->[ $i ], "\n" );
                $form->{ $name }->[ $i ] = utf8::is_utf8( $form->{ $name }->[ $i ] ) ? $form->{ $name }->[ $i ] : Encode::decode_utf8( $form->{ $name }->[ $i ] );
                #$io2->print( "\t[$i]: ", $form->{ $name }->[ $i ], "\n" );
            }
            #$raw->print( "];\n" );
            #$io->print( "];\n" );
            #$io2->print( "];\n" );
        }
        else
        {
            #$raw->print( $form->{ $name }, "\n" );
            #$io->print( $form->{ $name }, "\n" );
            $form->{ $name } = utf8::is_utf8( $form->{ $name } ) ? $form->{ $name } : Encode::decode_utf8( $form->{ $name } );
            #$io2->print( $form->{ $name }, "\n" );
        }
    }
    #$raw->close;
    #$io->close;
    #$io2->close;
    return( $form );
}

# NOTE: parse_date for compatibility
sub parse_date { return( shift->datetime->parse_date( @_ ) ); }

# example: /bin:/usr/bin:/usr/local/bin
sub path { return( shift->env( 'PATH', @_ ) ); }

sub path_info { return( shift->_try( 'request', 'path_info', @_ ) ); }

sub payload { return( shift->_set_get_hash( 'payload', @_ ) ); }