File Coverage

lib/HTTP/Promise/Headers/ContentDisposition.pm

Criterion	Covered	Total	%
statement	75	80	93.7
branch	27	34	79.4
condition	13	23	56.5
subroutine	14	16	87.5
pod	9	9	100.0
total	138	162	85.1

##----------------------------------------------------------------------------
## Asynchronous HTTP Request and Promise - ~/lib/HTTP/Promise/Headers/ContentDisposition.pm
## Version v0.1.0
## Copyright(c) 2022 DEGUEST Pte. Ltd.
## Author: Jacques Deguest <[e-mail]>
## Created 2022/05/07
## Modified 2022/05/07
## All rights reserved.
##
##
## This program is free software; you can redistribute  it  and/or  modify  it
## under the same terms as Perl itself.
##----------------------------------------------------------------------------
package HTTP::Promise::Headers::ContentDisposition;
BEGIN
{
    use strict;
    use warnings;
    use warnings::register;
    use parent qw( HTTP::Promise::Headers::Generic );
    our $VERSION = 'v0.1.0';
};

use strict;
use warnings;

sub init
{
    my $self = shift( @_ );
    $self->{filename_charset} = undef;
    $self->{filename_lang}    = undef;
    @_ = () if( @_ == 1 && $self->_is_a( $_[0] => 'Module::Generic::Null' ) );
    if( @_ )
    {
        my $str = shift( @_ );
        return( $self->error( "No value was provided for Content-Disposition field." ) ) if( !defined( $str ) || !length( "$str" ) );
        my $params = $self->_get_args_as_hash( @_ );
        my $hv = $self->_parse_header_value( $str ) ||
            return( $self->pass_error );
        $hv->params( $params ) if( scalar( keys( %$params ) ) );
        $self->_hv( $hv );
    }
    $self->SUPER::init( @_ ) || return( $self->pass_error );
    $self->_field_name( 'Content-Disposition' );
    return( $self );
}

sub as_string { return( shift->_hv_as_string( [qw( name filename )] ) ); }

sub disposition
{
    my $self = shift( @_ );
    if( @_ )
    {
        my $dispo = shift( @_ ) || return( $self->error( "No content disposition was provided." ) );
        my $hv = $self->_hv;
        if( $hv )
        {
            $hv->value( $dispo );
        }
        else
        {
            $hv = $self->_new_hv( $dispo ) || return( $self->pass_error );
            $self->_hv( $hv );
        }
        return( $dispo );
    }
    else
    {
        # No header value object, means there is just nothing set yet
        my $hv = $self->_hv || return( '' );
        return( $hv->value_data );
    }
}

sub filename
{
    my $self = shift( @_ );
    if( @_ )
    {
        my( $fname, $lang ) = @_;
        if( !defined( $fname ) )
        {
            $self->params->delete( 'filename' );
            $self->params->delete( 'filename*' );
        }
        else
        {
            $lang //= $self->filename_lang;
            if( my $enc = $self->_filename_encode( $fname, $lang ) )
            {
                $self->_set_get_param( 'filename*' => $enc ) || return( $self->pass_error );
            }
            else
            {
                $self->_set_get_qparam( filename => $fname );
            }
        }
    }
    else
    {
        my $v = $self->_set_get_qparam( 'filename' );
        if( defined( $v ) && length( $v ) )
        {
            # decode if necessary
            my( $f_charset, $f_lang );
            ( $v, $f_charset, $f_lang ) = $self->_filename_decode( $v );
            $self->filename_charset( $f_charset );
            $self->filename_lang( $f_lang );
        }
        elsif( $v = $self->_set_get_param( 'filename*' ) )
        {
            my( $f_charset, $f_lang );
            ( $v, $f_charset, $f_lang ) = $self->_filename_decode( $v );
            $self->filename_charset( $f_charset );
            $self->filename_lang( $f_lang );
        }
        return( $v );
    }
}

sub filename_charset
{
    my $self = shift( @_ );
    if( @_ )
    {
        my $v = shift( @_ );
        if( !defined( $v ) )
        {
            return( $self->_set_get_scalar_as_object( 'filename_charset', $v ) );
        }
        return( $self->error( "Only supported charset is 'utf-8'." ) ) if( lc( $v ) ne 'utf-8' && lc( $v ) ne 'utf8' );
        # Convenience
        $v = 'utf-8' if( lc( $v ) eq 'utf8' );
        $v = uc( $v );
        return( $self->_set_get_scalar_as_object( 'filename_charset', $v ) );
    }
    return( $self->_set_get_scalar_as_object( 'filename_charset' ) );
}

sub filename_lang { return( shift->_set_get_scalar_as_object( 'filename_lang', @_ ) ); }

sub name { return( shift->_set_get_param( name => @_ ) ); }

sub param { return( shift->_set_get_param( @_ ) ); }

sub params { return( shift->_set_get_params( @_ ) ); }

1;
# NOTE: POD
__END__

=encoding utf-8

=head1 NAME

HTTP::Promise::Headers::ContentDisposition - Content-Disposition Header Field

=head1 SYNOPSIS

    use HTTP::Promise::Headers::ContentDisposition;
    my $cd = HTTP::Promise::Headers::ContentDisposition->new ||
        die( HTTP::Promise::Headers::ContentDisposition->error, "\n" );
    my $dispo = $cd->disposition;
    # For example, attachment
    $cd->disposition( 'inline' );
    $cd->filename( 'some-file.txt' );
    $cd->disposition( 'form-data' );
    $cd->name( 'someField' );
    my $name = $cd->name;
    # Same thing
    my $name = $cd->param( 'name' );
    $cd->params( name => 'someField', filename => 'some-file.txt' );

