#!/usr/bin/perl
use strict;
use File::Basename;
use Fcntl;
use IO::File;
use Cwd;
use File::Copy;

STDOUT->autoflush(1);
STDERR->autoflush(1);

package main;

my $debug = $ENV{DEBUG};
sub qprint{return if ($ENV{QUIET});     print STDERR @_;}
sub qprintf{return if ($ENV{QUIET});     printf STDERR @_;}
sub dprint{return if (!$debug);     print STDERR @_;}
sub dprint1{return if ($debug < 1); print STDERR @_;}
sub dprint2{return if ($debug < 2); print STDERR @_;}
sub dprint3{return if ($debug < 3); print STDERR @_;}
sub dprint4{return if ($debug < 4); print STDERR @_;}
sub dprint5{return if ($debug < 5); print STDERR @_;}

sub dprintf{return if (!$debug); printf STDERR @_;}
sub dprintf1{return if ($debug < 1); printf STDERR @_;}
sub dprintf2{return if ($debug < 2); printf STDERR @_;}
sub dprintf3{return if ($debug < 3); printf STDERR @_;}
sub dprintf4{return if ($debug < 4); printf STDERR @_;}
sub dprintf5{return if ($debug < 5); printf STDERR @_;}

sub cat_file
{
	my $filename = shift;;
	my $contents;
	my $line;
	open FILE, "< $filename";
	while ($line = <FILE>) {
		$contents .= $line;
	}
	close FILE;
	return $contents;
}

sub cat_file_into_array
{
	my $filename = shift;;
	my $nr_lines = shift;
	my @contents;
	my $line;
	open FILE, "< $filename";
	while ($line = <FILE>) {
		chomp $line;
		push @contents, $line;
		last if defined $nr_lines && --$nr_lines <= 0;
	}
	close FILE;
	return @contents;
}

sub tail_1
{
	my $file = shift;
	my @array = cat_file_into_array($file);
	return $array[-1];
}

sub parent_dirs
{
        (my $dir) = @_;
        my @res;
        # just like dirname(1), if the arg ends in /
        # then count it.
        if ($dir =~ s/\/$//) {
                push @res, $dir;
        }
        while (length($dir) && $dir ne "/" && $dir ne ".") {
                $dir = dirname($dir);
                push @res, $dir;
        }
        return @res;
}
sub mkdir_or_die
{
	my $dir = shift;
	my $res = 1;
	if (! -d $dir) {
		if (!($res = mkdir $dir)) {
			die "error: $! '$dir'";
		}
	}
	return $res;
}

sub mkdir_p
{
	my $dir = shift;
	my $pdir;
	if ($dir !~ /\/$/) {
		$dir .= "/";
	}
	my @pdirs = reverse(parent_dirs($dir));
	for $pdir (@pdirs) {
		mkdir_or_die($pdir);
	}
}

sub dirpart
{
	my $foo = shift;
	$foo =~ s/(.*\/).*/$1/;
	return $foo;
}

sub file_has_line
{
	my $filename = shift;
	my $pattern = shift;

	open(FILE, "< $filename");
	while (my $line = <FILE>) {
		chomp $line;
		if ($line eq $pattern) {
			return 1;
		}
	}
	close FILE;
	return 0;
}
sub file_append_line
{
	my $filename = shift;
	my $line = shift;

	open(FILE, ">> $filename");
	print FILE $line."\n";
	close FILE;
}
sub file_append_null_string
{
	my $filename = shift;
	my $line = shift;

	open(FILE, ">> $filename");
	print FILE $line."\0";
	close FILE;
}
sub file_read_one_line
{
	my $filename = shift;
	open(FILE, "< $filename");
	my $line = <FILE>;
	chomp $line;
	return $line;
}
sub file_shift_line
{
	my $filename = shift;
	my $tmpfile = $filename.".tmp";
	open(FILE, "< $filename");
	open(TMPFILE, "> $tmpfile");
	my $line = <FILE>;
	while ($line = <FILE>) {
		print TMPFILE $line;
	}
	close FILE;
	close TMPFILE;
	rename $tmpfile, $filename;
	return $line;
}

