/[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

Diff of /trunk/bin/sack.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 10 by dpavlin, Mon Sep 21 20:32:51 2009 UTC revision 11 by dpavlin, Mon Sep 21 23:21:34 2009 UTC
# Line 7  use Time::HiRes qw(time); Line 7  use Time::HiRes qw(time);
7  use Data::Dump qw(dump);  use Data::Dump qw(dump);
8  use File::Slurp;  use File::Slurp;
9  use Getopt::Long;  use Getopt::Long;
10    use IO::Socket::INET;
11    
12    
13  my $path   = '/data/isi/full.txt';  my $path   = '/data/isi/full.txt';
14  my $limit  = 10000;  my $limit  = 5000;
15  my $offset = 0;  my $offset = 0;
16  my @views;  my @views;
17    my $listen;
18    my @nodes;
19    
20    
21  GetOptions(  GetOptions(
# Line 20  GetOptions( Line 23  GetOptions(
23          'offset=i' => \$offset,          'offset=i' => \$offset,
24          'limit=i'  => \$limit,          'limit=i'  => \$limit,
25          'view=s'   => \@views,          'view=s'   => \@views,
26            'listen|port=i' => \$listen,
27            'connect=s'   => \@nodes,
28  ) or die $!;  ) or die $!;
29    
30  my $t = time;  my $t = time;
# Line 49  our $out; Line 54  our $out;
54    
55  our $cache;  our $cache;
56    
57    sub send_nodes {
58            my $content = pop @_;
59            my $header = length($content);
60            $header .= ' ' . join(' ', @_) if @_;
61    
62            foreach my $node ( @nodes ) {
63    
64                    my $sock = IO::Socket::INET->new(
65                            PeerAddr => $node,
66                            Proto    => 'tcp',
67                    ) or die "can't connect to $node - $!";
68    
69                    print ">>>> $node $header\n";
70    
71                    print $sock "$header\n$content" || warn "can't send $header to $node: $!";
72    
73            }
74    }
75    
76    sub run_code {
77            my ( $view, $code ) = @_;
78    
79            warn "\n#### CODE $view START ####\n$code\n#### CODE $view END ####\n";
80    
81            send_nodes view => $view => $code;
82    
83            undef $out;
84    
85            my $affected = 0;
86            $t = time;
87    
88            foreach my $pos ( $offset + 1 .. $offset + $input->size ) {
89                    my $rec = $cache->{$pos} ||= $input->fetch_rec( $pos );
90                    if ( ! $rec ) {
91                            warn "END at $pos";
92                            last;
93                    }
94    
95                    eval "$code";
96                    if ( $@ ) {
97                            warn "ERROR [$pos] $@\n";
98                    } else {
99                            $affected++;
100                    }
101            };
102    
103            report "$affected affected records $view";
104    
105            warn "WARN no \$out defined!" unless defined $out;
106    }
107    
108  sub run_views {  sub run_views {
109          @views = sort glob 'views/*.pl' unless @views;          @views = sort glob 'views/*.pl' unless @views;
110          warn "# views ", dump @views;          warn "# views ", dump @views;
111    
112          foreach my $view ( @views ) {          foreach my $view ( @views ) {
113    
                 my ( $nr, $package ) = ( $1, $2 )  
                         if $view =~ m{/(\d+)\.([^/]+(\.pl)?$)};  
   
                 undef $out;  
   
114                  next if system("perl -c $view") != 0;                  next if system("perl -c $view") != 0;
115    
116                  my $code = read_file $view;                  my $code = read_file $view;
                 warn "## CODE\n$code\n## CODE\n";  
117    
118                  my $affected = 0;                  run_code $view => $code;
                 $t = time;  
119    
120                  foreach my $pos ( $offset + 1 .. $offset + $input->size ) {                  if ( defined $out ) {
                         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 ) {  
121                          my $dump = dump $out;                          my $dump = dump $out;
122                          my $len  = length $dump;                          my $len  = length $dump;
123                          my $path = "out/$nr.$package";  
124                          print "out $view $offset/$limit $len bytes $path"                          my $path = $view;
125                            $path =~ s{views?/}{out/} || die "no view in $view";
126                            $path =~ s{\.pl}{};
127    
128                            print "OUT $view $offset/$limit $len bytes $path"
129                                  , ( $len < 10000 ?  " \$out = $dump" : ' SAVED ONLY' )                                  , ( $len < 10000 ?  " \$out = $dump" : ' SAVED ONLY' )
130                                  , "\n"                                  , "\n"
131                                  ;                                  ;
# Line 97  sub run_views { Line 133  sub run_views {
133                          unlink "$path.last" if -e "$path.last";                          unlink "$path.last" if -e "$path.last";
134                          rename $path, "$path.last";                          rename $path, "$path.last";
135                          write_file $path, $dump;                          write_file $path, $dump;
136                          report "save $path";                          report "SAVE $path";
137                    }
138    
139            }
140    
141    }
142    
143    if ( $listen ) {
144            my $sock = IO::Socket::INET->new(
145                    Listen    => SOMAXCONN,
146    #               LocalAddr => '0.0.0.0',
147                    LocalPort => $listen,
148                    Proto     => 'tcp',
149                    Reuse     => 1,
150            ) or die $!;
151    
152            while (1) {
153    
154                    warn "NODE listen on $listen\n";
155    
156                    my $client = $sock->accept();
157    
158                    warn "<<<< connect from ", $client->peerhost, $/;
159    
160                    my @header = split(/\s/, <$client>);
161                    warn "# header ",dump @header;
162    
163                    my $size = shift @header;
164    
165                    my $content;
166                    read $client, $content, $size;
167    
168                    if ( $header[0] eq 'view' ) {
169                            run_code $header[1] => $content;
170                  } else {                  } else {
171                          warn "W: no \$out defined!";                          warn "WARN unknown";
172                  }                  }
173    
174          }          }
# Line 112  while ( 1 ) { Line 181  while ( 1 ) {
181          print "sack> ";          print "sack> ";
182          my $cmd = <STDIN>;          my $cmd = <STDIN>;
183    
184          if ( $cmd =~ m{(vi|\\e|out)}i ) {          if ( $cmd =~ m{^(vi?|\\e|o(?:ut)?)}i ) {
185                  system "vi out/*";                  system "vi out/*";
186            } elsif ( $cmd =~ m{^i(nfo)?}i ) {
187                    print "nodes: ", dump @nodes, $/;
188          } else {          } else {
189                  run_views;                  run_views;
190          }          }
Legend:
Removed from v.10  
changed lines
  Added in v.11
  ViewVC Help
Powered by ViewVC 1.1.26