view release on metacpan or  search on metacpan

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

                my $rv = eval
                {
                    $callback->( $row );
                };
                if( $@ )
                {
                    $self->error( "An error occurred executing callback with data from CSV at line $n", { cause => { data => $row } } );
                    return(0);
                }
                # Returned value from callback is defined, but explicitly false, we indicate that this is the end
                elsif( defined( $rv ) && !$rv )
                {
                    return( $rv );
                }
            }
            else
            {
                push( @$all, $row );
            }
        }
        return(1);
    };

    # If we have a initial first raw from our detect BOM operation earlier, then we use that line of data now.
    $process->( $first_row ) if( $first_row );

    # Read each line of CSV data until the end.
    my $row;
    # while( my $row = $csv->getline( $io ) )
    while( $io->opened && ( $row = eval{ $csv->getline( $io ) } ) )
    {
        $n++;
        my $rv = $process->( $row );
        if( !$rv )
        {
            if( $self->error )
            {
                return( $self->pass_error );
            }
            return( $self->new_array );
        }
    }
    if( $@ )
    {
        return( $self->error( "Error trying to load data from CSV file $file: $@" ) );
    }
    elsif( !$csv->eof && ( my $error = $csv->error_diag ) )
    {
        warn( "Warning: error reading a CSV line: ${error}" ) if( $is_warnings_enabled );
    }
    # Return a Module::Generic::Array object.
    return( $self->new_array( $all ) );
}

sub load_json
{
    my $self = shift( @_ );
    my $opts = $self->_get_args_as_hash( @_ );
    # Inherited from Module::Generic
    my $j = $self->new_json || return( $self->pass_error );
    if( exists( $opts->{boolean_values} ) && 
        $self->_is_array( $opts->{boolean_values} ) )
    {
        $j->boolean_values( @{$opts->{boolean_values}} );
    }
    if( exists( $opts->{filter_json_object} ) && 
        ref( $opts->{filter_json_object} ) eq 'CODE' )
    {
        $j->filter_json_object( $opts->{filter_json_object} );
    }
    if( exists( $opts->{filter_json_single_key_object} ) && 
        ref( $opts->{filter_json_single_key_object} ) eq 'HASH' &&
        scalar( keys( %{$opts->{filter_json_single_key_object}} ) ) &&
        ref( $opts->{filter_json_single_key_object}->{ [keys( %{$opts->{filter_json_single_key_object}} ) ]->[0] } ) eq 'CODE' )
    {
        $j->filter_json_single_key_object( %{$opts->{filter_json_single_key_object}} );
    }
    if( exists( $opts->{decode_prefix} ) && 
        defined( $opts->{decode_prefix} ) && 
        CORE::length( $opts->{decode_prefix} ) )
    {
        $j->decode_prefix( $opts->{decode_prefix} );
    }
    my $json = $self->load_utf8;
    return( $self->pass_error ) if( !CORE::defined( $json ) );
    return( '' ) if( !CORE::length( $json ) );
    if( want( 'OBJECT' ) )
    {
        my $buf = $j->decode( $json );
        return( $self->new_scalar( \$buf ) );
    }
    else
    {
        # try-catch
        local $@;
        my $rv;
        eval
        {
            $rv = $j->decode( $json );
        };
        if( $@ )
        {
            return( $self->error( "Error while decoding ", CORE::length( $json ), " bytes of json data: $@" ) );
        }
        return( $rv );
    }
}

sub load_perl
{
    my $self = shift( @_ );
    # try-catch
    local $@;
    my $v;
    eval
    {
        $v = do( $self->filepath );
    };
    if( $@ )
    {
        return( $self->error( "Error while loading ", $self->length, " bytes of perl data: $@" ) );
    }

    if( !defined( $v ) && $@ )

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

    ) || die( $file->error );

If the number of headers provided is lower than the actual number of columns in the CSV data, only the data for the given headers will be returned. Conversely, if the headers provided exceeds the number of columns found, those extra headers values wi...