sub append_to_file
{
        my $stuff = shift;
        my $file = shift;
        open FILE, ">> $file";
        print FILE $stuff;
        close FILE;
}
sub cat_into_file
{
        my $stuff = shift;
        my $file = shift;
        if ( -e "$file" ) {
                die "exists: $file";
        }
        open FILE, "> $file";
        print FILE $stuff;
        close FILE;
}

sub cat_into_existing_file
{
        my $stuff = shift;
        my $file = shift;
        open FILE, "> $file";
        print FILE $stuff;
        close FILE;
}

sub resolve_symlink
{
	my $file = shift;
	my $depth = shift;
	return undef if ($depth > 20);
	return $file if ! -l $file;
	my $target = readlink($file);
	# for relative path symlinks, make sure you
	# use the link's contex
	if ($target !~ /^\//) {
		$target = dirname($file)."/".$target;
	}
	return resolve_symlink($target, $depth+1);
}

eval "use File::ExtAttr ':all';";

sub fs_type
{
	my $path = shift;
	eval 'use Filesys::Statvfs' || 
		die "unable to get fs_type";
	#eval 'use Filesys::DiskSpace;' ||
	#  return undef;
	my $opath = $path;

	if (-f $path) {
		$path = dirname($path);
	}
	dprintf2 "path: '$path' cwd: '%s'\n", getcwd();
	# df is retarded.  If you pass '0' to it, it pukes
	# So, don't pass '0'.  append a little dir.
	if ($path !~ /^\//) {
		$path = "./".$path;
	}
        my($bsize, $frsize, $blocks, $bfree, $bavail,
	    $files, $ffree, $favail, $fsid, $basetype, $flag,
	    $namemax, $fstr) = statvfs($path);
			      
	dprintf4("fs_type() ret: (%s)\n", $fsid);
	return $fsid;
}

sub has_xattr_support
{
	my $f = shift;
	my $ret = 1;
	my $type = fs_type($f);
	if ($type == 0x4d44 || $type == 0x1006) {
		$ret = 0;
	}
	dprintf5 "has_xattr_support('$f') type: %04x ret: %s\n", $type, $ret;
	return $ret;
}

sub get_xattr_file
{
	my $f = shift;
	$f = resolve_symlink($f);
	dprintf4 "get_xattr_file('$f')\n";
	if (has_xattr_support($f)) {
		return $f;
	}
	my $proxy = $ENV{HOME}."/.perl-xattr-cache/".$f;
	mkdir_p(dirname($proxy));
	if (! -e $proxy) {
		cat_into_file($f, $proxy);
	}
	return $proxy;
}

sub setufattr
{
	my ($file, $attr, $val) = @_;
	return undef if (! -e $file);
	$file = get_xattr_file($file);
	if (!length($val)) {
		die "empty value for '$attr': '$val'\n";
	}
	my $ret = setfattr($file, 'user.'.$attr, $val);
	if (!defined $ret || !$ret) {
		printf STDERR "failed ($ret): setfattr('%s', '%s', '%s')\n", $file, 'user.'.$attr, $val;
		printf STDERR "Val len: %d\n", length($val);
		print STDERR $!."\n";
		return undef;
	}
	return 0;
}
sub delufattr
{
	my ($file, $attr) = @_;
	return undef if (! -e $file);
	$file = get_xattr_file($file);
	delfattr($file, 'user.'.$attr);
}

my $XATTR_MAX_LEN = 16;
my $XATTR_CREATE  =  0x1; # set value, fail if attr already exists
my $XATTR_REPLACE =  0x2; # set value, fail if attr does not exist

my $SYS_getxattr = -1;
my $SYS_setxattr = -1;

my $arch_set = 0;
sub dave_set_arch
{
	return if $arch_set;
	use Config;
	if ($Config{myarchname} eq "i386-linux") {
		$SYS_getxattr = 229;
		$SYS_setxattr = 226;
		$arch_set = 1;
	} elsif ($Config{myarchname} eq "x86_64-linux") {
		$SYS_getxattr = 191;
		$SYS_setxattr = 188;
		$arch_set = 1;
	} else {
		die "unknown arch: " . $Config{myarchname};
	}
}

