author 'Dobrica Pavlinusic <dpavlin@rot13.org>';
license 'dual';
-requires 'Mojolicious' => '0.999931';
+requires 'Mojolicious' => '1.13';
requires 'Data::Dump';
requires 'File::Slurp';
requires 'JSON';
requires 'File::Path';
requires 'Text::Unaccent::PurePerl';
requires 'Statistics::Descriptive';
+requires 'Text::CSV';
features(
'profile' => [
#!/bin/sh -x
-sudo apt-get install libhtml-tableextract-perl libjson-perl libmodule-install-perl libstatistics-descriptive-perl
+sudo apt-get install libhtml-tableextract-perl libjson-perl libmodule-install-perl libstatistics-descriptive-perl libmodule-install-perl
use Time::HiRes qw(time);
-sub save_tx {
- my ($self,$tx) = @_;
+sub save_action {
+ my ($self) = @_;
# warn "## before_dispatch req ",dump($tx->req->url, $tx->req->params);
- my $parts = $tx->req->url->path->parts;
- warn "# parts ",dump( $parts );
- if ( $parts->[0] eq 'data' ) {
- if ( my $params = $tx->req->params ) {
-
- warn "# params ",dump($params);
+ my $path = $self->req->url->path;
+ if ( $path =~ m{/data/} ) {
+ if ( my $params = $self->req->params ) {
my $time = time();
if ( my $time_travel = $params->param('time') ) {
- warn "# time-travel to $time_travel from ", $tx->remote_address;
+ warn "# time-travel to $time_travel\n";
$time = $time_travel;
}
- my $path = '/tmp/actions/';
- mkdir $path unless -e $path;
- $path .= sprintf '%.4f.%s', $time, join('.', @$parts);
+ my $actions_path = '/tmp/actions/';
+ mkdir $actions_path unless -e $actions_path;
+ $path =~ s{/}{.}g;
+ $actions_path .= sprintf '%.4f%s', $time, $path;
- store $params, $path;
- warn "$path ", -s $path, " bytes\n";
+ my $array = $params->params;
+ if ( @$array ) {
+ store $array, $actions_path;
+ warn "SAVE $actions_path ", -s $actions_path, " bytes params = ", dump($array), $/;
+ }
}
}
}
# $self->plugin( 'request_timer' );
$self->plugins->add_hook(
- before_dispatch => sub {
- my ($self, $c) = @_;
- my $tx = $c->tx;
- save_tx( $self, $tx );
+ after_dispatch => sub {
+ my ($self) = @_;
+ save_action( $self );
}
);
use base 'Mojo::Base';
-use File::Slurp;
+use Text::CSV;
use Data::Dump qw(dump);
-use Encode;
__PACKAGE__->attr('full_path');
-my $null = ''; # FIXME undef?
-
-sub _split_line {
- my ( $delimiter, $line ) = @_;
- my @v;
- while ( $line ) {
- my $v;
- if ( $line =~ s/^"// ) {
- $line =~ s/""/_qq_/gc;
- $line =~ s/^\s*([^"]*)\s*"\Q$delimiter\E?// || die "can't parse [$line] ",dump(@v);
- $v = $1;
- } elsif ( $line =~ s/^\s*([^\Q$delimiter\E]+)\s*\Q$delimiter\E?// ) {
- $v = $1;
- } elsif ( $line =~ s/^\s*\Q$delimiter\E// ) {
- $v = $null;
- } else {
- die "can't parse [$line]\n";
- }
-
- $v =~ s/^\s*(.+?)\s*$/$1/;
- $v = $null if $v eq '_qq_'; # "" field which is not first one
- $v =~ s/_qq_/"/g;
- $v =~ s/_LF_/\n/g;
- push @v, $v;
- }
-
- return @v;
-}
-
sub data {
my $self = shift;
my $path = $self->full_path;
- my $data = read_file $path, { binmode => ':raw' }; # FIXME configurable!
my $encoding = 'utf-8';
if ( $path =~ m/\.(\w+).csv/i ) {
$encoding = $1;
}
- warn "decoding ", length($data), " bytes using $encoding\n";
- $data = decode($encoding, $data);
- # multi-line strings
- while ( $data =~ s/(,"[^"]*)[\n\r]+([^"]*)/$1_LF_$2/sg ) {
- warn "multi-line quoted CSV data found";
- }
+ my $data = { items => [] };
+ my @header;
- my @lines = split(/\r?\n/, $data);
- $data = { items => [] };
+ my $csv = Text::CSV->new ( { binary => 1, eol => $/ } )
+ or die "Cannot use CSV: ".Text::CSV->error_diag ();
- my $delimiter = ',';
-
- if ( $lines[0] !~ m/,/ ) {
- if ( $lines[0] =~ m/;/ ) {
- $delimiter = ';';
- } elsif ( $lines[0] !~ /;/ && $lines[1] =~ /;/ ) {
- shift @lines; # FIXME skip non-header line
- $delimiter = ';';
+ open my $fh, "<:encoding($encoding)", $path or die "$path: $!";
+ while ( my $row = $csv->getline( $fh ) ) {
+ if ( ! @header ) {
+ @header = @$row;
+ next;
}
- }
-
- warn "$path ", $#lines + 1, " lines encoding: $encoding delimiter:",dump($delimiter);
-
- my $header_line = shift @lines;
-
- my @header = _split_line( $delimiter, $header_line );
- warn "# header ",dump( @header );
-
- while ( my $line = shift @lines ) {
- chomp $line;
- my @v = _split_line($delimiter, $line);
my $item;
- foreach my $i ( 0 .. $#v ) {
- $item->{ $header[$i] || "f_$i" } = [ $v[$i] ];
+ foreach my $i ( 0 .. $#{$row} ) {
+ $item->{ $header[$i] || "f_$i" } = [ $row->[$i] ];
}
push @{ $data->{items} }, $item;
}
+ $csv->eof or $csv->error_diag();
+ close $fh;
+
$data->{header} = [ @header ];
return $data;
use File::Slurp;
use Data::Dump qw(dump);
use JSON;
-use Mojo::Client;
+use Mojo::UserAgent;
__PACKAGE__->attr('path');
__PACKAGE__->attr('full_path');
warn "# CouchDB URL: $url";
- my $json = Mojo::Client->new->get($url)->res->json;
+ my $json = Mojo::UserAgent->new->get($url)->res->json;
my $data;
% if ( my $master = $ENV{'MASTER'} ) {
<input class=replication type=checkbox name="_master" value="<%= $master %>" title="replicate to <%= $master %>">
% }
-% my $params = $change->{params};
<ul>
-% while ( @$params ) {
-% my $n = shift @$params;
-% my $v = shift @$params;
+% while ( @$change ) {
+% my $n = shift @$change;
+% my $v = shift @$change;
<li><label class=checkbox_to_text>
<%= $n %>
<span class=value title="double click to edit">
<span title="unique">✍</span>
% }
% if ( session('order') ne $n ) {
-<a href="<%= url_for( action => 'order' )->query( order => $n, sort => 'a' ) %>"><%= $n %></a>
+<a href="<%= url_for( action => 'items' )->query( order => $n, sort => 'a' ) %>"><%= $n %></a>
% } else {
-<a href="<%= url_for( action => 'order' )->query( order => $n, sort => session('sort') eq 'a' ? 'd' : 'a' ) %>"><%= $n %></a>
+<a href="<%= url_for( action => 'items' )->query( order => $n, sort => session('sort') eq 'a' ? 'd' : 'a' ) %>"><%= $n %></a>
<%== session('sort') eq 'a' ? '↑' : '↓' %>
% }
<div class="col_opts">