view release on metacpan or  search on metacpan

lib/App/csvtool/Smudge.pm  view on Meta::CPAN

      make => sub ( $param ) {
         my $alpha = 2 ** -$1;
         my $prev;
         return sub ( $new ) {
            return $prev = $new if !defined $prev;
            # $result = ( $prev * ( 1 - $alpha ) ) + ( $new * $alpha )
            #         =  $prev * 1 - $prev * $alpha + $new * $alpha
            return $prev = $prev + $alpha * ( $new - $prev );
         };
      }
   },
   {
      name => "total",
      desc => "Running total",
      make => sub ( $ ) {
         my $total = 0;
         return sub ( $new ) {
            $total += $new;
            return $total;
         }
      }
   },
);

   sub mk_filter ( $name )
   {
      foreach ( @FILTERS ) {
         my $re = $_->{name} =~ s/N$/(\\d+)/r;
         next unless $name =~ qr/^$re$/;
         return $_->{make}( $1 );
      }

      croak "Unrecognised filter name $name";
   }

   # For Commandable's builtin 'help' support
   sub commandable_more_help
   {
      Commandable::Output->printf( "\n" );
      Commandable::Output->print_heading( "FILTERS:" );

      Commandable::Output->printf( "    Each filter should be specified as IDX(,IDX...):FILTER\n" );
      Commandable::Output->printf( "\n" );

      foreach ( @FILTERS ) {
         Commandable::Output->printf( "    %s\n",
            Commandable::Output->format_note( $_->{name}, 1 ) );
         Commandable::Output->printf( "      %s\n",
            $_->{desc} );
      }
   }

   sub run ( $pkg, $opts, $reader, $output )
   {
      my @filters;
      foreach my $spec ( ( $opts->{filter} // [] )->@* ) {
         # TODO: Accept DD-DD,DD-DD,etc... as indexes
         my ( $fields, $filter ) = $spec =~ m/^(\d+(?:,\d+)*):(.*)$/ or
            warn( "Unrecognised --filter spec; expected IDX:FILTER\n" ), next;

         foreach my $idx ( split m/,/, $fields ) {
            $filters[$idx - 1] = mk_filter( $filter );
         }
      }

      while( my $row = $reader->() ) {
         my @data = @$row;

         # Skip header lines
         unless( @data and $data[0] =~ m/^#/ ) {
            foreach my $idx ( keys @filters ) {
               length $data[$idx] and defined $filters[$idx] and
                  $data[$idx] = $filters[$idx]->( $data[$idx] );
            }
         }

         $output->( \@data );
      }
   }
}

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;