sub pad
{
	my $len = shift;
	return sprintf "%".$len."s";
}

sub xattr_syscall
{
	dave_set_arch();
	my $call = shift;
	my $file = shift;
	my $attr_name = shift;
	my $attr_val_ref = shift;
	# 0 flags means create or replace
	my $flags = 0;
	my @extra = ();
	push @extra, $flags if ($call == $SYS_setxattr);
	$!=0;
	my $ret = syscall($call, $file, $attr_name, $$attr_val_ref, length($$attr_val_ref), @extra);
	dprintf4("ret: %d\n", $ret);
	dprintf4("'%s' '%s': '%s'\n", $file, $attr_name, $$attr_val_ref);
	return $ret if ($ret < 0);
	$$attr_val_ref = substr($$attr_val_ref, 0, $ret) if ($call == $SYS_getxattr);
	return $ret;
}

sub getfattr
{
	my ($file, $attr) = @_;
	my $val = pad($XATTR_MAX_LEN);
	my $ret = xattr_syscall($SYS_getxattr, $file, $attr, \$val);
	dprintf3("getfattr() got back: ret: %d, attr: '%s'\n", $ret, $val);
	return undef if ($ret < 0);
	return $val;
}

sub setfattr
{
	my ($file, $attr, $val) = @_;
	$val = "".$val;
	my $ret = xattr_syscall($SYS_setxattr, $file, $attr, \$val);
	dprintf3("setfattr() got back: ret: %d, attr: '%s'\n", $ret, $val);
	warn "unable to set xattr on '$file': $!" if $ret < 0;
	return undef if ($ret < 0);
	return length($val);
}

sub getufattr
{
	my ($file, $attr) = @_;
	return undef if (! -e $file);
	$file = get_xattr_file($file);
	my $ret = getfattr($file, 'user.'.$attr);
	dprintf4 "getufattr('$file', '$attr') ret: %d \!: %s\n", $!;
	return $ret;
}

sub del_dated_ufattr
{
	my ($file, $attr, $val) = @_;
        delufattr($file, $attr);
        delufattr($file, $attr.'.mtime');
}

sub set_dated_ufattr
{
	my ($file, $attr, $val) = @_;
        setufattr($file, $attr, $val);
        setufattr($file, $attr.'.mtime', time());
}

sub get_dated_ufattr
{
	my ($file, $attr) = @_;
        my $attr_age = getufattr($file, $attr.".mtime");
	return undef if (!defined $attr_age);

	if (filemtime($file) > $attr_age) {
		delufattr($file, $attr);
        	delufattr($file, $attr.".mtime");
		return undef;
	}
        return getufattr($file, $attr);
}


my $md5_sum_dave;

sub init_md5
{
	my $inited = eval "use MD5; 1;";
	die "unable to use MD5" if (!defined $inited);
	$md5_sum_dave = new MD5; 
}

sub get_md5_of_string
{
	init_md5();
	my $string = shift;
	my $sum = new MD5; 
	$sum->reset();
        $sum->add($string);
        return $sum->hexdigest;
}
my %md5_cache;
sub raw_get_md5
{
	my $file = shift;
	init_md5();
	$md5_sum_dave->reset();
	if (!(-f $file && -r $file && open(FILE, "<", $file))) {
		print STDERR "__get_md5(): error opening '$file' for read\n";
		return undef;
	}
	my $fh = *FILE;
	$md5_sum_dave->addfile($fh);
        my $digest = $md5_sum_dave->hexdigest;
	close FILE;
	return $digest;
}
sub __get_md5
{
	init_md5();
	my $file = shift;
	if (defined $md5_cache{$file}) {
		return $md5_cache{$file};
	}
	my $digest = getufattr($file, 'md5');
	if (defined $digest) {
		return $digest;
	}
	$digest = raw_get_md5($file);
	setufattr($file, 'md5', $digest);
	$md5_cache{$file} = $digest;
	return $digest;
}
sub get_md5
{
	my $filename = shift;
	if (-d $filename) {
		return undef;
	}
	if ($filename =~ /\.md5cache/) {
		return undef;
	}
	my $md5 = __get_md5($filename);
	if ($md5) {
		cache_md5($filename,$md5);
	}
	return $md5;
}

