/[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 50 by dpavlin, Thu Sep 24 19:21:55 2009 UTC revision 60 by dpavlin, Fri Sep 25 13:02:32 2009 UTC
# Line 44  sub BEGIN { Line 44  sub BEGIN {
44                  chomp( my $pwd = `pwd` );                  chomp( my $pwd = `pwd` );
45                  $prefix = "$pwd/$prefix";                  $prefix = "$pwd/$prefix";
46          }          }
47          $prefix =~ s{^(.*)/srv/Sack/[\./]+bin.+$}{$1};          $prefix =~ s{^(.*)/srv/Sack/.+$}{$1};
48          warn "# prefix $prefix";          warn "# prefix $prefix";
49    
50          $SIG{INT} = sub {          $SIG{INT} = sub {
# Line 96  sub send_nodes { Line 96  sub send_nodes {
96          my $header = defined $content ? length($content) : 0;          my $header = defined $content ? length($content) : 0;
97          $header .= ' ' . join(' ', @_) if @_;          $header .= ' ' . join(' ', @_) if @_;
98    
99            warn "# send_nodes ", dump @nodes;
100    
101          foreach my $node ( @nodes ) {          foreach my $node ( @nodes ) {
102    
103                  my $sock = IO::Socket::INET->new(                  my $sock = IO::Socket::INET->new(
104                          PeerAddr => $node,                          PeerAddr => '127.0.0.1',
105                            PeerPort => $node,
106                          Proto    => 'tcp',                          Proto    => 'tcp',
107                  );                  );
108    
109                  if ( ! $sock ) {                  if ( ! $sock ) {
110                          warn "can't connect to $node - $!"; # FIXME die?                          warn "[$port] can't connect to $node - $!\n"; # FIXME die?
111                          next;                          next;
112                  }                  }
113    
# Line 125  sub get_node { Line 128  sub get_node {
128                  return;                  return;
129          }          }
130          chomp( my $size = <$sock> );          chomp( my $size = <$sock> );
131          warn "[$port] <<<< $node $size bytes\n";          warn "[$port] <<<< $node $size bytes\n" if $debug || $size > 1024;
132          my $data;          my $data;
133          read $sock, $data, $size;          read $sock, $data, $size;
134          return $data;          return $data;
# Line 134  sub get_node { Line 137  sub get_node {
137  sub send_sock {  sub send_sock {
138          my ( $sock, $data ) = @_;          my ( $sock, $data ) = @_;
139          my $size   = length $data;          my $size   = length $data;
140          warn "[$port] >>>> ", $sock->peerhost, " $size bytes\n";          warn "[$port] >>>> $size bytes\n" if $debug || $size > 1024;
141          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;
142  }  }
143    
144  sub merge_out {  sub merge_out {
145          my ( $from_node, $new ) = @_;          my ( $from_node, $new ) = @_;
146    
147          warn "### merge $from_node";          my $remote_digest = Sack::Digest->new( port => $from_node );
   
         my $from_port = $from_node;  
         $from_port =~ s{.+:(\d+)$}{$1};  
   
         my $remote_digest = Sack::Digest->new( port => $from_port );  
148          my ( $local, $remote ) = ( 0, 0 );          my ( $local, $remote ) = ( 0, 0 );
149    
150            my $tick = 0;
151            print STDERR "[$port] merge $from_node";
152    
153          foreach my $k1 ( keys %$new ) {          foreach my $k1 ( keys %$new ) {
154    
155                  foreach my $k2 ( keys %{ $new->{$k1} } ) {                  foreach my $k2 ( keys %{ $new->{$k1} } ) {
# Line 158  sub merge_out { Line 159  sub merge_out {
159                          if ( $k1 =~ m{#} ) {                          if ( $k1 =~ m{#} ) {
160                                  die "ASSERT $k1 $k2" unless $k2 =~ m{^\d+$};                                  die "ASSERT $k1 $k2" unless $k2 =~ m{^\d+$};
161  #warn "XXX $k1 $k2";  #warn "XXX $k1 $k2";
162                                  my $md5 = $remote_digest->{nr_md5}->[$k2] || warn "[$port] no2md5 $n not found in $from_port\n";                                  my $md5 = $remote_digest->{nr_md5}->[$k2] || warn "[$port] no2md5 $n not found in $from_node\n";
163                                  if ( my $local_k2 = $digest->{md5_nr}->{$md5} ) {                                  if ( my $local_k2 = $digest->{md5_nr}->{$md5} ) {
164                                          $k2 = $local_k2;                                          $k2 = $local_k2;
165                                          $local++;                                          $local++;
# Line 186  sub merge_out { Line 187  sub merge_out {
187                          } else {                          } else {
188                                  die "can't merge $k2 [$ref] from ",dump($n), " into ", dump($out->{$k1}->{$k2});                                  die "can't merge $k2 [$ref] from ",dump($n), " into ", dump($out->{$k1}->{$k2});
189                          }                          }
190    
191                            if ( $tick++ % 1000 == 0 ) {
192                                    print STDERR ".";
193                            } elsif ( $tick % 10000 == 0 ) {
194                                    print STDERR $tick;
195                            }
196                  }                  }
197          }          }
198    
199          warn "[$port] merge local $local remote $remote from $from_port\n";          warn "$tick $local/$remote\n";
200    
201          warn "## merge out ", dump $out if $debug;          warn "## merge out ", dump $out if $debug;
202  }  }
203    
# Line 238  sub run_code { Line 246  sub run_code {
246                          $o = thaw $o;                          $o = thaw $o;
247                          warn "[$port] merge $node $s bytes\n";                          warn "[$port] merge $node $s bytes\n";
248                          merge_out $node => $o;                          merge_out $node => $o;
249                            report "[$port] merged $node";
250                  }                  }
251          }          }
252  }  }
# Line 366  Sacks Lorry v$VERSION - path: $path offs Line 375  Sacks Lorry v$VERSION - path: $path offs
375  __HELP__  __HELP__
376          } elsif ( $cmd =~ m{^(vi|\\e|o)}i ) {          } elsif ( $cmd =~ m{^(vi|\\e|o)}i ) {
377                  #system "vi out/*";                  #system "vi out/*";
378                    $digest->sync;
379                  system "bin/storableedit.pl", (glob('out/*.storable'))[0];                  system "bin/storableedit.pl", (glob('out/*.storable'))[0];
380          } elsif ( $cmd =~ m{^i(?:nfo)?\s?(.+)?$}i ) {          } elsif ( $cmd =~ m{^i(?:nfo)?\s?(.+)?$}i ) {
381                  info;                  info;
# Line 375  __HELP__ Line 385  __HELP__
385                  exit;                  exit;
386          } elsif ( $cmd =~ m{^(v|r)}i ) {          } elsif ( $cmd =~ m{^(v|r)}i ) {
387                  run_views;                  run_views;
388            } elsif ( $cmd =~ m{^n(ode)?\s*(\d+)}i ) {
389                    push @nodes, $2;
390                    info;
391          } elsif ( $cmd ) {          } elsif ( $cmd ) {
392                  warn "UNKNOWN ", dump $cmd;                  warn "UNKNOWN ", dump $cmd;
393          }          }
Legend:
Removed from v.50  
changed lines
  Added in v.60
  ViewVC Help
Powered by ViewVC 1.1.26