+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use Data::Dump qw(dump);
+use File::Path qw(make_path);
+
+sub home_dir {
+ my $login = shift;
+ my ( undef, undef, $uid, $gid, undef, undef, $email, $dir, $shell ) = getpwnam $login;
+ return $dir;
+}
+
+sub send_file {
+ my ($job) = @_;
+
+ my $work = $job->arg;
+ chomp $work;
+ warn "# work [$work]\n";
+
+ my ( $from, $to ) = split(/#/,$work,2);
+
+ my $f_dir = home_dir($1) if $from =~ s/~(\w+)//;
+ my $t_dir = home_dir($1) if $to =~ s/~(\w+)//;
+
+ warn "send_file $f_dir $from -> $t_dir $to\n";
+
+ my $t_basedir = $t_dir . $to;
+ $t_basedir =~ s{/[^/]+$}{};
+ make_path $t_basedir unless -d $t_basedir;
+ link $f_dir . $from => $t_dir . $to;
+
+ return "send_file $f_dir $from -> $t_dir $to";
+};
+
+use Gearman::Worker;
+my $worker = Gearman::Worker->new;
+$worker->job_servers('127.0.0.1:4730');
+$worker->register_function( send_file => \&send_file );
+
+warn "$0 pid $$ waitng for jobs\n";
+$worker->work while 1;
+