git.rot13.org Git - openface-maja/blob - p.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4 use autodie;
   5 use Data::Dump qw(dump);
   6 use Text::Unaccent;
   7 use POSIX qw(strftime);
   8
   9 #my $filename = 'Intervali_Openface_novi_rad_Boris_export.txt';
  10 my $filename = 'originals_2023-07-09/Intervali_Openface_novi_rad_Boris_export.txt';
  11
  12 my $debug = $ENV{DEBUG} || 0;
  13
  14 # better time format for scp (don't have :)
  15 my $today = strftime("%Y-%m-%d_%H%M%S", localtime(time()));
  16 warn "# today $today";
  17
  18 open(my $err_fh, '>', "out.$today.log");
  19 local $SIG{__WARN__} = sub {
  20         print STDERR @_;
  21         print $err_fh @_;
  22 };
  23
  24
  25 sub col2nr {
  26         my @c = @_;
  27         my $i = 0;
  28         my $out;
  29         $out->{$_} = $i++ foreach @c;
  30         #warn "## col2nr ", dump( $out );
  31         return $out;
  32 }
  33
  34 open(my $fh, '<', $filename);
  35
  36 my $h = <$fh>; chomp $h;
  37 my @cols = split(/\t/, $h);
  38 my $col2nr = col2nr @cols;
  39
  40 my $file2;
  41 my $fh2;
  42 my $last_id;
  43
  44 my @h2;
  45 my $h2nr;
  46 my $tell2;
  47
  48 my @glob = glob 'originals_2023-07-07/*';
  49 my $map_un_back;
  50 my @glob_un = map {
  51         my $un = lc( unac_string('utf-8', $_ ) );
  52         $map_un_back->{ $un } = $_;
  53         $un;
  54 } @glob;
  55 sub glob_id {
  56         my $id = shift;
  57         my $id_lc = lc( unac_string('utf-8', $id ) );
  58         my $pos = -1;
  59         my @found = grep { $pos++; m/$id_lc/ } @glob_un;
  60         if ( @found ) {
  61                 if ( $#found == 0 ) {
  62                         warn "XXX patt=$id pos=$pos found=",dump(@found);
  63                         return $map_un_back->{$found[0]};
  64                         #return $glob[$pos];
  65                 } else {
  66                         warn "ERROR: pattern $id found $#found results, ignoring";
  67                         return;
  68                 }
  69         } else {
  70                 warn "not found $id";
  71                 return;
  72         }
  73 }
  74
  75 open(my $skipped_input, '>',"out.$today.skip");
  76 open(my $out_fh, '>', "out.$today.csv");
  77 sub out_csv {
  78         my @a = @_;
  79         print $out_fh join(",", map { m/\s/ ? qq{"$_"} : $_ } @a),"\n";
  80 }
  81
  82 my @out_header;
  83
  84 while(<$fh>) {
  85         chomp;
  86         next if m/^\s*$/;       # FIXME corrput data
  87         my @v = split(/\t/, $_);
  88         warn "#[ $_ ]\n" if $debug;
  89
  90         my $id = $v[0];
  91         if ( ! defined $id ) {
  92                 warn "ERROR: ID col 0 null [$_]";
  93                 next;
  94         }
  95
  96         if ( ! $last_id || $last_id ne $v[0] ) {
  97                 my $patt = 'originals_2023-07-07/' . $v[0] . '*.csv';
  98                 $file2 = glob $patt;
  99                 $file2 ||= glob 'originals_2023-07-07/' . $v[0] . '*.csv';
 100                 $file2 ||= glob 'originals_2023-07-07/' . unac_string('utf-8', $v[0] ) . '*.csv';
 101                 $file2 ||= glob_id $v[0];
 102                 # try to find file with same numbers
 103                 my $id_nrs = $v[0];
 104                 $id_nrs =~ s/\D//g;
 105                 $file2 ||= glob_id $id_nrs;
 106
 107                 if ( ! defined $file2 ) {
 108                         warn "SKIP ERROR: $patt glob didn't find anything for v[0]=$v[0] [$_]";
 109                         print $skipped_input "$_\n";
 110                         next;
 111                 }
 112
 113                 if ( ! -r $file2 ) {
 114                         warn "ERROR: $patt glob file $file2 not readable: $! SKIPPING [$_]";
 115                         print $skipped_input "$_\n";
 116                         next;
 117                 }
 118
 119                 warn "# file2 $file2 [$v[0]]";
 120                 open($fh2, '<', $file2);
 121                 $last_id = $v[0];
 122                 @h2 = ();
 123         }
 124
 125         sub col_v {
 126                 my $name = shift;
 127                 my $i = $col2nr->{$name};
 128                 die "can't find $name" unless defined $i;
 129                 my $v = $v[$i];
 130                 die "can't find $i : $name in ",dump( \@v ) unless defined $v;
 131                 warn "## col_v $name -> $i -> $v",dump( \@v ) if $debug > 1;
 132                 return $v;
 133         }
 134
 135         #my $start = $v[ $col2nr->{'Start (s)'} ];
 136         #my $stop  = $v[ $col2nr->{'Stop (s)'} ];
 137
 138         #my $start = col_v 'Start (s)';
 139         #my $stop  = col_v 'Stop (s)';
 140
 141         my $start = $v[10];
 142         my $stop  = $v[11];
 143         warn "# start: $start - stop: $stop\n" if $debug;
 144
 145         my @sum;
 146         my $count = 0;
 147
 148         while(<$fh2>) {
 149                 chomp; s/\r+$//;
 150                 warn "## fh2 [ $_ ]\n" if $debug;
 151                 #my @v2 = map { s/^\s+//; $_ } split(/\t/,$_);
 152                 my @v2 = map { s/^\s+//; $_ } split(/[;,]\s*/,$_);
 153                 if ( ! @h2 ) {
 154                         @h2 = @v2;
 155                         $h2nr = col2nr @h2;
 156                         $tell2 = tell($fh2);
 157                         warn "# h2nr ",dump( $h2nr ) if $debug;
 158                         if ( ! @out_header ) {
 159                                 push @out_header, @cols;
 160                                 push @out_header, map { $h2[$_] }
 161                                         ( $h2nr->{'AU01_r'} .. $h2nr->{'AU45_r'} );
 162                                 push @out_header, map { $h2[$_] }
 163                                         ( $h2nr->{'AU01_c'} .. $h2nr->{'AU45_c'} );
 164                                 warn "# out_header ",dump( \@out_header );
 165                                 out_csv @out_header;
 166                         }
 167                         next;
 168                 }
 169
 170                 sub col_v2 {
 171                         my $name = shift;
 172                         my $i = $h2nr->{$name};
 173                         die "can't find $name in ",dump( $h2nr ) unless defined $i;
 174                         my $v = $v2[$i];
 175                         die "can't find $i : $name in ",dump( \@v2 ) unless defined $v;
 176                         return "### col_v2 $name $i = $v";
 177                         return $v;
 178                 }
 179
 180
 181                 #my $timestamp = $v2[ $h2nr->{'timestamp'} ] || die;
 182                 #my $timestamp = col_v2 'timestamp';
 183                 my $timestamp = $v2[2];
 184
 185                 #$timestamp /= 1000 if $timestamp =~ m/^\d+$/;  # FIXME fix corrputed input data
 186                 #warn "XXX filter $start - $stop from ",dump( $timestamp ); #$h2nr, \@v2 );
 187
 188                 # Argument "1.324.400" isn't numeric
 189                 $timestamp =~ s/^(\d+)\.(\d\d\d)\.(\d\d\d)$/$1$2.$3/;
 190
 191                 if ( $timestamp !~ m/^\d+(\.\d+)$/ ) {
 192                         warn "timestamp [$timestamp] from $file2 not numeric [$_]";
 193                 }
 194
 195                 if ( $timestamp < $start ) {
 196                         #warn "## $start > @v2";
 197                 } elsif ( $timestamp < $stop ) {
 198                         $tell2 = tell($fh2);
 199                         foreach my $n ( $h2nr->{'AU01_r'} .. $h2nr->{'AU45_c'} ) {
 200                                 $sum[$n] += $v2[$n];
 201                                 #warn "sum $n $sum[$n] $v2[$n]\n";
 202                         }
 203                         $count++;
 204                         #warn "XXX $count sum $h2nr->{'AU01_r'} .. $h2nr->{'AU45_c'} = ",dump( \@sum );
 205                 } else {
 206                         warn "# seek $tell2" if $debug;
 207                         seek $fh2, $tell2, 0;
 208
 209                         die "count is 0" if $count == 0;
 210
 211                         #warn "XXX $file2 count=$count XXX ", $h2nr->{'AU01_r'},' - ', $h2nr->{'AU45_r'} , " YYY ", $h2nr->{'AU01_c'}, ' - ', $h2nr->{'AU45_c'}, ' sum=', dump( \@sum );
 212                         my @add_cols;
 213                         push @add_cols, map { $sum[$_] / $count } ( $h2nr->{'AU01_r'} .. $h2nr->{'AU45_r'} );
 214                         push @add_cols, map { $sum[$_] }          ( $h2nr->{'AU01_c'} .. $h2nr->{'AU45_c'} );
 215                         warn "# add_cols = ",dump( \@add_cols ) if $debug;
 216                         out_csv @v, @add_cols;
 217
 218                         @sum = ();
 219                         $count = 0;
 220
 221                         warn "# last" if $debug;
 222                         last;
 223                 }
 224         }
 225 }
 226
 227 __END__
 228
 229
 230 my $col2nr;
 231
 232 # prema filenamenu iz $v[0]
 233 # Start (s)       Stop (s)
 234
 235 my $lookup_file = '
 236
 237 # col timestamp
 238 #