view release on metacpan or  search on metacpan

lib/Datafile/Array.pm  view on Meta::CPAN

    if ( ref $data ne 'ARRAY' && ref $data ne 'HASH' && !@field_names ) {
        if ( -f $filename ) {
            unlink($filename)
                or return ( 0, ["WARNING: unable to delete file $filename"] );
            return ( 1, ["SUCCESS: file $filename is deleted"] );
        }
        croak
"datafile::array::writearray: 'data' parameter must be an ARRAY or HASH reference";
    }

    my @messages = ();
    push @messages,
        "# writearray: fields=@field_names\n",
        "# opts: "
        . join( ", ", map { "$_=$opts->{$_}" } sort keys %$opts ) . "\n"
        if $verbose;

    my $tmp = "$filename.tmp";
    open( my $fh, '>:encoding(UTF-8):crlf', $tmp )
        or return ( 0, ["ERROR: cannot open '$tmp' for writing: $!"] );

    if ( my $comment = $opts->{comment} ) {
        my @lines = ref($comment) eq 'ARRAY' ? @$comment : split( /\n/, $comment );
        print $fh "$comment_char $_\n" for @lines;
        if ($verbose) { push @messages, "> $comment_char $_\n" for @lines }
    }

    my $prefix_hdr = $prefix ? 'H' . $delim : '';
    my $prefix_row = $prefix ? 'R' . $delim : '';

    if ( $header && @field_names ) {
        print $fh $prefix_hdr . join( $delim, @field_names ) . "\n";
        push @messages,
            "> " . $prefix_hdr . join( $delim, @field_names ) . "\n"
            if $verbose;
    }

    my $record_count = 0;
    my @records =
        ref($data) eq 'HASH' ? sort keys %$data : 0 .. $#$data;

    for my $key (@records) {
        my $rec = ref($data) eq 'HASH' ? $data->{$key} : $data->[$key];
        my @values = map { defined( $rec->{$_} ) ? $rec->{$_} : '' } @field_names;
        my $line   = $prefix_row . join( $delim, @values );
        print $fh $line . "\n"
            or return ( 0, ["ERROR: write error to '$tmp': $!"] );
        $record_count++;
    }
    print $fh "#EOF\n" if $comment_char eq '#';
    close $fh
        or return ( 0, ["ERROR: failed to close '$tmp': $!"] );

    if ($backup && -f $filename) {
        rename( $filename, $filename . '.bak' )
            or push @messages,
            "WARNING: backup to ${filename}.bak failed: $!";
    }
    rename( $tmp, $filename )
        or return ( 0, ["ERROR: failed to rename '$tmp' to '$filename': $!"] );
    chmod $prot, $filename;

    push @messages,
        "- renamed $tmp to $filename\n",
        "- $record_count data records written to $filename\n"
        if $verbose;
    return ( $record_count, \@messages );
}

1;

__END__

=head1 NAME

Datafile::Array - Pure-Perl utilities for reading and writing delimited data files

=head1 LICENSE

This module is free software.

You can redistribute it and/or modify it under the same terms as Perl itself.

=head1 SYNOPSIS

  use Datafile::Array qw(readarray writearray parse_csv_line);

  my @records;
  my @fields;

  my ($count, $msgs) = readarray('data.txt', \@records, \@fields, {
      delimiter    => ';',
      csvquotes    => 1,        # enable proper CSV quoted fields and multi-line
      has_headers  => 1,
      prefix       => 1,        # expect 'H' header and 'R' data lines
      trim_values  => 1,
      verbose      => 1,
  });

  # @records now contains array of hashes
  # @fields contains the detected or provided field names

  writearray('data.txt', \@records, \@fields, {
      header  => 1,
      prefix  => 1,
      backup  => 1,
      comment => 'Exported on ' . scalar localtime,
  });

=head1 DESCRIPTION

Lightweight pure-Perl module for reading and writing simple delimited data files.
Supports optional CSV-style quoted fields (including multi-line records), automatic or explicit headers,
prefix lines (H/R convention), search filtering, trimming, and safe atomic writes.

=head1 FUNCTIONS

=head2 readarray($filename, $data_ref, $fields_ref, \%options)

Loads delimited data into an array of hashes (or hash of hashes if using keys).