perl

How to make the Perl gather construct work


I want to use the gather command several times on one perl array. The first time it works, but the very same command fails on the second attempt. I have a string of automatic station data for specific time intervals. The data is so awkwardly written that one time interval string contains 8 stations of data. The first 3 stations have 13 string of data, the next 4 have 35 strings and the last one has 13, as below

2024-08-02  00:00:00;15.0;50.6;2.9;7.6;38;29;-2.7;846.9;;28.0;0;93;12.7;14.4;47.6;3.8;8.0;86;101;-2.5;833.8;;30.6;0;56;12.9;12.9;60.7;3.2;6.7;45;56;-0.7;843.6;;82.2;0;76;12.8;14.0;53.2;2.2;3.7;50;41;-1.2;841.9;;19.2;0;63;12.9;10.0;8.8;8.5;7.5;7.7;7.2;8.1;8.3;8.8;8.4;9.3;9.7;1.9;4.2;5.7;4.5;5.8;7.4;7.1;7.1;14.1;7.9;23.7;26.3;12.7;61.0;1.9;4.2;22;51;-1.2;839.5;;45.2;0;66;12.9;8.4;7.9;7.6;6.8;6.8;7.2;7.2;7.5;7.6;8.3;8.6;8.7;2.2;16.3;13.2;9.0;28.0;22.4;27.2;34.3;41.0;39.4;47.4;48.3;13.5;50.4;2.6;5.0;44;60;-2.0;827.0;;29.6;1;53;13.0;10.0;9.3;8.7;7.8;7.0;7.3;7.6;8.2;8.3;9.3;9.8;10.0;0.2;5.8;11.4;17.7;23.5;22.3;18.5;11.4;5.5;9.5;20.9;19.6;14.2;51.3;1.7;5.2;40;20;-0.8;844.3;;42.4;0;57;12.9;8.3;8.3;8.7;7.9;7.8;8.2;9.7;9.8;9.9;10.4;10.5;10.4;0.3;10.9;3.6;2.7;0.8;15.6;33.9;33.5;33.4;37.6;36.8;35.2;12.4;52.9;;;;;-0.6;813.1;;0.0;0;46;13.0
2024-08-02 00:10:00;15.0;50.8;2.7;7.4;32;76;-0.8;847.1;;28.0;0;89;12.7;14.4;47.9;5.1;10.0;86;85;-1.4;833.8;;30.6;0;53;12.9;12.7;61.4;2.8;6.2;37;59;-1.3;843.5;;82.2;0;72;12.8;14.3;51.7;2.5;5.8;61;360;-0.5;841.6;;19.2;0;69;12.9;10.0;8.8;8.5;7.4;7.7;7.2;8.1;8.2;8.8;8.4;9.3;9.6;1.9;4.2;5.7;4.5;5.9;7.4;7.1;7.1;14.1;7.9;23.7;26.3;12.6;62.1;1.5;3.1;13;25;-0.9;839.5;;45.2;0;56;12.9;8.3;7.9;7.6;6.8;6.8;7.2;7.2;7.5;7.6;8.3;8.6;8.7;2.2;16.3;13.2;9.0;28.0;22.4;27.2;34.3;41.0;39.4;47.4;48.3;13.3;51.4;2.9;5.9;40;41;-1.3;827.0;;29.6;1;69;12.9;9.8;9.3;8.7;7.8;7.0;7.3;7.5;8.2;8.3;9.3;9.8;9.9;0.2;5.8;11.4;17.7;23.5;22.3;18.5;11.4;5.5;9.5;20.9;19.6;14.0;51.8;0.9;2.0;343;322;-0.7;844.3;;42.4;0;65;12.9;8.2;8.3;8.7;7.9;7.8;8.2;9.7;9.8;9.9;10.3;10.5;10.4;0.3;10.9;3.6;2.7;0.8;15.6;33.9;33.6;33.4;37.7;36.8;35.2;12.4;52.7;;;;;-0.8;812.8;;0.0;0;45;13.0
2024-08-02 00:20:00;15.0;51.6;2.3;6.2;46;65;-3.0;847.0;;28.0;0;103;12.7;13.9;49.1;4.4;7.5;79;89;-1.3;833.8;;30.6;0;54;12.9;12.7;62.7;3.1;6.3;45;6;-0.7;843.5;;82.2;0;69;12.8;14.4;50.6;2.9;5.7;25;14;-0.3;841.9;;19.2;0;56;12.9;10.0;8.8;8.5;7.5;7.7;7.2;8.1;8.3;8.8;8.4;9.2;9.7;1.9;4.2;5.7;4.5;5.9;7.4;7.1;7.1;14.1;7.9;23.7;26.3;12.4;63.1;2.0;4.3;28;49;-0.8;839.4;;45.2;0;64;12.9;8.3;7.9;7.6;6.8;6.8;7.2;7.2;7.5;7.6;8.3;8.6;8.7;2.2;16.3;13.2;9.0;28.0;22.4;27.2;34.3;41.0;39.4;47.4;48.3;13.5;51.4;4.1;6.9;32;42;-0.5;827.0;;29.6;0;69;12.9;9.8;9.3;8.7;7.8;7.0;7.3;7.5;8.2;8.3;9.2;9.8;10.0;0.2;5.7;11.4;17.7;23.5;22.3;18.5;11.4;5.5;9.5;20.9;19.6;13.8;55.6;2.2;5.1;303;317;-2.8;844.6;;42.4;0;71;12.9;8.3;8.3;8.7;7.9;7.8;8.2;9.7;9.8;9.9;10.4;10.5;10.4;0.3;10.9;3.6;2.7;0.8;15.6;33.9;33.5;33.4;37.7;36.8;35.2;12.1;53.6;;;;;-1.0;812.6;;0.0;0;57;12.9