sub samesum
{
	my $a = shift;
	my $b = shift;
	my $asum = get_md5($a);
	my $bsum = get_md5($b);
	if ($asum && $bsum && ($asum eq $bsum)) {
		return 1;
	}
	return 0;
}

sub same_md5_exists_here
{
	my $file = shift;
	my $dir = shift;
        my $link_name = $dir."/".get_md5_cache_path(__get_md5($file));
        check_cache_link($link_name);
        if (-e $link_name) {
		return readlink($link_name);
	}
	return undef;
}


sub min
{
	if ($_[0] < $_[1]) {
		return $_[0];
	}
	return $_[1];
}

sub max
{
	if ($_[0] > $_[1]) {
		return $_[0];
	}
	return $_[1];
}

sub samefile
{
	my ($f1, $f2) = @_;
	my ($f1dev,$f1ino) = stat($f1);
	my ($f2dev,$f2ino) = stat($f2);
	if ($f1dev == $f2dev && $f1ino == $f2ino) {
		return 1;
	}
	return 0;
}

sub filesize
{
	my ($file) = @_;
	if (-l $file) {
		dprintf3 "symlink: $file\n";
	 	my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
		     $atime,$mtime,$ctime,$blksize,$blocks) = lstat($file);
        	return $size;
	}
	return -s $file;
}

sub filemtime
{
	my ($file) = @_;
	my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	    $atime,$mtime,$ctime,$blksize,$blocks) = stat($file);
	return $mtime
}

sub file_hard_links
{
	my ($file) = @_;
	my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	    $atime,$mtime,$ctime,$blksize,$blocks) = stat($file);
	return $nlink;
}

sub file_ino_dev
{
	my ($file) = @_;
	my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	    $atime,$mtime,$ctime,$blksize,$blocks) = stat($file);
	return $ino.".".$dev;
}

sub __ls
{
        my $dir = shift;
        if (! -d $dir) {
                die "not a directory: '$dir'";
        }
        my $ret = opendir (DIR, $dir);
      	if (!$ret) {
		warn "Error opening directory $dir : $!\n";
		return undef;
	}
        my @f = readdir(DIR);
        #map { $_ = $db_dir."/".$_ } @f;
        closedir (DIR) || die "Error closing directory $dir : $!\n";
        return @f
}

sub ls
{
	my @ret;
	foreach my $ent (@_) {
		push @ret, __ls($ent);
	}
	return @ret;
}

sub ls_nodot
{
	my @ret;
	foreach my $ent (ls(@_)) {
		next if special_dir($ent);
		push @ret, $ent;
	}
	return @ret;
}

sub special_dir
{
	my $dir = shift;
 	return 1 if ($dir eq "." || $dir eq "..");
	return 0;
}

sub __findfiles
{
	my $symlinks = shift;
	my @dirs = @_;
	my @res;
	if ($symlinks > 5) {
		warn "too many levels of symbolic links";
		return undef;
	}
	foreach my $dir (@dirs) {
		#strip trailing slashes to keep it neat
		$dir =~ s'/$'';
		if (-f $dir) {
			push @res, $dir;
			next;
		}
		foreach my $dirent (ls $dir) {
			next if special_dir($dirent);
			next if !defined $dirent;
			my $fullname = $dir.'/'.$dirent;
			if (! -d $fullname) {
				push @res, $fullname;
			} else {
				$symlinks++ if -l $fullname;
				push @res, __findfiles($symlinks, $fullname);
				$symlinks-- if -l $fullname;
			}
		}
	}
	return @res;
}

sub findfiles
{
	return __findfiles(0, @_);
}

sub finddirs
{
	my @dirs = @_;
	my @res;
	foreach my $dir (@dirs) {
		foreach my $dirent (ls $dir) {
			next if ($dirent eq "." || $dirent eq "..");
			my $fullname = $dir.'/'.$dirent;
			if (! -d $fullname) {
				push @res, $fullname;
				push @res, findfiles($fullname);
			}
		}
	}
	return @res;
}

