gearman/send_file.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4
   5 use Data::Dump qw(dump);
   6 use File::Path qw(make_path);
   7
   8 sub home_dir {
   9         my $login = shift;
  10         my ( undef, undef, $uid, $gid, undef, undef, $email, $dir, $shell ) = getpwnam $login;
  11         return $dir;
  12 }
  13
  14 sub send_file {
  15         my ($job) = @_;
  16
  17         my $work = $job->arg;
  18         chomp $work;
  19         warn "# work [$work]\n";
  20
  21         my ( $from, $to ) = split(/#/,$work,2);
  22
  23         my $f_dir = home_dir($1) if $from =~ s/~(\w+)//;
  24         my $t_dir = home_dir($1) if $to   =~ s/~(\w+)//;
  25
  26         warn "send_file $f_dir $from -> $t_dir $to\n";
  27
  28         my $t_basedir = $t_dir . $to;
  29         $t_basedir =~ s{/[^/]+$}{};
  30         make_path $t_basedir unless -d $t_basedir;
  31         link $f_dir . $from => $t_dir . $to;
  32
  33         return "send_file $f_dir $from -> $t_dir $to";
  34 };
  35
  36 use Gearman::Worker;
  37 my $worker = Gearman::Worker->new;
  38 $worker->job_servers('127.0.0.1:4730');
  39 $worker->register_function( send_file => \&send_file );
  40
  41 warn "$0 pid $$ waitng for jobs\n";
  42 $worker->work while 1;
  43