X-Git-Url: https://git.sesse.net/?p=pr0n;a=blobdiff_plain;f=perl%2Fpr0n-upload.pl;fp=perl%2Fpr0n-upload.pl;h=6d5aacc9d898039e8cf8e0c731ba5bc6075d2b2c;hp=0000000000000000000000000000000000000000;hb=773d6cc9629e119b2bdc0ea8849aefccc29ffc8b;hpb=d5656c57d0f9cf32eb61652e49c5b6811e432158

diff --git a/perl/pr0n-upload.pl b/perl/pr0n-upload.pl
new file mode 100755
index 0000000..6d5aacc
--- /dev/null
+++ b/perl/pr0n-upload.pl
@@ -0,0 +1,81 @@
+#! /usr/bin/perl
+
+#
+# Small multithreaded pr0n uploader, based partially on dave from HTTP::DAV.
+# Use like
+#
+#   pr0n-upload.pl http://pr0n.sesse.net/webdav/upload/random/ *.JPG
+#
+# Adjust $threads to your own liking.
+#
+
+use strict;
+use warnings;
+use HTTP::DAV;
+use threads;
+use Thread::Queue;
+
+my $threads = 16;
+my $running_threads :shared = 0;
+my $queue :shared = Thread::Queue->new;
+
+# Enqueue all the images.
+my $url = shift @ARGV;
+$queue->enqueue(@ARGV);
+
+# Fetch username and password, and check that they actually work.
+my ($user, $pass) = get_credentials();
+my $dav = init_dav($url, $user, $pass);
+my $r = $dav->propfind(-url => $url, -depth => 0);
+if ($r == 0) {
+	die "Couldn't open $url: " . $dav->message . "\n";
+}
+
+# Fire up the worker threads, and wait for them to finish.
+my @threads = ();
+for my $i (1..$threads) {
+	push @threads, threads->create(\&upload_thread);
+}
+while ($running_threads > 0) {
+	printf "%d threads running, %d images queued\n", $running_threads, $queue->pending;
+	sleep 1;
+}
+for my $thread (@threads) {
+	$thread->join();
+}
+
+sub upload_thread {
+	$running_threads++;
+
+	my $dav = init_dav($url, $user, $pass);
+	while (my $filename = $queue->dequeue_nb) {
+		$dav->put(-local => $filename, -url => $url)
+			or warn "Couldn't upload $filename: " . $dav->message . "\n";
+	}
+	
+	$running_threads--;
+}
+
+sub init_dav {
+	my ($url, $user, $pass) = @_;
+	my $ua = HTTP::DAV::UserAgent->new();
+	$ua->agent('pr0n-uploader/v1.0 (perldav)');
+	my $dav = HTTP::DAV->new(-useragent=>$ua);
+	$dav->credentials(-user=>$user, -pass=>$pass, -url=>$url);
+	$dav->open(-url => $url)
+		or die "Couldn't open $url: " . $dav->message . "\n";
+	return $dav;
+}
+
+sub get_credentials {
+	print "\nEnter username for $url: ";
+	chomp (my $user = <STDIN>);
+	exit if (!defined($user));
+	print "Password: ";
+	system("stty -echo");
+	chomp (my $pass = <STDIN>);
+	system("stty echo");
+	print "\n";
+
+	return ($user, $pass);
+}