#!/usr/bin/perl
use warnings;
use strict;

use CGI::Fast qw/ :standard /;

use TMA::Loot;
use TMA::Config;
my @par = ( servers => $TMA::Config::memcached_web_servers, );
use Cache::Memcached;
my $cc = new Cache::Memcached @par;
die "failed to create cacheclient" unless $cc;

@par = (
	$TMA::Config::loot_dsn,
	$TMA::Config::loot_user,
	$TMA::Config::loot_pass,
	);
use DBI;
my $dbh = DBI->connect(@par) or die "cant connect: ".DBI->errstr;
$dbh->{mysql_auto_reconnect} = 1;


use MogileFS::Client;
my $mogc = MogileFS::Client->new(
		domain => "loot",
		hosts  => $TMA::Config::mogilefs_servers,);
die "failed to create mogileclient" unless $mogc;


while (my $q = new CGI::Fast) {
	&do_urires($q);
}
exit 0;
die "never here";

####

sub do_urires($) {

my $p;
my $mode;
my $role;
my $sep;
my $loc="cgi";

if (@ARGV == 2) {
	$role = lc shift @ARGV;
	$p = shift @ARGV;
	$mode = "cli";
	$sep = "\n";
} else {
	if (($ENV{REQUEST_URI}||"") =~ /^\/(uri|cgi)-res\/(\w+)\?/) {
		$loc = lc $1;
		$role = lc $2;
	} elsif (($ENV{SCRIPT_NAME}||"") =~ /^\/(uri|cgi)-res\/(\w+)$/) {
		$loc = lc $1;
		$role = lc $2;
	} else {
		die "whoami";
	}
	$p = param("keywords");
	$mode = "cgi";
	$sep = "\r\n";
}
die "missing" unless $role && $p && $mode;
if ($loc eq 'cgi') {
	# no caching for tests
	undef $cc;
}

my ($urn, $key, $type, $class,) = eval{ &parse_key($p); };
if (!defined $class || $@) {
	chomp $@;
	&printerr("unrecognized keytype EXC: '$@'");
	return 0;
}

if ($role =~ /^n2/) {
	if ($class ne 'urn') {
		&printerr("expected urn, got $class");
		return 0;
	}
} elsif ($role =~ /^l2/) {
	if ($class ne 'url') {
		&printerr("expected url, got $class");
		return 0;
	}
} else {
	die "bad role: $role";
}

my $lids;
my $lidkey = "lidcache:$urn";
if ($cc && $loc ne 'cgi') {
	$lids = $cc->get($lidkey);
}
unless (defined $lids) {
	my @l = &key_to_lids($urn);
	$lids = \@l;
	if ($cc) {
		$cc->set($lidkey, $lids, (@l ? 300 : 60));
	}
}

unless ($lids && @$lids) { 
	print header(-status=>"404 Not Found"),
		html("no matches for '$urn'");
	return 0;
}

my $sth;
if ($role =~ /^[nl]2l(s)?$/) {
	if ($mode eq 'cgi' && $role =~ /2ls$/) {
		#print header(-type=>'text/uri-list',);
		print header(-type=>'text/plain',);
	}
	print("### ", $urn, $sep) if $role =~ /2ls$/;
	for my $lid (@$lids) {
		print("## urn:x-lid:", $lid, $sep) if $role =~ /2ls$/;
		my $loot = new TMA::Loot(lid=>$lid);

		my @urls = $loot->get_urls();

		unless (@urls) { 
			print("# no urls", $sep) if $role =~ /2ls$/;
		}

		for my $url (@urls) {
			if ($role =~ /2l$/) {
				print redirect(
					-status => 302,
					-uri => $url,
					);
				return 0;
			}
			print $url,$sep;
		}
	}

	if ($role =~ /2l$/) {
		print header(-status=>"404 Not Found"),
			html("no urls for '$urn'");
	}
	return 0;

} elsif ($role =~ /^[ln]2n(s)?$/) {

	if ($mode eq 'cgi') {
		#print header(-type=>'text/uri-list',);
		print header(-type=>'text/plain',);
	}
	print("### ", $urn, $sep);
	for my $lid (@$lids) {
		print("## urn:x-lid:", $lid, $sep);

#			die "key mismatch" unless $r->{$type} eq $key;
#			for (qw{ maxatime }) { 
#				if (exists $r->{$_}) {
#					print "# $_: ", $r->{$_}, $sep;
#				}
#			}
		my $kvsth = $dbh->prepare_cached(qq{
				select
					k,
					v
				from
					triple
				where
					lid = ?
				}) or die $dbh->errstr;
		$kvsth->execute($lid) or die $kvsth->errstr;
		my $kar = $kvsth->fetchall_arrayref();
		$kvsth->finish;
		if (defined $kar && @$kar) {
			for (@$kar) {
				my ($k, $v,) = @$_;
				print "urn:x-triple-$k:$v", $sep;
			}
		}

		my $loot = new TMA::Loot(lid=>$lid);

		for my $u (qw{ mime size pref4k }) { 
			print $loot->get_urn("x-".$u), $sep;
		}

		for my $u (qw{ sha1 md5 md4 crc32 }) { 
			print $loot->get_urn($u), $sep;
		}
				
		print "#", $sep;  
	}
	return 0;

} elsif ($role =~ /^[nl]2([tr])$/) {
	my $what = $1 eq 'r' ? "loot" : "thumb";

	my $lid = $lids->[0];
	my ($mime, $name,);


	if ($what eq 'thumb') {
		$mime = 'image/jpeg';
		$name = "tn_".$lid;
	} else {
		my $loot = new TMA::Loot(lid=>$lid);

		use MIME::Base32 qw( RFC );
		$name = lc MIME::Base32::encode($loot->get_n2n('sha1'));
		$mime = $loot->get_n2n('mime');
	}
	die "no name for $lid" unless $name;
	die "no mime for $lid" unless $mime;



my $mogkey = sprintf "$what:%s", $lid;
print STDERR "[$$] DEB: mogkey $mogkey\n";
if (($ENV{HTTP_X_PROXY_CAPABILITIES}||"") =~ /reproxy-file/) {
	my $p;
	$p = $cc->get("mogpath:$mogkey") if $cc;
	my $s = "cached";
	unless (defined $p) {
		#my @paths = $mogc->get_paths($mogkey);
		my @paths = $mogc->get_paths($mogkey, { noverify => 1 });
		$p = \@paths;
		$cc->set("mogpath:$mogkey",$p,300) if $cc;
		$s = $cc ? "cachemissed" : "uncached";
	}
	printf STDERR "[$$] DEB: %s reprox %s\n", $s, join(" ", @$p);
        if (@$p) {
       	        print header(
			-type => $mime,
#				-Content_Length => $row->{size},
			-expires        => "+30d",
			-x_reproxy_url  => join(" ", @$p),
			-Content_Disposition => "filename=$name",
                      );
                return 0;
        }
} else {
        my $dataref = $mogc->get_file_data($mogkey);
	printf STDERR "[$$] DEB: fetched %i bytes\n", length($$dataref);
        if ($dataref && ref $dataref) {
		print header(
			-type => $mime,
			-expires=> "+30d",
			-Content_Length => length($$dataref),
			-Content_Disposition => "filename=$name",
			), $$dataref;
                return 0;
        }
}


print header(-status=>"404 Not Found"),
	html("no result4 from data fetch for $mogkey");
return 0;



} else { 
		&printerr("unsupported role $role");
		return 0;
}

die "never inner here";

} # end sub do_urires

sub printerr($) {
	my $msg = join " ", @_;
	chomp $msg;
	my $status = "409 Conflict";
	if ($msg =~ /^\s*(\w+(\s+\w+)*)($|\n)/) {
		$status = "409 $1";
	}
	print header("text/plain", $status);
	print $msg,"\n";
}