Add a simple multithreaded uploader.
[pr0n] / perl / pr0n-upload.pl
1 #! /usr/bin/perl
2
3 #
4 # Small multithreaded pr0n uploader, based partially on dave from HTTP::DAV.
5 # Use like
6 #
7 #   pr0n-upload.pl http://pr0n.sesse.net/webdav/upload/random/ *.JPG
8 #
9 # Adjust $threads to your own liking.
10 #
11
12 use strict;
13 use warnings;
14 use HTTP::DAV;
15 use threads;
16 use Thread::Queue;
17
18 my $threads = 16;
19 my $running_threads :shared = 0;
20 my $queue :shared = Thread::Queue->new;
21
22 # Enqueue all the images.
23 my $url = shift @ARGV;
24 $queue->enqueue(@ARGV);
25
26 # Fetch username and password, and check that they actually work.
27 my ($user, $pass) = get_credentials();
28 my $dav = init_dav($url, $user, $pass);
29 my $r = $dav->propfind(-url => $url, -depth => 0);
30 if ($r == 0) {
31         die "Couldn't open $url: " . $dav->message . "\n";
32 }
33
34 # Fire up the worker threads, and wait for them to finish.
35 my @threads = ();
36 for my $i (1..$threads) {
37         push @threads, threads->create(\&upload_thread);
38 }
39 while ($running_threads > 0) {
40         printf "%d threads running, %d images queued\n", $running_threads, $queue->pending;
41         sleep 1;
42 }
43 for my $thread (@threads) {
44         $thread->join();
45 }
46
47 sub upload_thread {
48         $running_threads++;
49
50         my $dav = init_dav($url, $user, $pass);
51         while (my $filename = $queue->dequeue_nb) {
52                 $dav->put(-local => $filename, -url => $url)
53                         or warn "Couldn't upload $filename: " . $dav->message . "\n";
54         }
55         
56         $running_threads--;
57 }
58
59 sub init_dav {
60         my ($url, $user, $pass) = @_;
61         my $ua = HTTP::DAV::UserAgent->new();
62         $ua->agent('pr0n-uploader/v1.0 (perldav)');
63         my $dav = HTTP::DAV->new(-useragent=>$ua);
64         $dav->credentials(-user=>$user, -pass=>$pass, -url=>$url);
65         $dav->open(-url => $url)
66                 or die "Couldn't open $url: " . $dav->message . "\n";
67         return $dav;
68 }
69
70 sub get_credentials {
71         print "\nEnter username for $url: ";
72         chomp (my $user = <STDIN>);
73         exit if (!defined($user));
74         print "Password: ";
75         system("stty -echo");
76         chomp (my $pass = <STDIN>);
77         system("stty echo");
78         print "\n";
79
80         return ($user, $pass);
81 }