/[Search-Estraier]/trunk/scripts/estcp-mt.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/scripts/estcp-mt.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 86 - (hide annotations)
Thu Jan 19 14:33:33 2006 UTC (18 years, 4 months ago) by dpavlin
File MIME type: text/plain
File size: 3044 byte(s)
multi-threaded version of estcp
1 dpavlin 80 #!/usr/bin/perl -w
2    
3     use strict;
4     use Search::Estraier;
5     use URI::Escape qw/uri_escape/;
6 dpavlin 82 use Time::HiRes;
7     use POSIX qw/strftime/;
8 dpavlin 86 use Config;
9     use threads;
10     use Thread::Queue;
11 dpavlin 80
12     =head1 NAME
13    
14     estcp.pl - copy Hyper Estraier index from one node to another
15    
16     =cut
17    
18 dpavlin 86 die "Your perl isn't compiled with support for ithreads\n" unless ($Config{useithreads});
19    
20    
21 dpavlin 80 my ($from,$to) = @ARGV;
22    
23     die "usage: $0 http://localhost:1978/node/from http://remote.example.com:1978/node/to\n" unless ($from && $to);
24    
25     my $debug = 0;
26 dpavlin 83 my $max = 256;
27 dpavlin 80
28     # create and configure node
29     my $from_n = new Search::Estraier::Node(
30     url => $from,
31     croak_on_error => 1,
32     debug => $debug,
33     );
34     my $to_n = new Search::Estraier::Node(
35     url => $to,
36     croak_on_error => 1,
37     debug => $debug,
38     );
39    
40 dpavlin 85 unless(eval{ $to_n->name }) {
41     if ($to =~ m#^(http://.+)/node/(\w+)$#) {
42     my ($url,$name) = ($1,$2);
43     print "Creating '$name' on $url\n";
44     $to_n->shuttle_url( $url . '/master?action=nodeadd',
45     'application/x-www-form-urlencoded',
46     'name=' . uri_escape($name) . '&label=' . uri_escape( $name ),
47     undef,
48     );
49     } else {
50     die "can't extract node name from $to\n";
51     }
52     }
53    
54 dpavlin 86 # total processed elements
55     my $i : shared = 1;
56 dpavlin 80
57 dpavlin 86 my $q_id = Thread::Queue->new;
58     my $q_drafts = Thread::Queue->new;
59    
60     my $get_thr = threads->new( sub {
61     while (my $id = $q_id->dequeue) {
62     print STDERR "get_thr, id: $id\n" if ($debug);
63     my $doc_draft = $from_n->_fetch_doc( id => $id, chomp_resbody => 1 );
64     $q_drafts->enqueue( $doc_draft );
65     }
66     } );
67    
68     my $t = time();
69     my $t_refresh = time();
70 dpavlin 82 my $doc_num = $from_n->doc_num || 1;
71 dpavlin 80
72 dpavlin 86 my $put_thr = threads->new( sub {
73     while (my $doc_draft = $q_drafts->dequeue) {
74     print STDERR "put_thr, $doc_draft\n" if ($debug);
75     $to_n->shuttle_url( $to_n->{url} . '/put_doc', 'text/x-estraier-draft', $doc_draft, undef) == 200 or die "can't insert $doc_draft\n";
76    
77     $i++;
78     if (time() - $t_refresh > 3) {
79     my $rate = ( $i / ((time() - $t) || 1) );
80     printf("%d records, %1.2f%% [%1.2f rec/s] estimated finish: %s\n",
81     $i,
82     ($i * 100 / $doc_num),
83     $rate,
84     strftime("%Y-%m-%d %H:%M:%S", localtime( time() + int(($doc_num-$i) / $rate))),
85     );
86     $t_refresh = time();
87     }
88    
89     }
90     } );
91    
92     print "Copy from ",$from_n->name," (",$from_n->label,") to ",$to_n->name," (",$to_n->label,") - ",$from_n->doc_num," documents (",$from_n->word_num," words, ",$from_n->size," bytes)\n";
93    
94 dpavlin 80 my $prev;
95 dpavlin 83 my $more = 1;
96 dpavlin 80
97 dpavlin 83 while($more) {
98     my $res;
99 dpavlin 80 $from_n->shuttle_url( $from_n->{url} . '/list',
100     'application/x-www-form-urlencoded',
101 dpavlin 83 'max=' . $max . ( $prev ? '&prev=' . uri_escape( $prev ) : '' ),
102 dpavlin 80 \$res,
103     );
104 dpavlin 83 if (! $res || $res eq '') {
105     $more = 0;
106     last;
107     }
108 dpavlin 80 foreach my $l (split(/\n/,$res)) {
109     (my $id, $prev) = split(/\t/,$l, 2);
110 dpavlin 84
111     #$to_n->put_doc( $from_n->get_doc( $id ));
112    
113 dpavlin 86 #my $doc_draft = $from_n->_fetch_doc( id => $id, chomp_resbody => 1 );
114     #$to_n->shuttle_url( $to_n->{url} . '/put_doc', 'text/x-estraier-draft', $doc_draft, undef) == 200 or die "can't insert $doc_draft\n";
115 dpavlin 84
116 dpavlin 86 $q_id->enqueue( $id );
117 dpavlin 80 }
118 dpavlin 82 warn "$prev\n";
119    
120 dpavlin 83 }
121 dpavlin 80
122 dpavlin 86 $get_thr->join;
123     $put_thr->join;
124    
125 dpavlin 83 print "Copy completed.\n";
126    

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26