My equally clumsy code is given below The data is comma delimited and sometimes zero values are represented as ;;, hence I have to some cleaning up.

#!/usr/bin/perl -w
use strict;
use warnings;
use File::Path;
use File::Copy;
use Tie::File;
use List::Gather;
my @list_stns=("stn1","stn2","stn3","stn4","stn5","stn6","stn7","stn8");
my $list_stns;

my $datestr=qr{\d{4}-\d{2}-\d{2}};
my $timestr=qr{\d{2}:\d{2}:\d{2}};
my $file="data.csv";
my $nfile="newfile.txt";

my @array;
my $line; 
my $array;
my @array1;
my $array1;
my @first;
my @second;
my @third;

tie @array, 'Tie::File', $file, mode => O_RDWR;
my $x = shift @array;

for(@array){
s/;;;;;/;0.0;0.0;0.0;0.0;/g;
s/;;/;0.0;/g; 
s/;/ /g;
}

open (my $INFILE, "> ddata.csv") or die "open 'ddata.csv': failed $! ($^E)";
for (my$kk=0; $kk < @array; ++$kk){
 print $INFILE "$array[$kk]\n";
}
close($INFILE);

my $yr;
my $mn;
my $dy;
my $hr;
my $mi;

open (my $OUTFILE, "< ddata.csv") or die "open 'data.csv': failed $! ($^E)";
for (my $kk=0; $kk < @array; ++$kk){
 $array1[$kk]=<$OUTFILE>;
 $line=$array1[$kk];
my($datestr, $timestr, $all_fields)=split(' ', $line, 3);

$yr=substr($datestr, 0, 4);
$mn=substr($datestr, 5, 2);
$dy=substr($datestr, 8, 2);
$hr=substr($timestr, 0, 2);
$mi=substr($timestr, 3, 2);

my(@all_fields)=split(' ', $all_fields);
@first = gather{for(@all_fields){take $_ if gathered < 13}};
open (my $AWSF, "> $list_stns[0]") or die "open '$list_stns[0]': failed $! ($^E)";
print $AWSF "Year Mon Day Hr Mn Temp  Humd  Wspd  Wdir Press  Rain\n";

$_ = sprintf "%5.1f", $_ foreach @first;
print $AWSF "$list_stns[0]\n";
print $AWSF "$yr  $mn  $dy $hr $mi", join(" ", ($first[0],$first[1],$first[2],$first[4],$first[7],$first[8])),"\n";
close($AWSF);

@second = gather { for ( @all_fields) { take $_ if (gathered >= 13) && (gathered < 26)}};
print "@all_fields\n";
print "@second\n"; #this prints a blank line
exit;
open ($AWSF, "> $list_stns[1]") or die "open '$list_stns[1]': failed $! ($^E)";
print $AWSF "Year Mon Day Hr Mn Temp  Humd  Wspd  Wdir Press  Rain\n";

$_ = sprintf "%5.1f", $_ foreach @second;
print $AWSF "$list_stns[1]\n";
print $AWSF "$yr  $mn  $dy $hr $mi", join(" ", ($second[0],$second[1],$second[2],$second[4],$second[7],$second[8])),"\n";
close($AWSF);
}

