Merge branch 'master' of github.com:dpavlin/MojoFacets
authorDobrica Pavlinusic <dpavlin@rot13.org>
Sun, 18 Sep 2011 11:20:07 +0000 (13:20 +0200)
committerDobrica Pavlinusic <dpavlin@rot13.org>
Sun, 18 Sep 2011 11:20:07 +0000 (13:20 +0200)
Makefile.PL
bin/debian-install.sh
lib/MojoFacets.pm
lib/MojoFacets/Import/CSV.pm
lib/MojoFacets/Import/CouchDB.pm
templates/actions/view.html.ep
templates/data/items/table.html.ep

index 29d5e24..02090be 100755 (executable)
@@ -5,7 +5,7 @@ version_from 'lib/MojoFacets.pm';
 author 'Dobrica Pavlinusic <dpavlin@rot13.org>';
 license 'dual';
 
-requires 'Mojolicious' => '0.999931';
+requires 'Mojolicious' => '1.13';
 requires 'Data::Dump';
 requires 'File::Slurp';
 requires 'JSON';
@@ -13,6 +13,7 @@ requires 'HTML::TableExtract';
 requires 'File::Path';
 requires 'Text::Unaccent::PurePerl';
 requires 'Statistics::Descriptive';
+requires 'Text::CSV';
 
 features(
        'profile' => [
index 019f9e6..d2f28e2 100755 (executable)
@@ -1,3 +1,3 @@
 #!/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
index 1f34ea8..9146e2f 100644 (file)
@@ -12,28 +12,29 @@ use Storable;
 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), $/;
+                       }
                }
        }
 }
@@ -51,10 +52,9 @@ sub startup {
 #      $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 );
                        }
        );
        
index 6ab3395..260c002 100644 (file)
@@ -5,90 +5,43 @@ use strict;
 
 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;
index 93f79ed..bb1e16b 100644 (file)
@@ -8,7 +8,7 @@ use base 'Mojo::Base';
 use File::Slurp;
 use Data::Dump qw(dump);
 use JSON;
-use Mojo::Client;
+use Mojo::UserAgent;
 
 __PACKAGE__->attr('path');
 __PACKAGE__->attr('full_path');
@@ -45,7 +45,7 @@ sub data {
 
        warn "# CouchDB URL: $url";
 
-       my $json = Mojo::Client->new->get($url)->res->json;
+       my $json = Mojo::UserAgent->new->get($url)->res->json;
 
        my $data;
 
index d70d3cc..98e4324 100644 (file)
 % 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">
index 0b77366..e6df2c7 100644 (file)
@@ -13,9 +13,9 @@
 <span title="unique">&#9997;</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' ? '&uarr;' : '&darr;' %>
 % }
 <div class="col_opts">