/[Sack]/trunk/bin/sack.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk/bin/sack.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6 - (hide annotations)
Mon Sep 21 15:41:30 2009 UTC (14 years, 8 months ago) by dpavlin
File MIME type: text/plain
File size: 1886 byte(s)
added --view which can be repeated
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     }
41    
42    
43     report $input->size . ' records loaded';
44    
45     mkdir 'out' unless -e 'out';
46    
47 dpavlin 5 our $out;
48    
49 dpavlin 1 sub run_views {
50 dpavlin 6 @views = sort glob 'views/*.pl' unless @views;
51 dpavlin 1 warn "# views ", dump @views;
52    
53     foreach my $view ( @views ) {
54    
55     my ( $nr, $package ) = ( $1, $2 )
56     if $view =~ m{/(\d+)\.([^/]+(\.pl)?$)};
57    
58 dpavlin 5 undef $out;
59 dpavlin 1
60     next if system("perl -c $view") != 0;
61    
62     my $code = read_file $view;
63 dpavlin 5 warn "## CODE\n$code\n## CODE\n";
64 dpavlin 1
65 dpavlin 5 my $affected = 0;
66 dpavlin 1 $t = time;
67    
68 dpavlin 5 foreach my $pos ( $offset + 1 .. $input->size ) {
69     my $rec = $input->fetch_rec($pos);
70     if ( ! $rec ) {
71     warn "END at $pos";
72     last;
73     }
74 dpavlin 1
75 dpavlin 5 eval "$code";
76     if ( $@ ) {
77     warn "ERROR [$pos] $@\n";
78     } else {
79     $affected++;
80     }
81 dpavlin 1 };
82    
83 dpavlin 5 report "$affected affected records $view";
84 dpavlin 1
85     if ( defined $out ) {
86     my $dump = dump $out;
87     my $len = length $dump;
88     my $path = "out/$nr.$package";
89 dpavlin 5 print "out $view $offset/$limit $len bytes $path"
90     , ( $len < 10000 ? " \$out = $dump" : ' SAVED ONLY' )
91 dpavlin 1 , "\n"
92     ;
93 dpavlin 5
94 dpavlin 1 write_file $path, $dump;
95     report "save $path";
96 dpavlin 5 } else {
97     warn "W: no \$out defined!";
98 dpavlin 1 }
99    
100     }
101     }
102    
103 dpavlin 3 run_views;
104    
105 dpavlin 1 while ( 1 ) {
106    
107     print "sack> ";
108     my $cmd = <STDIN>;
109    
110 dpavlin 3 if ( $cmd =~ m{(vi|\\e|out)}i ) {
111     system "vi out/*";
112     } else {
113     run_views;
114     }
115    
116 dpavlin 1 }
117    

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26