sub get_cached_dirsize
{
	my $dir = shift;
	my $cached_size = getufattr($dir, "du");
	return undef if ! defined $cached_size;
	my $cached_size_timestamp = getufattr($dir, "du.mtime");
	if ($cached_size_timestamp < filemtime($dir)) {
		return undef;
	}
	return $cached_size;
}

sub __du_dir
{
	my $du_visited_hash = shift;
	my $dir = shift;

	if (-l $dir) {
		return 0;
	}
	my $cached_res = get_cached_dirsize($dir);
	if (defined $cached_res) {
		return $cached_res;
	}
	my $start_mtime = time();

	use Cwd;
	my $olddir = fastgetcwd;
	my @entries = ls($dir);
	chdir $dir;
	my $res = __du($du_visited_hash, @entries);
	chdir $olddir;
	setufattr($dir, "du", $res);
	setufattr($dir, "du.mtime", $start_mtime);
	my $full_path = fastgetcwd()."/".$dir;
	if (length($full_path) > 80) {
		my $len = length($full_path);
		$full_path = "...".substr($full_path, $len-80, $len);
	}
	printf STDERR "duing: '%s'\r", $full_path;
	return $res;
}

sub __du
{
	my $du_visited_hash = shift;
	my @arg = @_;
	my $res = 0;
	foreach my $dirent (@arg) {
		next if ($dirent eq ".." || $dirent eq ".");
		next if -l $dirent;
		
		if (! -d $dirent) {
			$res += filesize($dirent);
		} else {
			my $dir_ident = file_ino_dev($dirent);
			if (defined $du_visited_hash->{$dir_ident}) {
				printf "recursive directories: '%s' '%s'\n",
					$dirent, $du_visited_hash->{$dir_ident};
				next;
			}
			use Cwd;
			my $full_path = fastgetcwd()."/".$dirent;
			#printf STDERR "duing: '%s'\r", substr($full_path, 0, 80);
			$du_visited_hash->{$dir_ident} = $full_path;
			$res += __du_dir($du_visited_hash, $dirent);
		}
	}
	return $res;
}

sub du
{
	my %du_visited_hash;
	return __du(\%du_visited_hash, @_);
}

sub sizeprint
{
	my $size = shift;
	return sprintf "%7d KB", $size/1024;
	if ($size < 1<<10) {
		return sprintf "%3d B", $size;
	} elsif ($size < 1<<20) {
		return sprintf "%3d KB", $size>>10;
	} elsif ($size < 1<<30) {
		return sprintf "%3d MB", $size>>20;
	} 
	return sprintf "%3d GB", $size;
}
sub get_md5_cache_path
{
	my $md5 = shift;
	my $part1 = substr($md5,0,2);
	my $part2 = substr($md5,2,2);
	my $dir = sprintf ".md5cache/%s/%s", $part1, $part2;
 	my $link_name = $dir."/".$md5;
	return $link_name;
}

sub unique
{
	my @list = @_;
	my %tmphash;
	my @ret;
	for (my $i = 0; $i < scalar @list; $i++) {
		next if defined $tmphash{$list[$i]};
		$tmphash{$list[$i]} = 1;
		push @ret, $list[$i];
	}
	return @ret;
}

sub check_cache_link
{
	my $link_name = shift;
	my $target = readlink($link_name);
	if (-e $link_name && !defined $target) {
		unlink $link_name;
	}
}
sub cache_md5
{
	return;
	my $filename = shift;
	my $md5 = shift;
	my $link_name = dirpart($filename)."/".get_md5_cache_path($md5);
	check_cache_link($link_name);
	if (-e $link_name) {
		my $target = readlink($link_name);
		if (!samefile($target, $filename)) {
			use Carp;
			croak "duplicate md5 $filename $target $md5\n";
		}
	}
	mkdir_p(dirpart($link_name));
	symlink $filename,$link_name;
}

