re-implement send_file as perl script

This allows us to correctly deal with spaces in filenames and dirnames

diff --git a/bin/debian-install.sh b/bin/debian-install.sh
index 687efad..6ef64e5 100755 (executable)
--- a/bin/debian-install.sh
+++ b/bin/debian-install.sh
@@ -1,5 +1,5 @@
 #!/bin/sh -x
 
-sudo apt-get install libautodie-perl libdata-dump-perl libfile-slurp-perl libtime-hires-perl \
+sudo apt-get install libautodie-perl libdata-dump-perl libfile-slurp-perl libtime-hires-perl libgearman-client-perl \
 libjson-xs-perl libmodule-refresh-perl libnss-extrausers libtokyocabinet-perl
 

diff --git a/gearman/send_file.pl b/gearman/send_file.pl
new file mode 100755 (executable)
index 0000000..f9df9ff
--- /dev/null
+++ b/gearman/send_file.pl
@@ -0,0 +1,43 @@
+#!/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;
+