package butch;
use strict;
use utf8;
use Encode;
use Encode::Guess qw/ euc-jp shiftjis 7bit-jis utf8 /;
$Encode::Guess::NoUTFAutoGuess = 1; # utf16 utf32 を候補から外す
use lib './';
use DBI;
use Time::Local;
use Digest::MD5;
use crawl_books;
use base qw(butch::sql butch::page butch::misc);
use vars qw( $dbh );

sub new{
	my $invocant = shift;
	my $class = ref($invocant) || $invocant;
	my $args = shift;
	my ( $obj )  = bless {
		root=> './',
		db_path => 'bolivia/db/',
		dbname=>'bookshelf',
		session_dir=>'bolivia/session/',
		session_days=>365,
		tmp_dir=>'bolivia/tmp/',
		index=>'index.pl',
		profile=>'profile.pl',
		site_static=>'bolivia/static/',

		site_images=>'./bolivia/css/images/',
		no_image_book=>{file=>'no_image_book.jpg',width=>60, height=>88},
		page_title=>{
			'index.pl'=>'本棚', 'profile.pl'=>'プロフィール',
		},
		page_limit=>20,
		pager_page=>10,
		memo_max=>3,
		crawl_max_count=>5,
		comment_length=>2048,

		is_public=>1,

		%$args,
		@_
	}, $class;
	if( $dbh eq '' ){
		$obj->connect_db($args->{dbname});
	}
	return $obj;
}
#
sub DESTROY {
	my $self = shift;
	$dbh->disconnect;
	undef $dbh;
}
sub _test{
	my $self = shift;
}
####
sub serial_id{
	my $self = shift;
	my $args = shift;
	my ($serial) = $dbh->selectrow_array(qq{select max($args->{id}) from $args->{table}});
	return $serial+1;
}
sub strtime{
	my $self = shift;
	my $timestamp = (shift || time);
	$timestamp += 9 * 60 * 60;
	my ($current) = $dbh->selectrow_array(qq{select strftime("%Y%m%d%H%M%S", $timestamp,'unixepoch' ) });
	# yyyymmddhhmmss
	return $current;
}
###
sub check_change_db{
	my $self = shift;
	my $uid  = shift;
	my $dbname;
	if( $uid =~ /^\d+$/){
		$dbname = sprintf qq{%05d}, $uid;
	}
	elsif($uid =~ /(butch|sundance)/){
		$dbname = $1;
	}
	else{
		return;
	}
	if( -e $self->{root} . $self->{db_path} . $dbname . '.sqlite' ) {
		$self->disconnect_db;
		$self->connect_db($dbname);
		return $uid;
	}
	return;
}
sub change_db{
	my $self = shift;
	my $uid  = shift;
	return if ! $uid;

	$self->disconnect_db;
	$self->connect_db( sprintf qq{%05d}, $uid );
	return $uid;
}
sub vacuum_db{
	my $self = shift;
	$dbh->do('VACUUM');
	return;
}
sub connect_db{
	my $self = shift;
	my $dbname = (shift || return);

	$dbname = $self->{root} . $self->{db_path} . $dbname . '.sqlite';
	$dbh = DBI->connect( "dbi:SQLite:dbname=$dbname","","",{ RaiseError => 1, AutoCommit=>1 });
	if( ! $dbh ) { die 'cannot connect db'; }
	return $dbh;
}
sub disconnect_db{
	my $self = shift;
	return if ! $dbh;
	$dbh->disconnect;
	undef $dbh;
}
###
sub execute_sql{
	my $self = shift;
	my $sql  = shift;
	return if ! $sql;
	my $sth;
	eval{$sth = $dbh->prepare($sql);};
	if($@){
		printf qq{%s<br />\n%s}, $sql, $@;
		return;
	}
	my $r   = $sth->execute;

	return $r;
}
sub select_data{
	my $self = shift;
	my $sql  = shift;
	my $cols = shift;
	return if ! $sql;
	my $sth;
	eval{$sth = $dbh->prepare($sql);};
	if($@){
		printf qq{%s<br />\n%s}, $sql, $@;
		return;
	}
	my $r   = $sth->execute;
	$cols= $sth->{NAME} if ! $cols;
	my @buf;
	while( my $p = $sth->fetchrow_arrayref){
		my %h;
		map{$_ = $self->touch_decode($_)} @{$p};
		map{$_ =~ s/\'\'/\'/g;} @{$p}; # for sqlite escape
		@h{ @{$cols} } = @{$p};
		push(@buf, \%h);
	}
	return \@buf;
}
### insert book from amazon
sub edit_profile{
	my $self = shift;
	my $uid  = shift;
	my $args = shift;
	return if ! $uid;
	return if ! $args;

	$args->{uid} = $uid;
	my ($checked) = $dbh->selectrow_array(qq{select uid from prof where uid=$uid});
	if( ! $checked ){
		$self->execute_sql($self->insert_prof($args));
	}
	else{
		$self->execute_sql($self->update_prof($args));
	}
}
sub edit_bookstar{
	my $self = shift;
	my $uid  = shift;
	my $args = shift;
	return if ! $uid;
	return if ! $args;

	for(my $i=1; $i<=10; $i++){
		my ($checked) = $dbh->selectrow_array(qq{select uid from bookstar_list where uid=$uid and starid=$i});
		$args->{'starstr' . $i} = substr($args->{'starstr' . $i}, 0,1) if length($args->{'starstr' . $i}) > 1;
		$args->{'starcolor' . $i} =~ s/^#//;
		my $starname = $args->{'starname' . $i} ? $args->{'starname' . $i} : 'カテゴリ' . $i;
		my $starstr  = $args->{'starstr' . $i} ? $args->{'starstr' . $i} : '■';
		my $starcolor = $args->{'starcolor' . $i} ? $args->{'starcolor' . $i} : 'cccccc';
		my $cols = {
			uid=>$uid,
			starid=>$i,
			starname=>$starname,
			staricon=>'',
			starcolor=>$starcolor,
			starstr=>$starstr
		};
		if( ! $checked ){
			$self->execute_sql($self->insert_bookstar($cols));
		}
		else{
			$self->execute_sql($self->update_bookstar($cols));
		}
	}
}
sub import_book{
	my $self = shift;
	my $uid  = shift;
	my $args = shift;

	return if(! $args);

	my $err;
	my $checked;
	# isbn チェック
	$checked = $self->check_isbn($args->{_isbn});
	if( ! $checked ){
		$err->{$args->{_isbn}} = 'wrong'; return $err;
	}
	my $asin = $checked; # check_isbn が amazon の asinを生成して返している。
	# 重複 isbn
	($checked) = $dbh->selectrow_array(qq{select isbn from books_list where isbn='$asin'});
	if( $checked ){
		$err->{$args->{_isbn}} = 'duplicate'; return $err;
	}
	my $crawl = crawl_books->new({});
	my ($book, $pages) = $crawl->check_cache({'isbn'=>$asin});
	if( ! ref($book) ){
		$err->{$args->{_isbn}} = 'nonexistent'; return $err;
	}

	if(! $book->[0]{title}){
		$err->{$args->{_isbn}} = 'not found --- ' . $args->{_isbn}; return $err;
	}

	$book->[0]{uid} = $uid;
	$book->[0]{timestamp} = time;
	$book->[0]{bookid} = $self->serial_id({id=>'bookid',table=>'books_list'});
	$book->[0]{ymd} = $self->strtime($book->[0]{timestamp});
	$book->[0]{readed} = $args->{_readed} ? 1 : 0;
	$book->[0]{bookstar} = sprintf qq{%d}, $args->{_bookstar};
	$self->execute_sql( $self->insert_book($book) );
	foreach ( @{$book->[0]{creator}} ){
		$book->[0]{authorid} = $self->serial_id({id=>'authorid',table=>'authors_list'});
		$book->[0]{author} = $_;
		$self->execute_sql( $self->insert_author($book) );
	}
	return 1;
}
### prof
sub get_prof{
	my $self = shift;
	return $self->select_data(qq{select * from prof});
}
sub get_profile_summary{
	my $self = shift;
	my $args = shift;

	my $prof   = $self->get_prof;
	my $stars  = $self->select_data( $self->get_bookstar_list );
	my $readed = $self->select_data(qq{select readed, count(*) as cnt from books_list group by readed order by readed});
	my $bookstar= $self->select_data(qq{select bookstar, count(*) as cnt from books_list group by bookstar order by bookstar});
	my $authors= $self->select_data(qq{select author, count(*) as cnt from authors_list group by author order by cnt desc limit 10 offset 0});


	return {profile=>$prof,stars=>$stars,readed=>$readed,bookstar=>$bookstar,authors=>$authors};
}
# books
sub get_memo{
	my $self = shift;
	my $args = shift;
	return if ! $args;
	return if ! $args->{commentid};
	return $self->select_data(qq{select * from books_memo where commentid=$args->{commentid}});
}
sub insert_memo{
	my $self = shift;
	my $args = shift;
	return if ! $args;
	return if length($args->{comment}) > $self->{comment_length};

	my ($cnt) = $dbh->selectrow_array(qq{select count(uid) from books_memo where uid=$args->{uid} and bookid=$args->{bookid}});
	return if $cnt >= $self->{memo_max};

	my $commentid = $self->serial_id({id=>'commentid',table=>'books_memo'});
	my $timestamp = time;
	my $netabare = $args->{netabare} ? 1 : 0;
	$self->execute_sql( $self->insert_bookmemo({uid=>$args->{uid}, bookid=>$args->{bookid}, commentid=>$commentid, comment=>$args->{comment}, netabare=>$netabare,ctime=>$timestamp,mtime=>$timestamp}) );
	$self->execute_sql( $self->update_book_timestamp({uid=>$args->{uid}, bookid=>$args->{bookid}}) );
	return $commentid;
}
sub update_memo{
	my $self = shift;
	my $args = shift;
	return if ! $args;
	return if length($args->{comment}) > $self->{comment_length};

	my $timestamp = time;
	my $netabare = $args->{netabare} ? 1 : 0;
	$self->execute_sql( $self->update_bookmemo({commentid=>$args->{commentid}, comment=>$args->{comment}, netabare=>$netabare, mtime=>$timestamp}) );
}
sub delete_memo{
	my $self = shift;
	my $args = shift;
	my ( $bookid ) = $dbh->selectrow_array(qq{select bookid from books_memo where commentid=$args->{commentid}});
	my $sql = qq{delete from books_memo where commentid=$args->{commentid}};
	$self->execute_sql($sql);
	return $bookid;
}
#
sub list_books{
	my $self = shift;
	my $args  = shift;
	return if ! $args;

	my ($cnt, $min, $max) = $dbh->selectrow_array(qq{select count(uid), min(mtime), max(mtime) from books_list});
	$args->{allcount} = $cnt;

	my $books;
	if($args && ($args->{uid}=~/^\d+$/ || $args->{bs}=~/^\d+$/) && $args->{bookid}=~/^\d+$/ && $args->{_} =~ /^\d+$/){
		# from ajax js_view_book.pl and visiter.pl
		my $uid = ($args->{bs} || $args->{uid});
		$books = $self->select_data( $self->get_book({uid=>$uid, bookid=>$args->{bookid}}) );
		if( $books->[0]{isbn} ){
			my $crawl = crawl_books->new({});
			my ($ref, $pages) = $crawl->check_cache({'isbn'=>$books->[0]{isbn}});
			if( ref($ref) ){
				#$books->[0]{image}->{url} = $ref->[0]{simage};
				$books->[0]{image}->{url} = $ref->[0]{simage};
				#$books->[0]{image}->{height} = $ref->[0]{simage_h};
				#$books->[0]{image}->{width}  = $ref->[0]{simage_w};
				$books->[0]{image}->{width}  = 60;
			}
		}
	}
	else{
		if($args->{_year}){
			$args->{ymd} = $args->{_year} . $args->{_month};
		}
		my $bookids; my $target_bookid;
		if( $args->{search} ne '' ){
			if( $args->{col} eq 'author'){
				$bookids = $self->select_data($self->get_bookid_from_authors($args));
			}
			elsif( $args->{col} eq 'memo'){
				$bookids = $self->select_data($self->get_bookid_from_memos($args));
			}
		}
		elsif( $args->{author} ne '' ){
			$bookids = $self->select_data($self->get_bookid_from_authors($args));
		}
		if(ref($bookids)){
			my @buf; foreach (@{$bookids}){ push(@buf, $_->{bookid}); }
			$target_bookid = join(',', @buf);
		}
		my $ref = $self->get_books_list($args, $target_bookid);
		# get count
		$args->{maxcount} = $dbh->selectrow_array($ref->{count});
		# get list
		$books = $self->select_data( $ref->{sql} );
	}
	my $authors;
	foreach (@{$books}){
		$authors->{$_->{uid}}->{$_->{bookid}} = $self->select_data( $self->get_authors({uid=>$_->{uid}, bookid=>$_->{bookid}}) );
	}
	my $has_memo;
	foreach (@{$books}){
		$has_memo->{$_->{uid}}->{$_->{bookid}} = $self->select_data( $self->get_memos({uid=>$_->{uid}, bookid=>$_->{bookid}}) );
	}
	my $stars;
	foreach (@{ $self->select_data( $self->get_bookstar_list ) } ){
		$stars->{$_->{starid}}->{name}  = $_->{starname};
		$stars->{$_->{starid}}->{icon}  = $_->{staricon};
		$stars->{$_->{starid}}->{color} = $_->{starcolor} ? $_->{starcolor} : 'cccccc';
		$stars->{$_->{starid}}->{str}   = $_->{starstr};
	}
	return {allcount=>$cnt, maxcount=>$args->{maxcount}, begin=>$min, latest=>$max, books=>$books, authors=>$authors, has_memo=>$has_memo, stars=>$stars};
}
#
sub update_bookinfo{
	my $self = shift;
	my $args = shift;
	return if ! $args;
	return unless( $args->{uid} && $args->{bookid});
	$self->execute_sql($self->update_book($args));
}
#
sub delete_bookinfo{
	my $self = shift;
	my $args = shift;
	return if ! $args;
	return unless( $args->{uid} && $args->{bookid});

	my $sql = qq{delete from books_memo where uid=$args->{uid} and bookid=$args->{bookid}};
	$self->execute_sql($sql);
	$sql = qq{delete from authors_list where uid=$args->{uid} and bookid=$args->{bookid}};
	$self->execute_sql($sql);
	$sql = qq{delete from books_list where uid=$args->{uid} and bookid=$args->{bookid}};
	$self->execute_sql($sql);
	1;
}
### from siteutil
# multipart の入力を解析
sub read_form_multipart{
	my $self  = shift;
	my $limit = shift;
	my $opt   = shift;
	$self->err_msg(0, 'File size is too large.') if $limit && $ENV{'CONTENT_LENGTH'} > $limit;

	my %form; my %form_file; my %zzz;
	my $buf;
	read(STDIN, $buf, $ENV{'CONTENT_LENGTH'});

	# 2006-07-07 boundary $ENV{'CONTENT_TYPE'};
	my($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=-(\S+)$/;	# バウンダリの取得
	my @form_body = split(/\-*${boundary}\-*/, $buf);
	foreach my $c ( @form_body ){
		next if ! $c;

		my ($disposition,$header,$body);
		if($c =~ /[Cc]ontent-[Dd]isposition: ([^\x0D\x0A]+)\x0D?\x0A	# Disposition
                    (?:([A-Za-z].*?)(?:\x0D?\x0A){2})?						# ヘッダ情報の取得
                    (?:\x0D?\x0A)?										# 予約空行
                    (?=(.+))/xs){										# データ行（次のヘッダ情報が含まれていることもある）
			($disposition,$header,$body) = ($1,$2,$3);
		}
		next if ! $disposition;

		# if( $disposition =~ /filename=\"([^\"]+)\"/i ){ 2011-12-04 13:34:12
		if( $disposition =~ /name=\"([^\"]+)\"; *filename=\"([^\"]+)\"/i ){
			my $name = $1;
			my $filename = $2; $filename =~ s!\\!/!g; $filename =~ s!^.+/!!;
			$form_file{$filename} = $body if $filename && $body;
			$form{$name} = $filename;
			$name=""; $filename =""; $body = "";
		}
		else{
			my ( $name ) = $disposition =~ /.+name=\"([^\"]+)\"/i;
			next if ! $name;
			$body =~ s/(\r\n)+$//;

			my $enc;
			if( $opt->{enc} ){
				$enc = $opt->{enc};
			}
			else{
				my $guess = Encode::Guess->guess($body);
				$enc = ref($guess) ? $guess->name : 'utf8';
			}
			$body = Encode::encode('utf8',Encode::decode($enc, $body));

			$body = Encode::decode('utf8', $body) if ! Encode::is_utf8($body);
			$name = Encode::decode('utf8', $name) if ! Encode::is_utf8($name);

			unless ( $body =~ /^--+/ ){
				$body =~ s/\x0D\x0A/\n/g;
				$body =~ s/\x0D/\n/g;
				$body =~ s/\,/，/g;

				if( ! $zzz{$name}++ ){
					$form{$name} = $body;
				}
				else{
					$form{$name} .= "," . $body;
				}
				$name = ""; $body = "";
			}
		}
	}
	return (\%form, \%form_file) if $buf;
}
sub read_form{
	my $self  = shift;
	my $limit = shift;
	my $opt   = shift;
	my($buf,$form_name, $form_value, $pair,@pairs);
	my %form;
	my %zzz;
	if( $ENV{'REQUEST_METHOD'} eq 'POST' ){
		read(STDIN, $buf, $ENV{'CONTENT_LENGTH'});
	}
	else{
		$buf = $ENV{'QUERY_STRING'};
	}
	$self->err_msg(0, 'File size is too large.') if $limit && $ENV{'CONTENT_LENGTH'} > $limit;
	@pairs = split(/&/,$buf);
	foreach $pair (@pairs){
		($form_name, $form_value) = split(/=/,$pair);
		$form_value =~ tr/+/ /;
		$form_value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;

		my $enc;
		if( $opt->{enc} ){
			$enc = $opt->{enc};
		}
		else{
			my $guess = Encode::Guess->guess($form_value);
			$enc = ref($guess) ? $guess->name : 'utf8';
		}
		$form_value = Encode::encode('utf8',Encode::decode($enc, $form_value));

		$form_name  = Encode::decode('utf8', $form_name)  if ! Encode::is_utf8($form_name);
		$form_value = Encode::decode('utf8', $form_value) if ! Encode::is_utf8($form_value);

		$form_value =~ s/\x0D\x0A/\n/g;
		$form_value =~ s/\x0D/\n/g;
		$form_value =~ s/\</＜/g;
		$form_value =~ s/\>/＞/g;
		$form_value =~ s/\,/，/g;


		if( ! $zzz{$form_name}++ ){
			$form{$form_name} = $form_value;
		}
		else{
			$form{$form_name} .= "," . $form_value;
		}
	}
	return \%form;
}
#
sub err_msg{
	my $self = shift;
	my $pos  = shift;
	my $msg  = shift;
	if( $pos < 1){
		print "Content-type:text/html\n\n";
		print "<html><body>";
	}
	print '<p class="err_msg">';
	print $msg;
	print '</p>';
	if( $pos < 1){
		print "</body></html>";
	}
	exit;
}
sub touch_decode{
	my $self = shift;
	my $c    = shift;
	$c = Encode::decode('utf8', $c) if ! Encode::is_utf8($c);
	return $c;
}
sub touch_encode{
	my $self = shift;
	my $c    = shift;
	$c = Encode::encode('utf8', $c) if Encode::is_utf8($c);
	return $c;
}
sub touch_encode2shiftjis{
	my $self = shift;
	my $c    = shift;
	$c = Encode::encode('shiftjis', $c) if Encode::is_utf8($c);
	return $c;
}
sub html_encode{
	my $self = shift;
	my $str = shift;
	my $enc = (shift || 'utf8');
	$str = Encode::encode($enc, $str) if Encode::is_utf8( $str );
	$str =~ s/([^0-9a-zA-Z~._-])/sprintf("%%%02X",unpack("C", $1))/eg;
	return $str;
}
sub html_decode{
	my $self = shift;
	my $str  = shift;
	$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
	return $str;
}
sub login_form{
	my $self = shift;
	my $form = shift;
	printf qq{<form action="%s" method="post">}, $self->{script};
	print qq{<h2>ログイン</h2>};

	print '<div class="content">';
	print qq{<dl id="login_form" class="inform">};
	print qq{<dt>メールアドレス:</dt>};
	printf qq{<dd><input type="text" name="email" value="%s" size="30" maxlength="128" /></dd>}, $form && $form->{email} ? $form->{email} :'';
	print qq{<dt>パスワード:</dt>};
	print qq{<dd><input type="password" name="pass" value="" size="30" maxlength="128" /></dd>};
	print qq{<dd class="submit_btn"><input type="submit" name="submit" value="送信" /></dd>};
	print qq{</dl>};
	print qq{<p>(メールアドレスとありますが、アルファベットなど半角でしたら何でもokです)</p>};
	print qq{<p>(ログイン リセットの場合もこの画面が表示されます)</p>};
	if( $form && $form->{email} ){
		$self->msg_err('メールアドレス、パスワードをご確認ください。');
	}
	print '</div>';
	print qq{</form>};
}
#
sub check_login{
	my $self = shift;
	my $args = shift;
	
	my $cookie = $self->get_cookie(['_bookshelf']);
	if( $args->{op} eq 'reset_login' ){ # for reset 
		my $sql = qq{delete from members where email is not null};
		$self->execute_sql($sql);
		unlink $self->{root} . $self->{session_dir} . $cookie->{'_bookshelf'};
		printf qq{Set-Cookie: _bookshelf=; expires=%s;\n}, $self->cookie_expires(-1);
		$self->go_entrance;
		return;
	}

	my $first_setting;
	eval{ $self->selectrow_array(qq{select * from members});};
	if($@){
		$self->execute_sql($self->make_table_members());
		$first_setting = 1;
	}
	if( $first_setting ){
		eval{ $self->selectrow_array(qq{select * from prof});};
		if($@){
			$self->setting_bookshelf();
		}
	}

	my $alive = $self->{session_days};
	# check session
	my $now = time;
	opendir(DIR, $self->{root} . $self->{session_dir}) || die; my @w = grep(/^[a-z0-9]+$/, readdir(DIR)); closedir(DIR);
	foreach( @w ){
		my $mtime = (stat($self->{root} . $self->{session_dir} . $_))[9];
		if( ($now - $mtime) > 60*60*24* $alive ){
			unlink $self->{root} . $self->{session_dir} . $_;
		}
	}

	if( $args->{email} && $args->{pass} ){
		return if( $args->{email} =~ m!\'! || $args->{pass} =~ m!\'! );
		my ($pass) = $dbh->selectrow_array(qq{select pass from members where email='$args->{email}'});
		my ($count) = $dbh->selectrow_array(qq{select count(*) from members});

		if( ! $pass && ! $count ){
			my $timestamp = time;
			my $pass = $self->make_pass({pass=>$args->{pass}});
			my $sql = qq{insert into members (email, pass, mtime, enabled) values ('$args->{email}', '$pass', $timestamp, 1)};
			$self->execute_sql($sql);
			my $digest = $self->set_session({email=>$args->{email}});
			printf qq{Set-Cookie: _bookshelf=%s; expires=%s;\n}, $digest, $self->cookie_expires($alive);
			return sprintf qq{Set-Cookie: _bookshelf=%s; expires=%s;\n}, $digest, $self->cookie_expires($alive);
		}
		if($pass){
			if( $self->check_pass({input=>$args->{pass}, pass=>$pass}) ){
				my $digest = $self->set_session({email=>$args->{email}});
				if($digest){
					$self->set_session({email=>$args->{email}});
					printf qq{Set-Cookie: _bookshelf=%s; expires=%s;\n}, $digest, $self->cookie_expires($alive);
					return sprintf qq{Set-Cookie: _bookshelf=%s; expires=%s;\n}, $digest, $self->cookie_expires($alive);
				}
			}
		}
	}
	elsif( $cookie->{'_bookshelf'} ){
		if( -f $self->{root} . $self->{session_dir} . $cookie->{'_bookshelf'} ){
			if( $args->{op} eq 'logout' ){ # for logout
				unlink $self->{root} . $self->{session_dir} . $cookie->{'_bookshelf'};
				printf qq{Set-Cookie: _bookshelf=; expires=%s;\n}, $self->cookie_expires(-1);
				return;
			}
			return $cookie->{'_bookshelf'};
		}
	}
	printf qq{Set-Cookie: _bookshelf=; expires=%s;\n}, $self->cookie_expires(-1);
	return;
}
#
sub set_session{
	my $self = shift;
	my $args = shift;
	my $timestamp = time;

	my $md5 = Digest::MD5->new;
	$md5->add(time, $args->{email});
	my $digest = $md5->hexdigest;
	my $session_file = $self->{root} . $self->{session_dir} . $digest;
	eval {
		no strict 'refs';
		my $fh = 'FH000';
		++$fh while fileno($fh);
		open($fh, '>' . $session_file) || die; print $fh $timestamp; close($fh);
	};
	if( $@ ){ return; }else{ return $digest; }
}
sub make_pass{
	my $self = shift;
	my $args = shift;
	return if ! $args->{pass};
	return $self->mk_crypt($args->{pass});
}
sub mk_crypt{
	my $self  = shift;
	my $input = shift;
	srand();
	my $salt = time;
	$salt = substr($salt, int(rand(length($salt))), 1);
	my $alph = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
	$salt .= substr($alph, int(rand(length($alph))), 1);
	return crypt($input, $salt);
}
#
sub check_pass{
	my $self = shift;
	my $args = shift;
	my $salt = substr($args->{pass}, 0, 2);
	return ( crypt($args->{input},$salt) eq $args->{pass} ) ? 1 : 0;
}
sub get_cookie{
	my $self   = shift;
	my $target = shift;

	my $pickup;
	if( ref($target) ){
		foreach( @{ $target } ){ $pickup->{$_}++; }
	}
	elsif( $target ne '' ){
		$pickup->{$target} = 1;
	}
	my %cookie;
	foreach my $pair ( split(/;\s*/,$ENV{'HTTP_COOKIE'}) ){
		my ($key, $value) = split(/=/, $pair); 
		next if( $pickup && ! $pickup->{$key} );
		$value =~ tr/+/ /;
		$value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C",hex($1))/eg;
		$value = Encode::decode('utf8',$value) if ! Encode::is_utf8($value);
		$cookie{ $key } = $value;
	}
	return \%cookie;
}
sub set_cookie{
	my $self  = shift;
	my $pairs = shift;

	foreach ( keys %{ $pairs } ){
		next if ! $pairs->{$_};
		printf"Set-Cookie: %s=%s; expires=%s;%s\n", $_, $self->html_encode($pairs->{$_}), $self->cookie_expires(30),
		$ENV{'HTTP_USER_AGENT'} =~ /UP\.Browser/i ? ' Max-Age=' . 60*60*24*30 .';' : '';
	}
	1;
}
sub cookie_expires {
	my $self = shift;
	my $days = shift;

	my $expires;
	my $t = time;
	$days = 1 if ! $days;		# デフォルトはとりあえず１日
	if($days == -1){
		$expires = 'Thu, 1-Jan-1980 00:00:00 GMT';
	}
	else{
		$days = $days * 60 * 60 * 24;
		my ($s,$mi,$h,$d,$m,$y,$wd) = (localtime(($t+$days)))[0..6]; ++$m; $y+=1900;
		$expires = sprintf("%s, %02d-%s-%s %02d:%02d:%02d GMT",
					   ('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[$wd],
						   $d,
						   ('','Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$m],
						   $y,
						   $h,$mi,$s);
	}
	return $expires;
}
sub clear_cookie{
	my $self = shift;
	my $key  = shift;
	foreach ( @{$key} ){
		printf qq{Set-Cookie: %s=''; expires=Thu, 01-Jan-1970 00:00:00 GMT;\n}, $_;
	}
	1;
}
sub setting_bookshelf{
	my $self = shift;

	$self->execute_sql( $self->make_books_list );
	$self->execute_sql( $self->make_authors_list );
	$self->execute_sql( $self->make_books_memo );
	$self->execute_sql( $self->make_bookstar_list );
	$self->execute_sql( $self->make_prof );

	$self->set_default_bookstars({uid=>1});
}
sub set_default_bookstars{
	my $self = shift;
	my $args = shift;

	my $uid = $args->{uid};
	my $stars = $self->select_data(qq{select * from bookstar_list});
	return if @{$stars} >= 10;
	my $timestamp = time;
	foreach (0..10){
		next if $stars->[$_]{starid};
		my $cat = ! $_ ? '未分類' : 'カテゴリ' . $_;
		my $sql = qq{
insert into bookstar_list (uid, starid,starname,staricon,starcolor,starstr, ctime,mtime)
  values ($uid, $_, '$cat','','999999','■', $timestamp,$timestamp)
};
		$self->execute_sql($sql);
	}
}

sub go_entrance{
	my $self = shift;
	printf qq{Location:%s\n\n}, $self->{index};
	exit;
}

### backup
sub download_backup{
	my $self = shift;
	my $uid  = shift;
	return if ! $uid;

	$self->check_change_db($uid);

	my $sql = qq{select * from bookstar_list where bookstar_list.uid=$uid order by bookstar_list.starid asc};
	my $stars = $self->select_data($sql);
	$sql = qq{select * from books_list where books_list.uid=$uid order by books_list.mtime desc};
	my $books = $self->select_data($sql);

	print qq{Content-type: application/octet-stream\n};
	print qq{Content-Disposition: inline; filename=bookshelf.xml\n\n};
	print qq{<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>};
	print qq{<dokusho>\n};
	print qq{<categories>\n};
	foreach (@{$stars}){
		print qq{<category>};
		printf qq{<id>%d</id>}, $_->{starid};
		printf qq{<name><![CDATA[%s]]></name>}, $_->{starname};
		printf qq{<color>%s</color>}, $_->{starcolor};
		printf qq{<mark><![CDATA[%s]]></mark>}, $_->{starstr};
		print qq{</category>\n};
	}
	print qq{</categories>\n};
	print qq{<bookslist>\n};
	foreach (@{$books}){
		print qq{<book>};
		printf qq{<isbn>%s</isbn>},$_->{isbn};
		printf qq{<title><![CDATA[%s]]></title>},$_->{title};
		printf qq{<readed>%s</readed>},$_->{readed};
		printf qq{<category>%d</category>}, $_->{bookstar};
		printf qq{<date>%s</date>}, $_->{ymd};
		my $authors = $self->select_data(qq{select * from authors_list where authors_list.uid=$uid and authors_list.bookid=$_->{bookid} order by authors_list.authorid});
		if( $authors->[0]{uid} ){
			print qq{<authors>};
			foreach ( @{$authors} ){
				printf qq{<author><![CDATA[%s]]></author>}, $_->{author};
			}
			print qq{</authors>};
		}
		my $memos = $self->select_data(qq{select * from books_memo where books_memo.uid=$uid and books_memo.bookid=$_->{bookid} order by books_memo.mtime desc});
		if( $memos->[0]{uid} ){
			print qq{<memo>};
			foreach ( @{$memos} ){
				printf qq{<comment><![CDATA[%s]]></comment>}, $_->{comment};
				printf qq{<netabare>%d</netabare>}, $_->{netabare};
			}
			print qq{</memo>};
		}
		print qq{</book>\n};
	}
	print qq{</bookslist>\n};
	print qq{</dokusho>};

	return;
}
sub download_backup_sqlite{
	my $self = shift;
	my $uid = shift;

	return if ! $uid;
	my $dbname = sprintf qq{user%05d.sqlite}, $uid;
	return if ! -e $self->{root} . $self->{db_path} . $dbname;
	my $fsize = (stat($self->{root} . $self->{db_path} . $dbname))[7];
	my $buf;
	open(IN, $self->{root} . $self->{db_path} . $dbname) || return;
	read(IN, $buf, $fsize);
	close(IN);	

	binmode STDOUT;
	print qq{Content-type: application/octet-stream\n};
	print qq{Content-Disposition: inline; filename=00001.sqlite\n\n};
	print $buf;

	return;
}
1;