I will be appreciate any assistance.


Solution

  • @second = gather { for ( @all_fields) { take $_ if (gathered >= 13) && (gathered < 26)}};

    Here, take $_ will never be executed since gathered is 0 in the beginning. Here is an example of how you could do this without using List::Gather:

    use v5.38;
    use Object::Pad;
    use experimental qw(declared_refs refaliasing);
    
    {
        my $csv_file = 'data.csv';
        my @list_stns = qw(stn1 stn2 stn3 stn4 stn5 stn6 stn7 stn8);
        my $header = "Year Mon Day Hr Mn Temp  Humd  Wspd  Wdir Press  Rain";
        my $self = Main->new(csv_file => $csv_file);
        my \@array = $self->read_file();
        for my $line (@array) {
            my($datestr, $timestr, $all_fields) = split ' ', $line, 3;
            $datestr = $self->parse_date($datestr, $timestr);
            my \@first = $self->gather_fields($all_fields, 0, 13);
            $self->write_to_file($list_stns[0], $header, $datestr, \@first);
            my \@second = $self->gather_fields($all_fields, 13, 26);
            $self->write_to_file($list_stns[1], $header, $datestr, \@second);
            exit;
        }
    }
    
    class Main;
    field $csv_file :param :reader;
    
    method gather_fields($all_fields, $start, $end) {
        my @all_fields = split ' ', $all_fields;
        @all_fields = @all_fields[$start..$end];
        return \@all_fields;
    }
    
    method parse_date($datestr, $timestr) {
        my $yr = substr($datestr, 0, 4);
        my $mn = substr($datestr, 5, 2);
        my $dy = substr($datestr, 8, 2);
        my $hr = substr($timestr, 0, 2);
        my $mi =substr($timestr, 3, 2);
        return "$yr  $mn  $dy $hr $mi";
    }
    
    method read_file() {
        my $fn = $self->csv_file;
        my @array;
        open (my $fh, "<", $fn) or die "Could not open file '$fn': $!";
        while (<$fh>) {
            s/;;;;;/;0.0;0.0;0.0;0.0;/g;
            s/;;/;0.0;/g; 
            s/;/ /g;
            push @array, $_;
        }
        return \@array;
    }
    
    method write_to_file($stn, $header, $datestr, $fields) {
        my $fn = $stn;
        open (my $fh, ">", $fn) or die "Could not open file '$fn': $!";
        print $fh "$header\n";
        my @fmt_fields = map {sprintf "%5.1f", $_} @$fields;
        print $fh "$stn\n";
        print $fh "$datestr ", join(" ", @fmt_fields), "\n";
        close($fh);
    }