]> git.sesse.net Git - pr0n/blob - perl/pr0n-upload.pl
Remove burned-in infoboxes. Turn infobox always on in fullscreen mode (for now).
[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 = 40;
19 my $running_threads :shared = 0;
20 my $queue :shared = Thread::Queue->new;
21 my @succeeded :shared = ();
22 my @failed :shared = ();
23
24 # Enqueue all the images.
25 my $url = shift @ARGV;
26 $queue->enqueue(@ARGV);
27
28 # Fetch username and password, and check that they actually work.
29 my ($user, $pass) = get_credentials();
30 my $dav = init_dav($url, $user, $pass);
31
32 # Fire up the worker threads, and wait for them to finish.
33 my @threads = ();
34 for my $i (1..$threads) {
35         push @threads, threads->create(\&upload_thread);
36 }
37 while ($running_threads > 0) {
38         printf "%d threads running, %d images queued\n", $running_threads, $queue->pending;
39         sleep 1;
40 }
41 for my $thread (@threads) {
42         $thread->join();
43 }
44
45 if (scalar @failed != 0 && scalar @succeeded != 0) {
46         # Output failed files in an easily-pastable format.
47         print "\nFailed files: ", join(' ', @failed), "\n";
48 }
49
50 sub upload_thread {
51         $running_threads++;
52
53         my $dav = init_dav($url, $user, $pass);
54         while (my $filename = $queue->dequeue_nb) {
55                 if ($dav->put(-local => $filename, -url => $url)) {
56                         push @succeeded, $filename;
57                 } else {
58                         push @failed, $filename;
59                         warn "Couldn't upload $filename: " . $dav->message . "\n";
60                 }
61         }
62         
63         $running_threads--;
64 }
65
66 sub init_dav {
67         my ($url, $user, $pass) = @_;
68         my $ua = HTTP::DAV::UserAgent->new();
69         $ua->agent('pr0n-uploader/v1.0 (perldav)');
70         my $dav = HTTP::DAV->new(-useragent=>$ua);
71         $dav->credentials(-user=>$user, -pass=>$pass, -url=>$url, -realm=>'pr0n.sesse.net');
72         $dav->open(-url => $url)
73                 or die "Couldn't open $url: " . $dav->message . "\n";
74         return $dav;
75 }
76
77 sub get_credentials {
78         print "\nEnter username for $url: ";
79         chomp (my $user = <STDIN>);
80         exit if (!defined($user));
81         print "Password: ";
82         system("stty -echo");
83         chomp (my $pass = <STDIN>);
84         system("stty echo");
85         print "\n";
86
87         return ($user, $pass);
88 }