5 use Data::Dump qw(dump);
6 use File::Path qw(make_path remove_tree);
10 my ( undef, undef, $uid, $gid, undef, undef, $email, $dir, $shell ) = getpwnam $login;
15 my $worker = Gearman::Worker->new;
16 $worker->job_servers('127.0.0.1:4730');
18 open(my $log, '>>', '/rsync1/s1/log/send_file.log');
21 $worker->register_function( send_file => sub {
26 warn "# send_file [$work]\n";
28 my ( $from, $to ) = split(/#/,$work,2);
30 my $f_dir = home_dir($1) if $from =~ s/~(\w+)//;
31 my $t_dir = home_dir($1) if $to =~ s/~(\w+)//;
33 warn "send_file $f_dir $from -> $t_dir $to\n";
35 my $t_basedir = $t_dir . $to;
36 $t_basedir =~ s{/[^/]+$}{};
37 make_path $t_basedir unless -d $t_basedir;
38 link $f_dir . $from => $t_dir . $to;
40 print "send#$work#", -s $t_dir.$to, "#$!\n";
42 die "ERROR: $!" if $!;
44 return "send_file $f_dir $from -> $t_dir $to";
48 $worker->register_function( delete => sub {
52 warn "# delete [$work]\n";
54 my $dir = home_dir($1) if $work =~ s/~(\w+)//;
56 my $full = $dir . $work;
59 print "delete_tree#$work\n";
60 warn "remove_tree $full\n";
63 print "delete_file#$work#", -s $full, "\n";
64 warn "unlink $full\n";
76 warn "$0 pid $$ waitng for jobs\n";
77 $worker->work while 1;