lib/Sack/View.pm

package Sack::View;

use warnings;
use strict;

use Data::Dump qw(dump);

use lib '/srv/Sack/lib';
use Sack::Color;
use Sack;

our $coderef;
our $out;

sub out { $out };

sub code {
        my ( $self, $code ) = @_;

warn "XX code $code";

        undef $out;

        $coderef = eval "sub { my \$rec = \$_[0]; $code }";

        if ( $@ ) {
                warn "ABORT code: $@";
                return;
        }

        ref $coderef eq 'CODE';
}

sub on_shard {
        my ( $self, $data ) = @_;

warn "XX data ",dump $data;

        my $affected = 0;

        foreach my $pos ( 0 .. $#{ $data } ) {
                if ( ! defined $data->[$pos] ) {
                        print STDERR "END @ $pos";
                        last;
                }

                eval { $coderef->( $data->[$pos] ) };

                if ( $@ ) {
                        warn "ABORT $pos $@\n";
                        last;
                } else {
                        $affected++;
                }

                $pos % 10000 == 0 ? print STDERR $pos :
                $pos % 1000  == 0 ? print STDERR "."  : 0 ;
        };

        warn "## out ", dump( $out );
}

1;
1	dpavlin	193	package Sack::View;
2	dpavlin	92
3			use warnings;
4			use strict;
5
6			use Data::Dump qw(dump);
7
8	dpavlin	193	use lib '/srv/Sack/lib';
9	dpavlin	102	use Sack::Color;
10	dpavlin	142	use Sack;
11	dpavlin	92
12	dpavlin	193	our $coderef;
13			our $out;
14	dpavlin	92
15	dpavlin	193	sub out { $out };
16	dpavlin	92
17	dpavlin	193	sub code {
18			my ( $self, $code ) = @_;
19	dpavlin	92
20	dpavlin	193	warn "XX code $code";
21	dpavlin	92
22	dpavlin	193	undef $out;
23	dpavlin	92
24	dpavlin	193	$coderef = eval "sub { my \$rec = \$_[0]; $code }";
25	dpavlin	92
26	dpavlin	193	if ( $@ ) {
27			warn "ABORT code: $@";
28			return;
29	dpavlin	92	}
30
31	dpavlin	193	ref $coderef eq 'CODE';
32	dpavlin	92	}
33
34	dpavlin	193	sub on_shard {
35			my ( $self, $data ) = @_;
36	dpavlin	92
37	dpavlin	193	warn "XX data ",dump $data;
38
39	dpavlin	92	my $affected = 0;
40
41	dpavlin	193	foreach my $pos ( 0 .. $#{ $data } ) {
42			if ( ! defined $data->[$pos] ) {
43	dpavlin	92	print STDERR "END @ $pos";
44			last;
45			}
46
47	dpavlin	193	eval { $coderef->( $data->[$pos] ) };
48	dpavlin	162
49	dpavlin	92	if ( $@ ) {
50			warn "ABORT $pos $@\n";
51			last;
52			} else {
53			$affected++;
54			}
55
56			$pos % 10000 == 0 ? print STDERR $pos :
57			$pos % 1000 == 0 ? print STDERR "." : 0 ;
58			};
59
60	dpavlin	193	warn "## out ", dump( $out );
61	dpavlin	92	}
62
63			1;