sub unique_rename
{	
	(my $orig, my $orig_new) = @_;
	my $new = $orig_new;
	my $collision_number = 0;
	while (-e $new) {
		$collision_number++;
		(my $fname,my $fpath) = fileparse($orig_new);
		$new = "$fpath/rename-collide.$collision_number.$fname";
	}
	my $bexist = (-e $new);
	my $boexist = (-e $orig);
	my $res = rename $orig, $new;
	if ($res < 0 || $res > 1) {
		my $exist = (-e $new);
		my $oexist = (-e $orig);
		print STDERR "rename $orig -> $new failed: $res exist: $exist:$bexist orig exist: $oexist:$boexist\n";
	}
	return $res;
}

sub fileext
{
	my $file = shift;
	$file =~ s/.*\.//;
	return $file;
}

sub mv_file
{
	my $file = shift;
	my $dir = shift;
	my $dest = $dir."/".basename($file);
	my $ret = unique_rename($file, $dest);
	die "mv_file error($ret): $!" if ($ret < 0);
}

my $cpf_count = 0;
sub cp_file
{
	my $src = shift;
	my $dst = shift;
	open SRC, "< $src" or die "cp_file('".$src."') src: $!";
	open DST, "> $dst" or die "cp_file('".$dst."') dst: $!";
	my $ret;
	my $buf;
	while ($ret = read(SRC, $buf, 65536)) {
		print DST $buf;
	}
	if (!defined $ret) {
		die "cp_file(): error reading from '$src': $!";
	}
	close SRC;
	close DST;
	return $ret;
}

my $sha1_sum_dave = new Digest::SHA1; 
my %sha1_cache;
sub get_sha1
{
	use Digest::SHA1;
	my $file = shift;
	if (defined $sha1_cache{$file}) {
		return $sha1_cache{$file};
	}
	my $digest = getufattr($file, 'sha1');
	if (defined $digest) {
		return $digest;
	}
	$sha1_sum_dave->reset();
	if (!(-f $file && -r $file && open(FILE, "<$file"))) {
		print STDERR "error opening $file for read\n";
		return undef;
	}
	my $fh = *FILE;
	$sha1_sum_dave->addfile($fh);
        $digest = $sha1_sum_dave->hexdigest;
	close FILE;
	setufattr($file, 'sha1', $digest);
	$sha1_cache{$file} = $digest;
	return $digest;
}

my $exif;
sub init_exif
{
	return $exif if defined $exif;

	# This works on older versions, but newer ones
	# seem to need the qw() part
	# eval 'use Image::ExifTool;'

        eval 'use Image::ExifTool qw(:Public);';

	my $exif = new Image::ExifTool;
	return $exif;
}

# some things return 'TagsInStudlyCaps'
# We prefer 'them_like_this' inside of
# album
sub fixup_exif_key
{
	my $key = shift;
	my $orig = $key;
	$key =~ s/([a-z])([A-Z])/$1_$2/g;
	$key = lc($key);
	return $key;
}

sub __fetch_exif
{
	my $pic = shift;
	init_exif() || die "unable to load Image::ExifTool";

	#use Image::Info qw(image_info dim);
	#my $exif = image_info($pic);#ImageInfo($pic);

	my $exif = ImageInfo($pic);
	# this is more than just exif information, but that's OK
	my $fixed_up;
	foreach my $key (sort keys %$exif) {
		my $newkey = fixup_exif_key($key);
		my $val = $exif->{$key};
		if ($newkey eq 'error') {
			return undef;
		}
		$fixed_up->{$newkey} = $val;
	}
	return $fixed_up;
}

sub my_gzip
{
	use warnings;
	my $in = shift;
	eval 'use Compress::Raw::Zlib' || die "cant find zlib";
	my $gzip_obj = new Compress::Raw::Zlib::Deflate(-AppendOutput => 1);
	my $out = '';
	my $status = $gzip_obj->deflate($in, $out);
	$status = $gzip_obj->flush($out);
	dprintf2("gzip (%d/%d) in/output len: %d/%d '%s'\n",
		$status, eval 'Z_OK',
		length($in), length($out),
		$gzip_obj->msg());
	die "bad output len" if length($out) < 10;
	dprintf3 "out: len %d\n", length($out);
	return $out;
}