For example, let's imagine we have a CSV with the headers: C<name>, C<date>, C<locale>, C<zipcode>, but we provide only the headers C<name>, C<date>, C<locale>, such as:

    use Data::Pretty qw( dump );
    my $array_object = $file->load_csv(
        headers => [qw( name date locale )],
    ) || die( $file->error );
    say dump( $array_object );

would produce something like:

    {
        name => 'John Doe',
        date => '2025-03-18',
        locale => 'ja_JP',
    }

even though the data also included a C<zipcode> column, but since we only provided 3 headers, the resulting array object contains only 3 headers.

If you provide more headers than there are columns of data, the extra headers will have their value for each row set to C<undef>, since there are no corresponding data.

=item * an anonymous subroutine, or a subroutine reference (C<CODE>)

This callback will be called once, and the current array reference of headers will be passed as its sole argument.

It expects an array reference of headers as a replacement.

If the callback dies, the error will be caught, and an error will be returned.

If the callback returns a false value, it will be ignored, and if the value returned is no an array reference, a warning will be emitted if the C<use warnings> pragma is enabled, and the value will be ignored.

=back

=item * C<sep_char> or C<separator> or C<sep>

Optional. Defines the column separator used in the CSV file. This defaults to the comma, i.e. C<,>

=item * Any additional options

Any extra options provided will be passed directly to L<Text::CSV> during object instantiation. Examples include C<quote_char>, C<escape_char>, C<always_quote>, etc.

See the L<Text::CSV> documentation for more information.

=back

=head2 load_json

This will load the file data, which is assumed to be json in utf8, then decode it using L<JSON> and return the resulting perl data.

This requires the L<JSON> module to be installed or it will set an L<error|Module::Generic/error> and return undef.

If an eror occurs during decoding, this will set an L<error|Module::Generic/error> and return undef.

You can provide the following options to change the way C<JSON> will decode the data:

=over 4

=item * C<boolean_values>

See L<JSON/boolean_values>

=item * C<filter_json_object>

See L<JSON/filter_json_object>

=item * C<filter_json_single_key_object>

See L<JSON/filter_json_single_key_object>

=item * C<decode_prefix>

See L<JSON/decode_prefix>

=back

=head2 load_perl

This will load perl's data structure from file using L<perlfunc/do> and return the resulting perl data.

It sets an L<error|Module::Generic/error> and returns C<undef> if an error occurred.

=head2 load_utf8

This does the same as L</load>, but ensure the binmode used is C<:utf8> before proceeding.

=head2 lock

    # Exports the same constant as Fcntl's flock
    use Module::Generic::File qw( :flock );
    $file->lock( LOCK_SH ); # lock share
    # Do some coding
    $file->unlock;

or, using an hash or hash reference of options instead:

    use Module::Generic::File;
    # Shared lock with timeout
    $file->lock( shared => 1, timeout => 2 ) || die( $file->error );
    # Do some coding
    $file->unlock;
    # Exclusive non-blocking lock
    $file->lock( exclusive => 1, non_blocking => 1 ) || warn( $file->error );

This method locks the file using a combination of L<perlfunc/flock>, ensuring thread-safe and process-safe access via a shared repository (C<fd_locks>) managed by L<Module::Generic::Global>. Supports exclusive (C<LOCK_EX>) and shared (C<LOCK_SH>) loc...

It takes either a numeric argument representing the flag bitwise, or a list or hash reference of optional parameters, such as:

Accepts either a numeric bitwise flag (e.g., C<LOCK_EX | LOCK_NB>) or an hash or hash reference of options:

=over 4

=item * C<exclusive>

Enables an exclusive lock using the bit of C<Fcntl::LOCK_EX>

=item * C<shared>

Enables a shared lock using the bit of C<Fcntl::LOCK_SH>

=item * C<non_blocking> or C<nb>