/[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 19 by dpavlin, Tue Sep 22 15:14:00 2009 UTC revision 25 by dpavlin, Tue Sep 22 21:38:31 2009 UTC
# Line 3  Line 3 
3  use warnings;  use warnings;
4  use strict;  use strict;
5    
6    our $VERSION = '0.01';
7    
8  use Time::HiRes qw(time);  use Time::HiRes qw(time);
9  use Data::Dump qw(dump);  use Data::Dump qw(dump);
10  use File::Slurp;  use File::Slurp;
# Line 16  my $path   = '/data/isi/full.txt'; Line 18  my $path   = '/data/isi/full.txt';
18  my $limit  = 5000;  my $limit  = 5000;
19  my $offset = 0;  my $offset = 0;
20  my @views;  my @views;
21  my $listen;  my $listen = 0; # off
22  my @nodes;  my @nodes;
23    
24    
# Line 33  GetOptions( Line 35  GetOptions(
35  my $t = time;  my $t = time;
36    
37    
38    sub send_nodes;
39    
40  our $prefix;  our $prefix;
41  BEGIN {  sub BEGIN {
42          $prefix = $0;          $prefix = $0;
43          if ( $prefix =~ s{^./}{} ) {          if ( $prefix =~ s{^./}{} ) {
44                  chomp( my $pwd = `pwd` );                  chomp( my $pwd = `pwd` );
# Line 42  BEGIN { Line 46  BEGIN {
46          }          }
47          $prefix =~ s{^(.*)/srv/Sack/bin.+$}{$1};          $prefix =~ s{^(.*)/srv/Sack/bin.+$}{$1};
48          warn "# prefix $prefix";          warn "# prefix $prefix";
49    
50            $SIG{INT} = sub {
51                    my $signame = shift;
52                    send_nodes 'exit';
53                    die "SIG$signame";
54            };
55  }  }
56    
57    
58  use lib "$prefix/srv/webpac2/lib/";  use lib "$prefix/srv/webpac2/lib/";
59  use WebPAC::Input::ISI;  use WebPAC::Input::ISI;
60    
61    $WebPAC::Input::ISI::subfields = undef; # disable parsing of subfields
62    
63  my $input = WebPAC::Input::ISI->new(  my $input = WebPAC::Input::ISI->new(
64          path   => "$prefix/$path",          path   => "$prefix/$path",
65          offset => $offset,          offset => $offset,
66          limit  => $limit,          limit  => $limit,
67  );  );
68    
69    our $num_records = $input->size;
70    
71  sub report {  sub report {
72          my $description = shift;          my $description = shift;
# Line 74  our $connected; Line 88  our $connected;
88    
89  sub send_nodes {  sub send_nodes {
90          my $content = $#_ > 0 ? pop @_ : '';    # no content with just one argument!          my $content = $#_ > 0 ? pop @_ : '';    # no content with just one argument!
91          my $header = length($content);          my $header = defined $content ? length($content) : 0;
92          $header .= ' ' . join(' ', @_) if @_;          $header .= ' ' . join(' ', @_) if @_;
93    
94          foreach my $node ( @nodes ) {          foreach my $node ( @nodes ) {
# Line 89  sub send_nodes { Line 103  sub send_nodes {
103                          next;                          next;
104                  }                  }
105    
106                  print ">>>> $node $header\n";                  print ">>>> $listen $node $header\n";
107                  print $sock "$header\n$content" || warn "can't send $header to $node: $!";                  print $sock "$header\n$content" || warn "can't send $header to $node: $!";
108    
109                  $connected->{$node} = $sock;                  $connected->{$node} = $sock;
# Line 106  sub get_node { Line 120  sub get_node {
120                  return;                  return;
121          }          }
122          chomp( my $size = <$sock> );          chomp( my $size = <$sock> );
123          warn "<<<< $node $size bytes\n";          warn "<<<< $listen $node $size bytes\n";
124          my $data;          my $data;
125          read $sock, $data, $size;          read $sock, $data, $size;
126          return $data;          return $data;
# Line 115  sub get_node { Line 129  sub get_node {
129  sub send_sock {  sub send_sock {
130          my ( $sock, $data ) = @_;          my ( $sock, $data ) = @_;
131          my $size   = length $data;          my $size   = length $data;
132          warn ">>>> ", $sock->peerhost, " $size bytes";          warn ">>>> $listen ", $sock->peerhost, " $size bytes";
133          print $sock "$size\n$data" || warn "can't send $size bytes to ", $sock->peerhost;          print $sock "$size\n$data" || warn "can't send $size bytes to ", $sock->peerhost;
134  }  }
135    
# Line 134  sub merge_out { Line 148  sub merge_out {
148                          } elsif ( $k1 =~ m{\+} ) {                          } elsif ( $k1 =~ m{\+} ) {
149  #                               warn "## agregate $k1 $k2";  #                               warn "## agregate $k1 $k2";
150                                  $out->{$k1}->{$k2} += $n;                                  $out->{$k1}->{$k2} += $n;
151                          } elsif ( $ref eq 'ARRAY' ) {                          } elsif ( $ref  eq 'ARRAY' ) {
152                                  push @{ $out->{$k1}->{$k2} }, $n;                                  if ( ref $n eq 'ARRAY' ) {
153                                            push @{ $out->{$k1}->{$k2} }, $_ foreach @$n;
154                                    } else {
155                                            push @{ $out->{$k1}->{$k2} }, $n;
156                                    }
157                          } elsif ( $ref eq '' ) {                          } elsif ( $ref eq '' ) {
158                                  $out->{$k1}->{$k2} = [ $out->{$k1}->{$k2}, $n ];                                  $out->{$k1}->{$k2} = [ $out->{$k1}->{$k2}, $n ];
159                          } else {                          } else {
# Line 150  sub merge_out { Line 168  sub merge_out {
168  sub run_code {  sub run_code {
169          my ( $view, $code ) = @_;          my ( $view, $code ) = @_;
170    
171          warn "\n#### CODE $view START ####\n$code\n#### CODE $view END ####\n";          warn "\n#### CODE $view START ####\n$code\n#### CODE $view END ####\n" if $debug;
172    
173          send_nodes view => $view => $code;          send_nodes view => $view => $code;
174    
# Line 168  sub run_code { Line 186  sub run_code {
186    
187                  eval "$code";                  eval "$code";
188                  if ( $@ ) {                  if ( $@ ) {
189                          warn "ERROR [$pos] $@\n";                          warn "ABORT [$pos] $@\n";
190                            last;
191                  } else {                  } else {
192                          $affected++;                          $affected++;
193                  }                  }
# Line 179  sub run_code { Line 198  sub run_code {
198          warn "WARN no \$out defined!" unless defined $out;          warn "WARN no \$out defined!" unless defined $out;
199    
200          if ( $connected ) {          if ( $connected ) {
201                  warn "# get results from ", join(' ', keys %$connected );                  foreach my $node ( keys %$connected ) {
202                  merge_out( thaw( get_node( $_ ) ) ) foreach keys %$connected;                          warn "# $listen get_node $node\n";
203                            my $o = get_node $node;
204                            my $s = length $o;
205                            $o = thaw $o;
206                            warn "# $listen merge $s bytes\n";
207                            merge_out $o;
208                    }
209          }          }
210  }  }
211    
# Line 222  sub run_views { Line 247  sub run_views {
247  if ( $listen ) {  if ( $listen ) {
248          my $sock = IO::Socket::INET->new(          my $sock = IO::Socket::INET->new(
249                  Listen    => SOMAXCONN,                  Listen    => SOMAXCONN,
250  #               LocalAddr => '0.0.0.0',                  LocalAddr => '127.0.0.1',
251                  LocalPort => $listen,                  LocalPort => $listen,
252                  Proto     => 'tcp',                  Proto     => 'tcp',
253                  Reuse     => 1,                  Reuse     => 1,
# Line 230  if ( $listen ) { Line 255  if ( $listen ) {
255    
256          while (1) {          while (1) {
257    
258                  warn "NODE listen on $listen\n";                  warn "NODE $listen ready - path: $path offset: $offset limit: $limit #recs: $num_records\n";
259    
260                  my $client = $sock->accept();                  my $client = $sock->accept();
261    
262                  warn "<<<< $listen connect from ", $client->peerhost, $/;                  warn "<<<< $listen connect from ", $client->peerhost, $/;
263    
264                  my @header = split(/\s/, <$client>);                  my @header = split(/\s/, <$client>);
265                  warn "# header ",dump @header;                  warn "<<<< $listen header ",dump(@header),$/;
266    
267                  my $size = shift @header;                  my $size = shift @header;
268    
# Line 248  if ( $listen ) { Line 273  if ( $listen ) {
273                          run_code $header[1] => $content;                          run_code $header[1] => $content;
274                          send_sock $client => freeze $out;                          send_sock $client => freeze $out;
275                  } elsif ( $header[0] eq 'info' ) {                  } elsif ( $header[0] eq 'info' ) {
276                          my $info = "$listen\t$offset\t$limit\t$path";                          my $info = "$listen\t$offset\t$limit\t$num_records\t$path";
277                            $info .= "\t" . eval $header[1] if $header[1];
278                          warn "info $info\n";                          warn "info $info\n";
279                          send_sock $client => $info;                          send_sock $client => $info;
280                  } elsif ( $header[0] eq 'exit' ) {                  } elsif ( $header[0] eq 'exit' ) {
# Line 266  run_views; Line 292  run_views;
292  while ( 1 ) {  while ( 1 ) {
293    
294          print "sack> ";          print "sack> ";
295          my $cmd = <STDIN>;          chomp( my $cmd = <STDIN> );
296    
297          if ( $cmd =~ m{^(vi?|\\e|o(?:ut)?)}i ) {          if ( $cmd =~ m{^(h|\?)} ) {
298                    print << "__HELP__"
299    Sacks Lorry v$VERSION - path: $path offset: $offset limit: $limit
300    
301            View Run        run views
302            VI \\e Output   show output of last run
303            Info [\$VERSION]        instrospect
304            Quit EXit       shutdown
305    
306    __HELP__
307            } elsif ( $cmd =~ m{^(vi|\\e|o)}i ) {
308                  system "vi out/*";                  system "vi out/*";
309          } elsif ( $cmd =~ m{^i(nfo)?}i ) {          } elsif ( $cmd =~ m{^i(?:nfo)?\s?(.+)?$}i ) {
310                  print "# nodes: ", join(' ',@nodes), $/;                  print "# nodes: ", join(' ',@nodes), $/;
311    
312                    send_nodes 'info' => $2;
313    
314                  my @info = (                  my @info = (
315                          "node\toffset\tlimit\tpath",                          "node\toffset\tlimit\t#recs\tpath",
316                          "----\t------\t-----\t----",                          "----\t------\t-----\t-----\t----",
317                          "here\t$offset\t$limit\t$path",                          "0\t$offset\t$limit\t$num_records\t$path",
318                  );                  );
319    
                 send_nodes 'info';  
320                  push @info, get_node $_ foreach @nodes;                  push @info, get_node $_ foreach @nodes;
321    
322                  print "$_\n" foreach @info;                  print "$_\n" foreach @info;
323    
324          } elsif ( $cmd =~ m{^(q(uit)|e(xit))}i ) {          } elsif ( $cmd =~ m{^(q|e|x)}i ) {
325                  warn "# exit";                  warn "# exit";
326                  send_nodes 'exit';                  send_nodes 'exit';
327                  exit;                  exit;
328          } else {          } elsif ( $cmd =~ m{^(v|r)}i ) {
329                  run_views;                  run_views;
330            } elsif ( $cmd ) {
331                    warn "UNKNOWN ", dump $cmd;
332          }          }
333    
334  }  }
Legend:
Removed from v.19  
changed lines
  Added in v.25
  ViewVC Help
Powered by ViewVC 1.1.26