sub my_gunzip
{
	my $in = shift;
	my $out;
	eval 'use Compress::Raw::Zlib' || die "cant find zlib";
	my $gunzip_obj = new Compress::Raw::Zlib::Inflate();
	dprintf3("gunzip input len: %d\n", length($in));
	my $status = $gunzip_obj->inflate($in, $out);
	if ($status != eval 'Z_OK' &&
	    $status != eval 'Z_STREAM_END') {
		die sprintf("bad gunzip status: '%d' '%s'\n", $status, $gunzip_obj->msg());
	}
	return $out;
}

sub save_exif
{
	my $pic = shift;
	my $exif_tags = shift;

	my $value;
	my $max_value_len = 128;
	foreach my $key (keys %$exif_tags) {
		next if $key eq 'directory';
		next if $key eq 'maker_note_version';
		my $val = $exif_tags->{$key};
		if ($key eq 'error') {
			die "exif tag error on '$pic': '$val'";
		}
		if (length($val) > $max_value_len) {
			$val = substr($val, 0, $max_value_len);
		}
		$value .= sprintf("%s:%s\n", $key, $val);
	}
	return if !defined $value;
	my $gzipped = 0;
	my $xattr_name = 'exif.cache';
	if (length($value) > 3800) {
		dprintf3 "gzipping %d bytes of exif data for $pic\n", length($value);
		$value = my_gzip($value);
		dprintf3("got back %d bytes from my_gzip()\n", length($value));
		#my $test = my_gunzip($value);
		# even after gzipping it still won't fit, so
		# put a flag in here telling the other side
		# not to even try to cache it
		if (length($value) > 3800) {
			$value = 'slow_path';
		} else {
			$xattr_name = 'exif.cache.gzip';
		}
	}
	dprintf3("save_exif('%s') size: %d\n", $pic, length($value));
	dprintf3("save_exif('%s') value: '%s'\n", ($value));
	::set_dated_ufattr($pic, $xattr_name, $value);
}

sub fetch_cached_exif
{
	my $pic = shift;
	my $exif_tags;

	my $tmp = ::get_dated_ufattr($pic, 'exif.cache.gzip');
	if (defined $tmp) {
		my $otmp = $tmp;
		$tmp = my_gunzip($tmp);
		dprintf3 "gunzipped %d->%d bytes for xattr from '%s'\n",
			length($otmp), length($tmp), $pic;
	} else {
		$tmp = ::get_dated_ufattr($pic, 'exif.cache');
	}
	return $tmp if !length($tmp);
	if ($tmp eq 'slow_path') {
		dprintf1 "fetch_cached_exif('$pic') slow path\n";
		dprintf1 "slow path: fetch_cached_exif('$pic')\n";
		::del_dated_ufattr($pic, 'exif.cache');
		::del_dated_ufattr($pic, 'exif.cache.gzip');
		my $tags = __fetch_exif($pic);
		save_exif($pic, $tags);
		return $tags;
	}
	my $raw_exif_tags = $tmp;
	return undef if (!defined $raw_exif_tags);
	return undef if (!length($raw_exif_tags));
	my @lines = split('\n', $raw_exif_tags);
	foreach my $line (@lines) {
		my ($var, $val) = split(/:/, $line, 2);
		$exif_tags->{$var} = $val;
	}
	return $exif_tags;
}

sub fetch_exif
{
	my $pic = shift;
	dprintf3("fetch_exif('%s')\n", $pic);
	my $cached = fetch_cached_exif($pic);
	dprintf2 "got exif cache for '$pic'" if $cached;
	return $cached if (defined $cached);
	dprintf2 "cache miss '$pic'\n";

	my $exif_tags = __fetch_exif($pic);
	if (defined $exif_tags) {
		save_exif($pic, $exif_tags);
		# good for debugging
		die "unable to retrieve cache '$pic'" if !fetch_cached_exif($pic);
	}
	return $exif_tags;
}


sub __exif_date
{
	my $file = shift;
	my $ret;

	#dprintf4("%s('%s')\n", '__exif_date', $file);
	my $exif = fetch_exif($file);
	return undef if !defined $exif;
	foreach my $tag qw(DateTimeOriginal FileModifyDate date_time_original file_modify_date) {
		$ret = $exif->{$tag};
		last if defined $ret;
	}
	if (!defined $ret) {
		printf "unable to find date/time in '$file', ";
		printf "maybe one of these tags: %s\n",
			join(",", (keys %$exif));
		#printf "assuming bogus xattrs... stripping exif xattrs...";
		#system("strip-xattr", $file);
		#printf "done\n";
		die "";
	}
	return $ret;
}

