trunk/bin/sack.pl

#!/usr/bin/perl

use warnings;
use strict;

use Time::HiRes qw(time);
use Data::Dump qw(dump);
use File::Slurp;
use Getopt::Long;


my $path   = '/data/isi/full.txt';
my $limit  = 10000;
my $offset = 0; 
my @views;


GetOptions(
        'path=s'   => \$path,
        'offset=i' => \$offset,
        'limit=i'  => \$limit,
        'view=s'   => \@views,
) or die $!;

my $t = time;

use lib '/srv/webpac2/lib/';
use WebPAC::Input::ISI;
my $input = WebPAC::Input::ISI->new(
        path   => $path,
        offset => $offset,
        limit  => $limit,
);


sub report {
        my $description = shift;
        my $dt = time - $t;
        printf "%s in %1.4fs %.2f/s\n", $description, $dt, $input->size / $dt;
        $t = time;
}


report $input->size . ' records loaded';

mkdir 'out' unless -e 'out';

our $out;

our $cache;

sub run_views {
        @views = sort glob 'views/*.pl' unless @views;
        warn "# views ", dump @views;

        foreach my $view ( @views ) {

                my ( $nr, $package ) = ( $1, $2 )
                        if $view =~ m{/(\d+)\.([^/]+(\.pl)?$)};

                undef $out;

                next if system("perl -c $view") != 0;

                my $code = read_file $view;
                warn "## CODE\n$code\n## CODE\n";

                my $affected = 0;
                $t = time;

                foreach my $pos ( $offset + 1 .. $offset + $input->size ) {
                        my $rec = $cache->{$pos} ||= $input->fetch_rec( $pos );
                        if ( ! $rec ) {
                                warn "END at $pos";
                                last;
                        }

                        eval "$code";
                        if ( $@ ) {
                                warn "ERROR [$pos] $@\n";
                        } else {
                                $affected++;
                        }
                };

                report "$affected affected records $view";

                if ( defined $out ) {
                        my $dump = dump $out;
                        my $len  = length $dump;
                        my $path = "out/$nr.$package";
                        print "out $view $offset/$limit $len bytes $path"
                                , ( $len < 10000 ?  " \$out = $dump" : ' SAVED ONLY' )
                                , "\n"
                                ;

                        unlink "$path.last" if -e "$path.last";
                        rename $path, "$path.last";
                        write_file $path, $dump;
                        report "save $path";
                } else {
                        warn "W: no \$out defined!";
                }

        }
}

run_views;

while ( 1 ) {

        print "sack> ";
        my $cmd = <STDIN>;

        if ( $cmd =~ m{(vi|\\e|out)}i ) {
                system "vi out/*";
        } else {
                run_views;
        }

}

1	dpavlin	1	#!/usr/bin/perl
2
3			use warnings;
4			use strict;
5
6			use Time::HiRes qw(time);
7			use Data::Dump qw(dump);
8			use File::Slurp;
9	dpavlin	4	use Getopt::Long;
10	dpavlin	1
11	dpavlin	4
12			my $path = '/data/isi/full.txt';
13			my $limit = 10000;
14			my $offset = 0;
15	dpavlin	6	my @views;
16	dpavlin	4
17
18			GetOptions(
19			'path=s' => \$path,
20			'offset=i' => \$offset,
21			'limit=i' => \$limit,
22	dpavlin	6	'view=s' => \@views,
23	dpavlin	5	) or die $!;
24	dpavlin	4
25	dpavlin	1	my $t = time;
26
27			use lib '/srv/webpac2/lib/';
28			use WebPAC::Input::ISI;
29			my $input = WebPAC::Input::ISI->new(
30	dpavlin	4	path => $path,
31			offset => $offset,
32			limit => $limit,
33	dpavlin	1	);
34
35
36			sub report {
37			my $description = shift;
38			my $dt = time - $t;
39			printf "%s in %1.4fs %.2f/s\n", $description, $dt, $input->size / $dt;
40	dpavlin	10	$t = time;
41	dpavlin	1	}
42
43
44			report $input->size . ' records loaded';
45
46			mkdir 'out' unless -e 'out';
47
48	dpavlin	5	our $out;
49
50	dpavlin	8	our $cache;
51
52	dpavlin	1	sub run_views {
53	dpavlin	6	@views = sort glob 'views/*.pl' unless @views;
54	dpavlin	1	warn "# views ", dump @views;
55
56			foreach my $view ( @views ) {
57
58			my ( $nr, $package ) = ( $1, $2 )
59			if $view =~ m{/(\d+)\.([^/]+(\.pl)?$)};
60
61	dpavlin	5	undef $out;
62	dpavlin	1
63			next if system("perl -c $view") != 0;
64
65			my $code = read_file $view;
66	dpavlin	5	warn "## CODE\n$code\n## CODE\n";
67	dpavlin	1
68	dpavlin	5	my $affected = 0;
69	dpavlin	1	$t = time;
70
71	dpavlin	9	foreach my $pos ( $offset + 1 .. $offset + $input->size ) {
72			my $rec = $cache->{$pos} \|\|= $input->fetch_rec( $pos );
73	dpavlin	5	if ( ! $rec ) {
74			warn "END at $pos";
75			last;
76			}
77	dpavlin	1
78	dpavlin	5	eval "$code";
79			if ( $@ ) {
80			warn "ERROR [$pos] $@\n";
81			} else {
82			$affected++;
83			}
84	dpavlin	1	};
85
86	dpavlin	5	report "$affected affected records $view";
87	dpavlin	1
88			if ( defined $out ) {
89			my $dump = dump $out;
90			my $len = length $dump;
91			my $path = "out/$nr.$package";
92	dpavlin	5	print "out $view $offset/$limit $len bytes $path"
93			, ( $len < 10000 ? " \$out = $dump" : ' SAVED ONLY' )
94	dpavlin	1	, "\n"
95			;
96	dpavlin	5
97	dpavlin	9	unlink "$path.last" if -e "$path.last";
98			rename $path, "$path.last";
99	dpavlin	1	write_file $path, $dump;
100			report "save $path";
101	dpavlin	5	} else {
102			warn "W: no \$out defined!";
103	dpavlin	1	}
104
105			}
106			}
107
108	dpavlin	3	run_views;
109
110	dpavlin	1	while ( 1 ) {
111
112			print "sack> ";
113			my $cmd = <STDIN>;
114
115	dpavlin	3	if ( $cmd =~ m{(vi\|\\e\|out)}i ) {
116			system "vi out/*";
117			} else {
118			run_views;
119			}
120
121	dpavlin	1	}
122