=head1 VERSION

    v0.1.0

=head1 DESCRIPTION

The following description is taken from Mozilla documentation.

    Content-Disposition: inline
    Content-Disposition: attachment
    Content-Disposition: attachment; filename="filename.jpg"
    Content-Disposition: form-data; name="fieldName"
    Content-Disposition: form-data; name="fieldName"; filename="filename.jpg"

=head1 METHODS

=head2 as_string

Returns a string representation of the Content-Disposition object.

=head2 disposition

Sets or gets the type of C<Content-Disposition> this is. For example: C<attachment>, C<form-data>

=head2 name

Is followed by a string containing the name of the HTML field in the form that the content of this subpart refers to. When dealing with multiple files in the same field (for example, the multiple attribute of an <input type="file"> element), there can be several subparts with the same name.

A name with a value of '_charset_' indicates that the part is not an HTML field, but the default charset to use for parts without explicit charset information.

=head2 filename

Without any argument, this returns the string containing the original name of the file transmitted. The C<filename> is always optional and must not be used blindly by the application: path information should be stripped, and conversion to the server file system rules should be done. This parameter provides mostly indicative information. When used in combination with C<Content-Disposition: attachment>, it is used as the default C<filename> for an eventual "Save As" dialog presented to the user.

If the property C<filename*> is set instead, then it will be decoded and used instead, and the value for L</filename_charset> and L</filename_lang> will be set.

When setting the filename value, this takes an optional language iso 639 code (see L<rfc5987|https://tools.ietf.org/html/rfc5987> and L<rfc2231|https://tools.ietf.org/html/rfc2231>).
If the filename contains non ascii characters, it will be automatically encoded according to L<rfc5987|https://tools.ietf.org/html/rfc5987>. and the property C<filename*> set instead. That property, by rfc standard, takes precedence over the C<filename> one.

The language provided, if any, will be used then.

For example:

    $h->disposition( 'form-data' );
    $h->name( 'fileField' );
    $h->filename( q{file.txt} );
    say "$h";
    # form-data; name="fileField"; filename="file.txt"

    $h->disposition( 'form-data' );
    $h->name( 'fileField' );
    $h->filename( q{ファイル.txt} );
    say "$h";
    # form-data; name="fileField"; filename*="UTF-8''%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB.txt"

    $h->disposition( 'form-data' );
    $h->name( 'fileField' );
    $h->filename( q{ファイル.txt}, 'ja-JP' );
    say "$h";
    # form-data; name="fileField"; filename*="UTF-8'ja-JP'%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB.txt"

    # Using default value
    $h->filename_lang( 'ja-JP' );
    $h->disposition( 'form-data' );
    $h->name( 'fileField' );
    $h->filename( q{ファイル.txt} );
    say "$h";
    # form-data; name="fileField"; filename*="UTF-8'ja-JP'%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB.txt"

    $headers->header( Content_Disposition => "$h" );

The C<Content-Disposition> header value would then contain a property C<filename*> (with the trailing wildcard).

See also L<HTTP::Promise::Headers/decode_filename> and L<HTTP::Promise::Headers/encode_filename> which are used to decode and encode filenames.

=head2 filename_charset

Sets or gets the encoded filename charset.

This is used when the filename contains non-ascii characters, such as Japanese, Korean, or Cyrillic.
Although theoretically one can set any character set, by design this only accepts C<UTF-8> (case insensitive).

This is set automatically when calling L</filename>. You actually need to call L</filename> first to have a value set.

Returns a L<scalar object|Module::Generic::Scalar> containing the filename charset.

=head2 filename_lang

Sets or gets the encoded filename language. This takes an iso 639 language code (see L<rfc1766|https://tools.ietf.org/html/rfc1766>).

This is set automatically when calling L</filename>. You actually need to call L</filename> first to have a value set.

Returns a L<scalar object|Module::Generic::Scalar> containing the filename language.

=head2 param

Sets or gets an arbitrary C<Content-Disposition> property.

Note that if you use this, you bypass other specialised method who do some additional processing, so be mindful.

=head2 params

Sets or gets multiple arbitrary C<Content-Disposition> properties at once.

If called without any arguments, this returns the L<hash object|Module::Generic::Hash> used to store the C<Content-Disposition> properties.

=head1 AUTHOR

Jacques Deguest E<lt>F<[e-mail]>E<gt>

=head1 SEE ALSO

See L<rfc6266, section 4|https://tools.ietf.org/html/rfc6266#section-4>, L<rfc7578, section 4.2|https://tools.ietf.org/html/rfc7578#section-4.2> and L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Content-Disposition>

L<HTTP::Promise>, L<HTTP::Promise::Request>, L<HTTP::Promise::Response>, L<HTTP::Promise::Message>, L<HTTP::Promise::Entity>, L<HTTP::Promise::Headers>, L<HTTP::Promise::Body>, L<HTTP::Promise::Body::Form>, L<HTTP::Promise::Body::Form::Data>, L<HTTP::Promise::Body::Form::Field>, L<HTTP::Promise::Status>, L<HTTP::Promise::MIME>, L<HTTP::Promise::Parser>, L<HTTP::Promise::IO>, L<HTTP::Promise::Stream>, L<HTTP::Promise::Exception>

=head1 COPYRIGHT & LICENSE

Copyright(c) 2022 DEGUEST Pte. Ltd.

All rights reserved.

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

=cut