my $dave_exif_xattr = {
	func => \&__exif_date,
	title => 'exifdate',
};

sub xattr_cache_get
{
	my $cache_opts = shift;
	my $file = shift;
	my $func = $cache_opts->{func};
	my $title = $cache_opts->{title};
	
	my $val = get_dated_ufattr($file, $title);
	return $val if defined $val;

	$val = &$func($file);
	return $val if (!defined $val);

	set_dated_ufattr($file, $title, $val);
	return $val;
}

sub exif_date
{
	my $file = shift;
	return xattr_cache_get($dave_exif_xattr, $file);
}

# returns a UNIX integer timestamp,
# instead of a date string
sub exif_date_gm
{
	my $date = exif_date(@_);
	use Date::Parse;
	return str2time($date, 'GMT');
}

sub pfile
{
	my $format = shift;
	my $nr = shift;
	return sprintf "$format", $nr;
}
sub is_unique_file
{
	my $format = shift;
	my $nr = shift;
	return ! (-e pfile($format, $nr));
}
sub is_next_unique_file
{
	my $format = shift;
	my $nr = shift;
	if ($nr <= 0) {
		return is_unique_file($format, $nr);
	}
	return (is_unique_file($format, $nr) && 
		!is_unique_file($format, $nr-1)) 
}
sub uniquename_printf
{
	my $format = shift;;
	my $nr = 0;
	my $jump = 0;
	while (!is_unique_file($nr)) {
		$nr = (1<<$jump++);
	}
	$jump--;
	while (!is_next_unique_file($format, $nr)) {
		if (is_unique_file($format, $nr)) {
			$nr -= (1<<$jump);
		} else {
			$nr += (1<<$jump);
		}
		$jump--;
	}
	return pfile($format, $nr);
}

sub fetchmail_pass
{
	my $host = shift;
	my $pass = `cat ~/.fetchmailrc | grep $host -A1 | grep password`;
	$pass =~ s/.*password\s"(.*.)".*/$1/;
	chomp $pass;
	return $pass;
}

sub hal_devices_by_udi
{
	my $devices;
	dprintf3("hal_devices_by_udi()\n");
	my $current_udi = undef;

	my @lines = `hal-device`;	
	foreach my $line (@lines) {
		chomp $line;
		#rintf "line: '%s'\n", $line;
		next if (!length($line));
		if ($line =~ /^[0-9]+: udi = '(.*)'/) {
			$current_udi = $1;
			#rintf "line: '%s' udi: '%s'\n", $line, $udi;
			$devices->{$current_udi} = {};
		} elsif ($line =~ /^\s+([0-9a-z\._]+) = (.*)\s+\((.*)\)/i) {
			my $var = $1;
			my $_val = $2;
			my $type = $3;
			my $val = $_val;
			$val =~ s/^'(.*)'/$1/;
			$val =~ s/\s*$//;
			#rintf "val ->%s<- ->%s<-\n", $_val, $val;
			#rintf("var: '%s' val: '%s' type: '%s'\n", $var, $val, $type);
			$devices->{$current_udi}->{$var} = $val;
		} elsif ($line =~ /^\s+([0-9a-z\._]+) = (.*).*/) {
			die "until second part: '$1' '$2'";
		} elsif ($line =~ /^\s+([0-9a-z\._]+) =/) {
			die "just first part: '$1'";
		} elsif ($line =~ /(\s+)?([0-9a-z\._]+)?( = )?(.*.)?/) {
			die "parts: 1: '$1' 2: '$2' 3: '$3' 4: '$4'";
		} else {
			if ($line =~ /uint64/) {
				print "skipping: $line\n";
				next;
			}
			die "unknown line: '$line'";
		}
	}
	return $devices;
}

sub email_body
{
	my @email_lines = @_;

	my $line;
	while (length($line = shift(@email_lines))) {} ;
	return @email_lines;
}

1;