WebDAV Upload Script

gistfile1.pl

#!/usr/local/bin/perl

#use strict;
use utf8;
use HTTP::DAV;
use File::Basename;

my ($dav, $url, $user, $password);

$dav = new HTTP::DAV;

$url = "";
$user = "";
$password = "";

$dav->credentials(-user=>$user, -pass=>$password, -url=>$url);
$dav->open(-url=>$url) or die "Cannot open $url: " . $dav->message . "\n";

reflexiveFile("/pool1/photo");

sub reflexiveFile{

	my $dir = shift;
	my @list = ();

	opendir(DIR, $dir) or die("Can not open directory:$dir ($!)");
	@list = readdir(DIR);
	closedir(DIR);

	foreach my $file (sort @list){
		next if($file =~ /^\.{1,2}$/ || $file eq ".recycle" ||
				$file eq "Thumbs.db" || $file eq "desktop.ini");

		if(-d "$dir/$file"){
			reflexiveFile("$dir/$file");
		}else{
			# サブフォルダのない場合、フォルダを作れない
			$tmp = $dir;
			$tmp =~ s/\/pool1\/photo\///;
			if($olddir ne $tmp){
				if($tmp =~ m/.+\/.+/){
					@list1 = split(/\//, $tmp);
					$path = "";
					foreach $var (@list1){
						$path .= $var ."/";
						davMkdir("$path");
					}
				}
				$olddir = $tmp;
			}

			$filename = basename($file);
			print "Uploading file\n";
			print "  Local  : $dir/$file\n";
			print "  Remote : $url/$tmp/$filename\n";

			$remote_size = davSize("$tmp/$filename");

			$size = -s "$dir/$file";
			if($size == $remote_size){
				print "    Exist File\n";
			}else{
				$btime = time;
				if($dav->put(-local=>"$dir/$file", -url=>"$url/$tmp/")){
					$time = time - $btime;
					$size = $size / 1024;
					$bps  = (($size * 8) / $time);
					printf("    Upload OK(Time: %ds, Size: %.2fKB, Speed: %.2fKbps)\n", $time, $size, $bps)
				}else{
					print "    Upload NG\n";
					print "     $dav->message \n";

					 foreach $err ( $dav->errors ) { print "  Error:$err\n" }
				}
			}

			print "\n";

		}
	}

}

sub davSize{

	my($file) = @_;

	if($r=$dav->propfind( -url=>"$url/$file", -depth=>1)){
		if(!$r->is_collection){
			return $r->get_property("getcontentlength");
		}
	}

}

sub davMkdir{

	my($dir) = @_;

		if($r = $dav->propfind( -url=>"$url/$dir", -depth=>1)){
			print "Exist dir at $url/$dir\n\n";
			return;
		}else{
			$dav->mkcol( -url=>"$url/$dir" ) or die "Couldn't make newdir at $url/$dir\n\n";
		}

		print "Create newdir at $url/$dir\n\n";

}