lib/MojoFacets/Data.pm

   1 package MojoFacets::Data;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base 'Mojolicious::Controller';
   7
   8 use Data::Dump qw(dump);
   9 use File::Slurp;
  10 use JSON;
  11 use Encode;
  12 use locale;
  13 use File::Find;
  14 use Storable;
  15 use Time::HiRes qw(time);
  16
  17 our $loaded;
  18 our $filters;
  19
  20 sub index {
  21         my $self = shift;
  22
  23         my $path = $self->app->home->rel_dir('data');
  24         die "no data dir $path" unless -d $path;
  25
  26         my @files;
  27         my $edits;
  28         find( sub {
  29                 my $file = $File::Find::name;
  30                 if ( -f $file && $file =~ m/\.(js(on)?|txt)$/ ) {
  31                         $file =~ s/$path\/*//;
  32                         push @files, $file;
  33                 } elsif ( -f $file && $file =~ m/([^\/]+)\.edits\/(\d+\.\d+.+)/ ) {
  34                         push @{ $edits->{$1} }, $2
  35                 } else {
  36                         warn "IGNORE: $file\n";
  37                 }
  38         }, $path);
  39
  40         @files = sort { lc $a cmp lc $b } @files;
  41         my $size;
  42         $size->{$_} = -s "$path/$_" foreach @files;
  43
  44         if ( my $save_path = $self->session('save_path') ) {
  45                 $self->session( 'save_path' => 0 )
  46                 if ! defined $loaded->{$save_path};
  47         }
  48
  49         $self->render(
  50                 files => [ @files ],
  51                 size => $size,
  52                 loaded => $loaded,
  53                 filters => $filters,
  54                 dump_path => { map { $_ => $self->_dump_path($_) } @files },
  55                 edits => $edits,
  56         );
  57 }
  58
  59 sub _dump_path {
  60         my ( $self, $name ) = @_;
  61         my $dir = $self->app->home->rel_dir('data');
  62         $name =~ s/^$dir//;
  63         $name =~ s/\/+/_/g;
  64         return '/tmp/mojo_facets.' . $name . '.storable';
  65 }
  66
  67 sub _save {
  68         my ( $self, $path ) = @_;
  69
  70         my $dump_path = $self->_dump_path( $path );
  71         my $first_load = ! -e $dump_path;
  72         warn "save loaded to $dump_path";
  73         my $info = $loaded->{$path};
  74         store $info, $dump_path;
  75
  76         if ( $first_load ) {
  77                 my $mtime = $loaded->{$path}->{mtime};
  78                 utime $mtime, $mtime, $dump_path;
  79                 warn "sync time to $path at $mtime\n";
  80         }
  81
  82         warn $dump_path, ' ', -s $dump_path, " bytes\n";
  83         return $dump_path;
  84 }
  85
  86
  87 sub __stats {
  88
  89         my $stats;
  90
  91         my $nr_items = $#{ $_[0] } + 1;
  92
  93         warn "__stats $nr_items\n";
  94
  95         foreach my $e ( @{ $_[0] } ) {
  96                 foreach my $n ( keys %$e ) {
  97                         $stats->{$n}->{count}++;
  98                         my @v;
  99                         if ( ref $e->{$n} eq 'ARRAY' ) {
 100                                 $stats->{$n}->{array} += $#{ $e->{$n} } + 1;
 101                                 @v = @{ $e->{$n} };
 102                         } else {
 103                                 @v = ( $e->{$n} );
 104                         }
 105
 106                         foreach my $x ( @v ) {
 107                                 $stats->{$n}->{numeric}++
 108                                         if $x =~ m/^[-+]?([0-9]*\.[0-9]+|[0-9]+)$/;
 109                                 $stats->{$n}->{empty}++
 110                                         if length $x == 0; # faster than $x =~ m/^\s*$/;
 111                         }
 112
 113                 }
 114         }
 115
 116         foreach my $n ( keys %$stats ) {
 117                 my $s = $stats->{$n};
 118                 next unless defined $s->{array};
 119                 if ( $s->{array} == $s->{count} ) {
 120                         delete $s->{array};
 121                         if ( $s->{count} == $nr_items ) {
 122                                 warn "check $n for uniqeness\n";
 123                                 my $unique;
 124                                 foreach my $e ( @{ $_[0] } ) {
 125                                         if ( ++$unique->{ $e->{$n}->[0] } == 2 ) {
 126                                                 $unique = 0;
 127                                                 last;
 128                                         }
 129                                 }
 130                                 if ( $unique ) {
 131                                         $stats->{$n}->{unique} = 1;
 132                                         warn "# $n unique ",dump( $unique );
 133                                 }
 134                         }
 135                 }
 136         }
 137
 138         warn "# __stats ",dump($stats);
 139
 140         return $stats;
 141 }
 142
 143 sub _param_or_session {
 144         $_[0]->param( $_[1] ) || $_[0]->session( $_[1] )
 145 }
 146
 147 sub stats {
 148         my $self = shift;
 149         my $path = $self->_param_or_session('path');
 150         warn "stats $path\n";
 151         delete $loaded->{$path}->{stats};
 152         $self->redirect_to( '/data/columns' );
 153 }
 154
 155
 156 sub _load_path {
 157         my ( $self, $path ) = @_;
 158
 159         my $full_path = $self->app->home->rel_file( 'data/' . $path );
 160         die "$full_path $!" unless -r $full_path;
 161
 162         my $dump_path = $self->_dump_path( $path );
 163
 164         if ( defined $loaded->{$path}->{data} ) {
 165                 my $mtime = (stat($full_path))[9];
 166                 return if $loaded->{$path}->{mtime} == $mtime;
 167                 warn "reload $full_path, modified ", time() - $mtime, " seconds ago\n";
 168         } elsif ( -e $dump_path ) {
 169                 warn "dump_path $dump_path ", -s $dump_path, " bytes loading...\n";
 170                 my $info = retrieve $dump_path;
 171                 $loaded->{ $path } = $info;
 172                 return;
 173         }
 174
 175         # we could use Mojo::JSON here, but it's too slow
 176 #       $data = from_json read_file $path;
 177         my $data = read_file $full_path;
 178         warn "# data snippet: ", substr($data,0,200);
 179         my @header;
 180         if ( $path =~ m/\.js/ ) {
 181                 Encode::_utf8_on($data);
 182                 $data = from_json $data;
 183         } elsif ( $path =~ m/\.txt/ ) {
 184                 my @lines = split(/\r?\n/, $data);
 185                 $data = { items => [] };
 186
 187                 my $header_line = shift @lines;
 188                 my $multiline = $header_line =~ s/\^//g;
 189                 @header = split(/\|/, $header_line );
 190                 warn "# header ", dump( @header );
 191                 while ( my $line = shift @lines ) {
 192                         $line =~ s/\^//g;
 193                         chomp $line;
 194                         my @v = split(/\|/, $line);
 195                         while ( @lines && $#v < $#header ) {
 196                                 $line = $lines[0];
 197                                 $line =~ s/\^//g;
 198                                 chomp $line;
 199                                 my @more_v = split(/\|/, $line);
 200                                 if ( $#v + $#more_v > $#header ) {
 201                                         warn "short line: ",dump( @v );
 202                                         last;
 203                                 }
 204                                 shift @lines;
 205                                 $v[ $#v ] .= shift @more_v if @more_v;
 206                                 push @v, @more_v if @more_v;
 207
 208                                 if ( $#v > $#header ) {
 209                                         die "# splice $#header ", dump( @v );
 210                                         @v = splice @v, 0, $#header;
 211                                 }
 212                         }
 213                         my $item;
 214                         foreach my $i ( 0 .. $#v ) {
 215                                 $item->{ $header[$i] || "f_$i" } = [ $v[$i] ];
 216                         }
 217                         push @{ $data->{items} }, $item;
 218                 }
 219         } else {
 220                 warn "file format unknown $path";
 221         }
 222
 223         my $stats = __stats( $data->{items} );
 224
 225         if ( ! @header ) {
 226                 if ( defined $data->{header} ) {
 227                         if ( ref $data->{header} eq 'ARRAY' ) {
 228                                 @header = @{ $data->{header} };
 229                         } else {
 230                                 warn "header not array ", dump( $data->{header} );
 231                         }
 232                 }
 233         }
 234
 235         @header =
 236                 sort { $stats->{$b}->{count} <=> $stats->{$a}->{count} }
 237                 grep { defined $stats->{$_}->{count} } keys %$stats
 238                 unless @header;
 239
 240         my $info = {
 241                 header => [ @header ],
 242                 stats  => $stats,
 243                 full_path => $full_path,
 244                 size => -s $full_path,
 245                 mtime => (stat($full_path))[9],
 246                 data => $data,
 247         };
 248
 249         $loaded->{ $path } = $info;
 250         $self->_save( $path );
 251
 252 }
 253
 254
 255 sub load {
 256         my $self = shift;
 257
 258         my @paths = $self->param('paths');
 259         warn "# paths ", dump @paths;
 260         $self->_load_path( $_ ) foreach @paths;
 261
 262         my $path = $self->param('path') || $self->redirect_to( '/data/index' );
 263         warn "# path $path\n";
 264         $self->session('path' => $path);
 265         $self->_load_path( $path );
 266
 267         my $redirect_to = '/data/items';
 268
 269         $self->session( 'header' => $loaded->{$path}->{header} );
 270         if ( ! defined $loaded->{$path}->{columns} ) {
 271                 my $columns_path = $self->_permanent_path( 'columns' );
 272                 if ( -e $columns_path ) {
 273                         my @columns = map { s/[\r\n]+$//; $_ } read_file $columns_path;
 274                         $loaded->{$path}->{columns} = [ @columns ];
 275                         warn "# columns_path $columns_path ",dump(@columns);
 276                 } else {
 277                         $loaded->{$path}->{columns} = $loaded->{$path}->{header}
 278                 }
 279
 280                 $redirect_to = '/data/columns';
 281         }
 282         $self->session( 'columns' => $loaded->{$path}->{columns} );
 283         $self->session( 'order'   => $loaded->{$path}->{columns}->[0] );
 284         $self->redirect_to( $redirect_to );
 285 }
 286
 287
 288 sub _loaded {
 289         my ( $self, $name ) = @_;
 290         my $path = $self->session('path') || $self->param('path');
 291         $self->redirect_to('/data/index') unless $path;
 292         if ( ! defined $loaded->{$path}->{$name} ) {
 293                 warn "$path $name isn't loaded\n";
 294                 $self->_load_path( $path );
 295                 $self->redirect_to('/data/index')
 296                         unless defined $loaded->{$path}->{$name};
 297                 if ( ! defined $loaded->{$path}->{stats} ) {
 298                         warn "rebuild stats for $path\n";
 299                         $loaded->{$path}->{stats} = __stats( $loaded->{$path}->{data}->{items} );
 300                 }
 301         }
 302         return $loaded->{$path}->{$name};
 303 }
 304
 305
 306 sub _checked {
 307         my $self = shift;
 308         my $checked;
 309         $checked->{$_}++ foreach @_;
 310 #       warn "# _checked ",dump($checked);
 311         return $checked;
 312 }
 313
 314 sub _permanent_path {
 315         my $self = shift;
 316         my $path = $self->_param_or_session('path');
 317         $self->app->home->rel_dir('data') . '/' . join('.', $path, @_);
 318 }
 319
 320 sub _export_path {
 321         my $self = shift;
 322         my $path = $self->_param_or_session('path');
 323         my $dir = $self->app->home->rel_dir('public') . '/export/';
 324         mkdir $dir unless -e $dir;
 325         $dir .= $path;
 326         mkdir $dir unless -e $dir;
 327         $dir . '/' . join('.', @_);
 328 }
 329
 330 sub columns {
 331     my $self = shift;
 332
 333         if ( $self->param('columns') ) {
 334                 my @columns = $self->_param_array('columns');
 335                 write_file( $self->_permanent_path( 'columns' ), map { "$_\n" } @columns );
 336                 $self->redirect_to('/data/items');
 337         }
 338
 339         my $stats = $self->_loaded( 'stats' );
 340
 341         my @columns;
 342         @columns = grep { defined $stats->{$_}->{count} } @{ $self->session('columns') } if $self->session('columns');
 343
 344         foreach my $c ( @{ $self->session( 'header' ) } ) {
 345                 push @columns, $c unless grep { /^\Q$c\E$/ } @columns;
 346         }
 347
 348     $self->render(
 349                 message => 'Select columns to display',
 350                 stats => $stats,
 351                 columns => \@columns,
 352                 checked => $self->_checked( $self->_param_array('columns') ),
 353         );
 354 }
 355
 356 sub _param_array {
 357     my ($self,$name) = @_;
 358
 359         my @array = $self->param($name);
 360         my $path  = $self->session('path');
 361
 362         if ( @array ) {
 363                 $self->session($name => [ @array ]);
 364                 $loaded->{$path}->{$name} = [ @array ];
 365         } elsif ( my $session = $self->session($name) ) {
 366                 if ( ref $session eq 'ARRAY' ) {
 367                         @array = @$session;
 368                 } else {
 369                         die "$name not array ",dump($session);
 370                 }
 371         }
 372         #warn "# $name ",dump @array;
 373         return @array;
 374 }
 375
 376 sub _param_scalar {
 377     my ($self,$name,$default) = @_;
 378
 379         my $scalar = $self->param($name);
 380
 381         if ( defined $scalar ) {
 382                 $self->session($name => $scalar);
 383         } else {
 384                 $scalar = $self->session($name);
 385         }
 386
 387         if ( ! defined $scalar ) {
 388                 $scalar = $default;
 389                 die "no default for $name" unless defined $scalar;
 390                 $self->session($name => $scalar);
 391         }
 392
 393         warn "# _perm_scalar $name ",dump $scalar;
 394         return $scalar;
 395 }
 396
 397 sub filter {
 398         my $self = shift;
 399
 400         my $name = $self->param('filter_name') || die "name?";
 401         my @vals = $self->param('filter_vals');
 402
 403         $self->_remove_filter( $name );
 404         if ( @vals ) {
 405                 $self->_filter_on_data( $name, @vals );
 406                 if ( my $permanent = $self->param('_permanent') ) {
 407                         my $permanent_path = $self->_export_path( 'filter', $name, $permanent );
 408                         write_file $permanent_path, map { "$_\n" } @vals;
 409                         warn "permanent filter $permanent_path ", -s $permanent_path;
 410                 }
 411         }
 412
 413         $self->session( 'offset' => 0 );
 414
 415         $self->redirect_to('/data/items');
 416 }
 417
 418 sub _filter_on_data {
 419         my ( $self, $name, @vals ) = @_;
 420
 421         my $path = $self->session('path');
 422
 423         if ( ! defined $loaded->{$path}->{stats}->{ $name } ) {
 424                 warn "filter $name not found in data set";
 425                 return;
 426         }
 427
 428         $filters->{$name} = [ @vals ];
 429         warn "_filter_on_data $name ", $#vals + 1, " values on $path\n";
 430
 431         my $filter_hash;
 432         $filter_hash->{$_}++ foreach @vals;
 433
 434         #warn "# filter_hash ",dump( $filter_hash );
 435
 436         my $items = $self->_loaded('data')->{items};
 437
 438         my $include_missing = defined $filter_hash->{_missing};
 439         my $filtered_items;
 440
 441         foreach my $i ( 0 .. $#$items ) {
 442
 443                 if ( defined $items->[$i]->{$name} ) {
 444                         foreach my $v ( @{ $items->[$i]->{$name} } ) {
 445                                 if ( defined $filter_hash->{ $v } ) {
 446                                         $filtered_items->{$i}++;
 447                                 }
 448                         }
 449                 } elsif ( $include_missing ) {
 450                         $filtered_items->{$i}++;
 451                 }
 452         }
 453
 454         #warn "# filter $name ",dump($filtered_items);
 455
 456         $loaded->{$path}->{filters}->{$name} = $filtered_items;
 457         warn "filter $name with ", scalar keys %$filtered_items, " items created\n";
 458 }
 459
 460 sub _data_items {
 461         my ( $self, $all ) = @_;
 462         my $data = $self->_loaded( 'data' );
 463
 464         return @{ $data->{items} } if $all == 1;
 465
 466         my $filters = $self->_current_filters;
 467         my $filter_value;
 468         foreach my $f ( keys %$filters ) {
 469                 foreach my $n ( @{ $filters->{$f} } ) {
 470                         $filter_value->{$f}->{$n} = 1;
 471                 }
 472         }
 473         my @items = @{ $data->{items} };
 474         @items = grep {
 475                 my $i = $_;
 476                 my $pass = 1;
 477                 foreach my $n ( keys %$filter_value ) {
 478                         if ( ! exists $i->{$n} ) {
 479                                 if ( defined $filter_value->{$n}->{_missing} ) {
 480                                         $pass = 1;
 481                                         next;
 482                                 } else {
 483                                         $pass = 0;
 484                                         last;
 485                                 }
 486                         }
 487                         # and match any of values in element
 488                         my $have_values = 0;
 489                         foreach my $v ( @{ $i->{$n} } ) { # FIXME not array?
 490                                 $have_values ||= 1 if defined $filter_value->{$n}->{$v};
 491                         }
 492                         if ( ! $have_values ) {
 493                                 $pass = 0;
 494                                 last;
 495                         }
 496                 }
 497                 $pass;
 498         } @items if $filter_value;
 499         return @items;
 500 }
 501
 502
 503 sub _current_filters {
 504         my $self = shift;
 505         my $current_filters;
 506         $current_filters->{ $_ } = $filters->{ $_ }
 507                 foreach (
 508                         grep { defined $filters->{ $_ } }
 509                         @{ $self->_loaded('header') }
 510                 );
 511         #warn "# current_filters ",dump($current_filters);
 512         return $current_filters;
 513 }
 514
 515 sub _data_sorted_by {
 516         my ( $self, $order ) = @_;
 517
 518         my $path = $self->session('path');
 519
 520         warn "_data_sorted_by $order from $path";
 521
 522         if ( defined $loaded->{$path}->{sorted}->{$order} ) {
 523                 return $loaded->{$path}->{sorted}->{$order};
 524         }
 525
 526         my $data = $self->_loaded( 'data' );
 527         my $numeric = $self->_is_numeric($order);
 528         my $missing = $numeric ? 0 : '';
 529         no warnings qw(numeric);
 530         my $nr = 0;
 531         my @sorted = map {
 532                 $_->[0]
 533         } sort {
 534                 if ( $numeric ) {
 535                         $a->[1] <=> $b->[1]
 536                 } else {
 537                         $a->[1] cmp $b->[1]
 538                 }
 539         } map {
 540                 [ $nr++, exists $_->{$order} ? join('', @{$_->{$order}}) : $missing ]
 541         } @{ $data->{items} }
 542         ;
 543
 544         warn "sorted: $order numeric: $numeric items: ", $#sorted + 1, "\n";
 545         #warn "# sorted ",dump( @sorted );
 546
 547         $loaded->{$path}->{sorted}->{$order} = [ @sorted ];
 548 }
 549
 550
 551 sub items {
 552         my $self = shift;
 553
 554         my $path = $self->session('path');
 555         $self->redirect_to('/data/index') unless defined $loaded->{ $path };
 556
 557         my @columns = $self->_param_array('columns');
 558         $self->redirect_to('/data/columns') unless @columns;
 559         my $order   = $self->_param_scalar('order', $columns[0]);
 560         my $sort    = $self->_param_scalar('sort', 'a');
 561         my $offset  = $self->_param_scalar('offset', 0);
 562         my $limit   = $self->_param_scalar('limit', 20);
 563         $self->_param_scalar('show', 'table');
 564
 565         # fix offset when changing limit
 566         $offset = int( $offset / $limit ) * $limit;
 567
 568         my $sorted = $self->_data_sorted_by( $order );
 569
 570         my @filter_names;
 571         if ( $filters ) {
 572                 foreach my $name ( keys %$filters ) {
 573                         if ( ! defined $loaded->{$path}->{stats}->{ $name } ) {
 574                                 warn "skip filter $name not found in $path\n";
 575                                 next;
 576                         }
 577                         push @filter_names, $name;
 578                 }
 579                 warn "filter_names ",dump( @filter_names );
 580                 foreach my $name ( @filter_names ) {
 581                         next if ref $loaded->{$path}->{filters}->{$name} eq 'ARRAY';
 582                         $self->_filter_on_data( $name, @{ $filters->{$name} } );
 583                 }
 584         }
 585
 586         my $all_filters = join(' ',sort @filter_names,'order:',$order);
 587
 588 #       warn "# all_filters $all_filters ", dump( $loaded->{$path}->{filtered}->{$all_filters} );
 589
 590         if ( ! defined $loaded->{$path}->{filtered}->{$all_filters} ) {
 591
 592                 my $path_filters = $loaded->{$path}->{filters};
 593
 594                 warn "create combined filter for $all_filters\n";
 595
 596                 my @filtered;
 597                 foreach my $i ( 0 .. $#$sorted ) {
 598                         my $pos = $sorted->[$i];
 599
 600                         if ( $#filter_names == -1 ) {
 601                                 push @filtered, $pos;
 602                                 next;
 603                         }
 604
 605                         my $skip = 0;
 606                         foreach ( @filter_names ) {
 607                                 $skip ||= 1 if ! defined $path_filters->{$_}->{$pos};
 608                         }
 609                         next if $skip;
 610
 611                         push @filtered, $pos;
 612                 }
 613
 614                 $loaded->{$path}->{filtered}->{$all_filters} = [ @filtered ];
 615         }
 616
 617         my $filtered = $loaded->{$path}->{filtered}->{$all_filters}
 618                 if defined $loaded->{$path}->{filtered}->{$all_filters};
 619
 620         warn "all_filters $all_filters produced ", $#$filtered + 1, " items\n" if $filtered;
 621
 622         my $sorted_items;
 623         my $data = $self->_loaded('data');
 624         my $from_end = $sort eq 'd' ? $#$filtered : 0;
 625         foreach ( 0 .. $limit ) {
 626                 my $i = $_ + $offset;
 627                 last unless defined $filtered->[$i];
 628                 $i = $from_end - $i if $from_end;
 629                 my $id = $filtered->[$i];
 630                 push @$sorted_items,
 631                 my $item = $data->{items}->[ $id ];
 632                 $item->{_row_id} ||= $id;
 633         }
 634
 635         warn "# sorted_items ", $#$sorted_items + 1, " offset $offset limit $limit order $sort";
 636
 637         $self->render(
 638                 order => $order,
 639                 offset => $offset,
 640                 limit => $limit,
 641                 sorted => $sorted_items,
 642                 columns => [ @columns ],
 643                 rows => $#$filtered + 1,
 644                 numeric => { map { $_, $self->_is_numeric($_) } @columns },
 645                 filters => $self->_current_filters,
 646         );
 647
 648 }
 649
 650
 651 sub order {
 652         my $self = shift;
 653         $self->session('order', $self->param('order'));
 654         $self->session('sort', $self->param('sort'));
 655         $self->redirect_to('/data/items');
 656 }
 657
 658 sub _is_numeric {
 659         my ( $self, $name ) = @_;
 660
 661         my $stats = $self->_loaded( 'stats' );
 662
 663         # sort facet numerically if more >50% elements are numeric
 664         my $count = $stats->{$name}->{count};
 665         $count   -= $stats->{$name}->{empty} if defined $stats->{$name}->{empty};
 666         defined $stats->{$name}->{numeric} &&
 667                 $stats->{$name}->{numeric} > $count / 2;
 668 }
 669
 670 sub _remove_filter {
 671         my ($self,$name) = @_;
 672         warn "_remove_filter $name\n";
 673
 674         my $path = $self->session('path');
 675
 676         delete $filters->{$name};
 677         delete $loaded->{$path}->{filters}->{$name};
 678         warn "filters left: ", keys %{ $loaded->{$path}->{filters} };
 679
 680         foreach (
 681                         grep { /\b$name\b/ }
 682                         keys %{ $loaded->{$path}->{filtered} }
 683         ) {
 684                 delete $loaded->{$path}->{filtered}->{$_};
 685                 warn "remove filtered cache $_";
 686         }
 687 }
 688
 689 sub facet {
 690         my $self = shift;
 691
 692         my $path = $self->session('path') || $self->redirect_to( '/data/index' );
 693
 694         if ( my $name = $self->param('remove') ) {
 695                 $self->_remove_filter( $name );
 696                 $self->redirect_to( '/data/items' );
 697         }
 698
 699         my $facet;
 700         my $name = $self->param('name') || die "no name";
 701
 702         my $all = $self->_param_scalar('all', 1);
 703         my $data = $self->_loaded('data');
 704
 705         my $filters = $self->_current_filters;
 706         my $all_filters = join(' ',sort keys %$filters,'order:',$self->session('order'));
 707         my $filtered = $loaded->{$path}->{filtered}->{$all_filters}
 708                 if defined $loaded->{$path}->{filtered}->{$all_filters};
 709
 710         if ( ! $filtered || $all ) {
 711                 $filtered = [ 0 .. $#{ $data->{items} } ];
 712                 warn "filter all values\n";
 713         } else {
 714                 warn "filter using $all_filters\n";
 715         }
 716
 717         foreach my $i ( @$filtered ) {
 718                 my $item = $data->{items}->[$i];
 719                 if ( ! exists $item->{$name} ) {
 720                         $facet->{ _missing }++;
 721                 } elsif ( ref $item->{$name} eq 'ARRAY' ) {
 722                         $facet->{$_}++ foreach @{ $item->{$name} };
 723                 } else {
 724                         $facet->{ $item->{$name} }++;
 725                 }
 726         }
 727
 728 #       warn "# facet $name ",dump $facet;
 729
 730         my $checked;
 731         my @facet_names =
 732                   $all                      ? keys %$facet
 733                 : defined $filters->{$name} ? @{ $filters->{$name} }
 734                 : keys %$facet;
 735
 736         $checked = $self->_checked( @{ $filters->{$name} } ) if defined $filters->{$name};
 737
 738         my $numeric = $self->_is_numeric($name);
 739
 740         my $sort = $self->param('sort');
 741         # sort numeric facets with more than 5 values ascending
 742         $sort ||= $numeric && $#facet_names > 4 ? 'a' : 'c';
 743
 744         @facet_names = sort {
 745                 my $result;
 746                 if ( $sort eq 'a' ) {
 747                         $result = $numeric ? $a <=> $b : lc $a cmp lc $b;
 748                 } elsif ( $sort eq 'd' ) {
 749                         $result = $numeric ? $b <=> $a : lc $b cmp lc $a;
 750                 } elsif ( $sort eq 'c' ) {
 751                         $result = ( $facet->{$b} || -1 ) <=> ( $facet->{$a} || -1 )
 752                 } else {
 753                         warn "unknown sort: $sort";
 754                         $result = $a cmp $b;
 755                 }
 756                 $result = $a cmp $b unless defined $result; # FIXME cludge for numeric facets with invalid data
 757                 $result;
 758         } @facet_names;
 759
 760         $self->render( name => $name, facet => $facet, checked => $checked,
 761                 facet_names => \@facet_names, sort => $sort, numeric => $numeric,
 762         );
 763 }
 764
 765 sub edit {
 766         my $self = shift;
 767         my $new_content = $self->param('new_content');
 768
 769         my $i = $self->param('_row_id');
 770         die "invalid _row_id ",dump($i) unless $i =~ m/^\d+$/;
 771         my $path = $self->param('path') || die "no path";
 772         my $name = $self->param('name') || die "no name";
 773         my $status = 200; # 200 = OK, 201 = Created
 774
 775         my $data = $self->_loaded('data');
 776
 777         if ( defined $loaded->{$path}->{data}->{items}->[$i] ) {
 778                 $new_content =~ s/^\s+//s;
 779                 $new_content =~ s/\s+$//s;
 780                 my $v;
 781                 if ( $new_content =~ /\xB6/ ) { # para
 782                         $v = [ split(/\s*\xB6\s*/, $new_content) ];
 783                 } else {
 784                         $v = [ $new_content ];
 785                 }
 786
 787                 my $old = dump $loaded->{$path}->{data}->{items}->[$i]->{$name};
 788                 my $new = dump $v;
 789                 if ( $old ne $new
 790                         && ! ( $old eq 'undef' && length($new_content) == 0 ) # new value empty, previous undef
 791                 ) {
 792                         my $edit = {
 793                                 path => $path,
 794                                 column => $name,
 795                                 pos => $i,
 796                                 old => $loaded->{$path}->{data}->{items}->[$i]->{$name},
 797                                 new => $v,
 798                                 time => $self->param('time') || time(),
 799                                 user => $self->param('user') || $ENV{'LOGNAME'},
 800                                 unique => {
 801                                         map { $_ => $loaded->{$path}->{data}->{items}->[$i]->{$_}->[0] }
 802                                         grep { defined $loaded->{$path}->{stats}->{$_}->{unique} }
 803                                         keys %{ $loaded->{$path}->{stats} }
 804                                 },
 805                         };
 806                         my $edit_path = $self->_permanent_path( 'edits' );
 807                         mkdir $edit_path unless -d $edit_path;
 808                         $edit_path .= '/' . $edit->{time};
 809                         store $edit, $edit_path;
 810                         utime $edit->{time}, $edit->{time}, $edit_path;
 811                         warn "# $edit_path ", dump($edit);
 812
 813                         warn "# edit $path $i $old -> $new\n";
 814                         $loaded->{$path}->{data}->{items}->[$i]->{$name} = $v;
 815
 816                         if ( defined $loaded->{$path}->{sorted}->{$name} ) {
 817                             delete $loaded->{$path}->{sorted}->{$name};
 818                                 warn "# invalidate $path sorted $name\n";
 819                         }
 820
 821                         foreach ( grep { m/$name/ } keys %{ $loaded->{$path}->{filtered} } ) {
 822                             delete $loaded->{$path}->{filtered}->{$_};
 823                                 warn "# invalidate $path filtered $_\n";
 824                         }
 825
 826                         $status = 201; # created
 827                         $self->session('save_path' => $path);
 828
 829                         $new_content = join("\xB6",@$v);
 830
 831                 } else {
 832                         warn "# unchanged $path $i $old\n";
 833                         $status = 304;
 834                 }
 835         } else {
 836                 $new_content = "$path $i $name doesn't exist\n";
 837                 $status = 404;
 838         }
 839
 840         warn "# edit $status ", dump $new_content;
 841
 842         $self->render(
 843                 status => $status,
 844                 new_content => scalar $new_content,
 845         );
 846 }
 847
 848
 849 sub save {
 850         my $self = shift;
 851         my $path = $self->_param_or_session('path');
 852         my $dump_path = $self->_save( $path );
 853         $self->session('save_path' => 0);
 854
 855         $self->redirect_to( '/data/items' );
 856 }
 857
 858 sub export {
 859         my $self = shift;
 860         $self->render( export => [
 861                 map { s{^.+/public/export/}{}; $_ }
 862                 glob( $self->_export_path . '*' )
 863         ] );
 864 }
 865
 866 sub __loaded_paths {
 867         return
 868                 grep { defined $loaded->{$_}->{data} }
 869                 keys %$loaded;
 870 }
 871
 872 1;