#!/usr/bin/perl -w

use strict;
use Getopt::Std;
use DBI;
use Tk;
use Tk::Table;
use Tk::JPEG;
use Tk::HList;


#############################################################################
#				Main Program
#############################################################################

#============================================================================
#				Global variables
#============================================================================
my $toftool_cfg = $ENV{HOME}."/.toftool.cfg";
my $tmp_collfile = "/tmp/toftool_tmp.gqv";

my $kwentry;
my $tpentry;
my $rlentry;
my $kw_buffer_content;
my $tp_buffer_content;
my $mode;
my $rl_admin_frame;
my $kw_admin_frame;
my $tp_admin_frame;
my $view_frame;
my $rl_rb;
my $kw_rb;
my $tp_rb;
my $rl_rb_any;
my $kw_rb_any;
my $tp_rb_any;
my $rl_rb_all;
my $kw_rb_all;
my $tp_rb_all;
my $debug;
my $imagedir;
my $srcdir;
my $thumbnail_options;
my $image_options;
my $dbname;

# Load settings from configuration file $toftool_cfg
load_settings();

# Command line options
my %args;   
getopts("d:u:h", \%args);
my $opt_d = $args{d};
my $opt_u = $args{u};
my $opt_h = $args{h};

# Username
my $username;
if ($opt_u) {
    $username = $opt_u
} else {
    $username = $ENV{LOGNAME} 
}

if ($opt_d) { $dbname = $opt_d }

# Database 
my $database = "DBI:Pg:dbname=$dbname";
my $dbh = DBI->connect($database, '','') or die $DBI::errstr;

# Set userid and groupid
my $sql = "SELECT * FROM users WHERE username = ?";
my $sth = $dbh->prepare($sql);
$sth->execute($username);
my $row = $sth->fetchrow_hashref; 
my $userid = $row->{userid};
($userid) or die "Determination of userid failed for username $username"; 
my $groupid = $row->{selfgroup};
$sth->finish;


($debug) && print "-----------------------------------------------------------------------\n";
($debug) && print "\tSettings\n";
($debug) && print "-----------------------------------------------------------------------\n";
($debug) && print "toftool_cfg = $toftool_cfg\n";
($debug) && print "dbname = $dbname\n";
($debug) && print "username = $username\n";
($debug) && print "userid = $userid\n";
($debug) && print "groupid = $groupid\n";
($debug) && print "imagedir = $imagedir\n"; 
($debug) && print "tmp_collfile = $tmp_collfile\n";
($debug) && print "srcdir = $srcdir\n";
($debug) && print "-----------------------------------------------------------------------\n";

#============================================================================
#				The GUI
#============================================================================
# First cleanup tmp files in database from previous runs if needed
empty_kw_buffer();
empty_tp_buffer();

# Main applcation window.
my $mw = new MainWindow(
    -background => 'white',
    -title => 'Toftool',
);

# Force window manager to keep at least minimal size needed for view mode
$mw->resizable('no','no');

#----------------------------------------------------------------------------
# 	 		Main buttons frame
#----------------------------------------------------------------------------
my $mw_top_frame = $mw->Frame()->pack(-side => 'top', -fill => 'x');


# Buttons for selection of admin/view mode
my $toggle_mode_button; 
$toggle_mode_button = $mw_top_frame->Button(
    -font => 'Arial',
    -command => sub{
	if ( $mode eq 'view' ){
	    ($view_frame) && $view_frame->destroy;

	    open_rl_admin_frame();
	    open_kw_admin_frame();
	    open_tp_admin_frame();

	    $rl_rb='any';
	    $kw_rb='all';
	    $tp_rb='any';

	    $rl_rb_any->configure(-state => 'disabled');
	    $kw_rb_any->configure(-state => 'disabled');
	    $tp_rb_any->configure(-state => 'disabled');
	    $rl_rb_all->configure(-state => 'disabled');
	    $kw_rb_all->configure(-state => 'disabled');
	    $tp_rb_all->configure(-state => 'disabled');

	    $mode = 'admin';

	    $toggle_mode_button->configure(-text => 'View Mode');

	} elsif ( $mode eq 'admin' ) {
	    ($rl_admin_frame) && $rl_admin_frame->destroy;
	    ($kw_admin_frame) && $kw_admin_frame->destroy;
	    ($tp_admin_frame) && $tp_admin_frame->destroy;

	    $rl_rb='any';
	    $kw_rb='any';
	    $tp_rb='any';

	    $rl_rb_any->configure(-state => 'active');
	    $kw_rb_any->configure(-state => 'active');
	    $tp_rb_any->configure(-state => 'active');
	    $rl_rb_all->configure(-state => 'active');
	    $kw_rb_all->configure(-state => 'active');
	    $tp_rb_all->configure(-state => 'active');

	    open_view_frame();

	    $mode = 'view';

	    $toggle_mode_button->configure(-text => 'Admin Mode');
	}

    }
)->pack(
    -side => "left"
);

$mw_top_frame->Button(
    -font => 'Arial',
    -text => "Exit",
    -command => \&quit 
)->pack(
    -side => "right",
);


#----------------------------------------------------------------------------
# 	 		List (ratings, rolls, keywords, topics)  frame 
#----------------------------------------------------------------------------
# Subframe for rolls, keywords and topics lists
my $mw_list_frame = $mw->Frame(
    -background => 'white',
)->pack(-side => 'top', -fill => 'x');
#----------------------------------------------------------------------------
# 	 		Ratings frame 
#----------------------------------------------------------------------------
my $rt = $mw_list_frame->Frame(
    -background => 'white',
)->pack(-side => 'left', -anchor => 'n');
my $min_show_rate_scale;
my $min_show_rate_cb;
$min_show_rate_cb = $rt->Checkbutton(
    -text => "Min. rate",
    -font => 'Arial',
    -background => '#bbccff',
    -command => sub {
	my $min_show_rate_on_ref = $min_show_rate_cb->cget(-variable);
	if ($$min_show_rate_on_ref ){
	    $min_show_rate_scale->configure(-state => 'active')
	}else{ 
	    $min_show_rate_scale->configure(-state => 'disabled')
	}
    }
)->pack(
    -side => 'top',
    -anchor => 'n',
    -fill =>'x'
);

$min_show_rate_scale=$rt->Scale(
    -background => 'white',
    -from => 10, -to => 1,
    -tickinterval => 1, -showvalue => 1,
    -variable => 'min_show_rate' ,
    -length => 285,
    -state => 'disabled',
)->pack(-side => 'left');

#----------------------------------------------------------------------------
# 	 		Rolls frame 
#----------------------------------------------------------------------------
my $rl = $mw_list_frame->Frame(
)->pack(-side => 'left', -anchor => 'n');

my $rl_line1 = $rl->Frame(
    -background => '#bbccff',
)->pack(-side => 'top', fill => 'x');

my $rl_line2 = $rl->Frame(
    -background => 'white',
)->pack(-side => 'top', fill => 'x');

my $rl_line3 = $rl->Frame(
)->pack(-side => 'top', fill => 'x');

$rl_line1->Label(
    -text => "Rolls",
    -background => '#bbccff',
)->pack(
    -side => 'top',
    -fill => 'x'
);

my $rllist = $rl_line2->Scrolled(
    'HList',
    -scrollbars => 'oe',
    -background => 'white',
    -selectmode => 'extended',
    -exportselection => 0,
    -width => 0,
    -height => 20
)->pack(-side => 'top', -anchor => 'w', -fill => 'x');


$rl_rb_all = $rl_line3->Radiobutton(
    -text => 'ALL',
    -font => 'Arial',
    -value => 'all',
    -variable => \$rl_rb,
    -background => 'white',
    -command => sub{($debug) && print "selected: rl_rb=$rl_rb\n"} 
)->pack(
    -side => 'left'
);
$rl_rb_any = $rl_line3->Radiobutton(
    -text => 'ANY',
    -font => 'Arial',
    -value => 'any',
    -variable => \$rl_rb,
    -background => 'white',
    -command => sub{($debug) && print "selected: rl_rb=$rl_rb\n"} 
)->pack(
    -side => 'left'
);

$rl_line3->Button(
    -font => 'Arial',
    -text => "Clear",
    -command => \&reset_rl
)->pack(
    -anchor => 'e'
);


#----------------------------------------------------------------------------
# 	 		Keywords frame 
#----------------------------------------------------------------------------
my $kw = $mw_list_frame->Frame(
)->pack(-side => 'left', -anchor => 'n');

my $kw_line1 = $kw->Frame(
    -background => '#bbccff',
)->pack(-side => 'top', fill => 'x');

my $kw_line2 = $kw->Frame(
    -background => 'white',
)->pack(-side => 'top', fill => 'x');

my $kw_line3 = $kw->Frame(
)->pack(-side => 'top', fill => 'x');

$kw_line1->Label(
    -text => "Keywords",
    -background => '#bbccff',
)->pack(
    -side => 'top',
    -fill => 'x'
);

my $kwlist = $kw_line2->Scrolled(
    'HList',
    -scrollbars => 'oe',
    -background => 'white',
    -selectmode => 'extended',
    -exportselection => 0,
    -width => 0,
    -height => 20
)->pack(-side => 'top', -anchor => 'w', -fill => 'x');


$kw_rb_all = $kw_line3->Radiobutton(
    -text => 'ALL',
    -font => 'Arial',
    -value => 'all',
    -variable => \$kw_rb,
    -background => 'white',
)->pack(
    -side => 'left'
);

$kw_rb_any = $kw_line3->Radiobutton(
    -text => 'ANY',
    -font => 'Arial',
    -value => 'any',
    -variable => \$kw_rb,
    -background => 'white',
)->pack(
    -side => 'left'
);

$kw_line3->Button(
    -font => 'Arial',
    -text => "Clear",
    -command => sub{
	reset_kw($kwlist)
    }
)->pack(
    -anchor => 'e'
);

#----------------------------------------------------------------------------
# 				Topics frame
#----------------------------------------------------------------------------
my $tp = $mw_list_frame->Frame(
)->pack(-side => 'left', -anchor => 'n');

my $tp_line1 = $tp->Frame(
    -background => '#bbccff',
)->pack(-side => 'top', fill => 'x');

my $tp_line2 = $tp->Frame(
    -background => 'white',
)->pack(-side => 'top', fill => 'x');

my $tp_line3 = $tp->Frame(
)->pack(-side => 'top', fill => 'x');

$tp_line1->Label(
    -text => "Topics",
    -background => '#bbccff',
)->pack(
    -side => 'top',
    -fill => 'x'
);

my $tplist = $tp_line2->Scrolled(
    'HList',
    -scrollbars => 'oe',
    -background => 'white',
    -separator => ':',
    -selectmode => 'extended',
    -exportselection => 0,
    -width => 0,
    -height => 20
)->pack(-side => 'top', -anchor => 'w', -fill => 'x');

$tp_rb_all = $tp_line3->Radiobutton(
    -text => 'ALL',
    -font => 'Arial',
    -value => 'all',
    -variable => \$tp_rb,
    -background => 'white',
)->pack(
    -side => 'left'
);

$tp_rb_any = $tp_line3->Radiobutton(
    -text => 'ANY',
    -font => 'Arial',
    -value => 'any',
    -variable => \$tp_rb,
    -background => 'white',
)->pack(
    -side => 'left'
);

$tp_line3->Button(
    -font => 'Arial',
    -text => "Clear",
    -command => sub{
	reset_tp($tplist)
    }
)->pack(
    -anchor => 'e'
);

#############################################################################
# 				Start of the program
#############################################################################
# Print help if required
if ($opt_h) {
    print_help();
    exit;
}


# Fill rolls list
show_rllist();

# Fill keywords list
my @keywords= get_kw_stored();
show_kwlist($kwlist,@keywords);

# Fill topics-tplist
# and show topics-collections-dir-tree
show_tptree($tplist);

# start in view mode
$mode = 'view';
open_view_frame();
$toggle_mode_button->configure(-text => 'Admin Mode');

# Main event loop
MainLoop();

#############################################################################
#				Subroutines
#############################################################################

sub Test {
}


# Add a new keyword
sub add_kw {
    my $kwentry = shift;

    my $kw = $kwentry->get();
    if ($kw){
	($kw) && $kwlist->add("$kw", -text => "$kw");
	$kwentry->delete(0,'end');
    }
}

# Add a new topic
sub add_tp {
    my $tplist = shift;
    my $dcr = $tpentry->get();		    # description
    if ($dcr){
	my @tp = get_tp_selected($tplist);
	if ($#tp > 0){
	    popup_mesg("Add topic: supported only for one topic");
	    return
	}
	my $ptp = $tp[0];	# if more topics are selected take the first one
	my $new_topic = $ptp.":".$dcr; 
	$tplist->add($new_topic, -text => "$dcr" );
	store_topics_data($new_topic);
	$tpentry->delete(0,'end');
    }
}

# Add a new roll (subdir in $srcdir)
sub add_rl {
    my $dir = $rlentry->get();		     

    if ($dir){
	mkdir "$srcdir/$dir";
	$rlentry->delete(0,'end');
	show_rllist(); 
    }
}

# Remove data for selected keyword.
# The data are stored in the table keywords_tmp for use in a subsequent 'restore' action
sub copy_kw {
    my @kw = get_kw_selected($kwlist);
    if (@kw){
	# Remove current tmp table first
	my $sql1 = "DROP TABLE keywords_tmp";
	my $sth1 = $dbh->prepare($sql1);
	table_exists('keywords_tmp') && $sth1->execute(); 
	$sth1->finish;

	# Prepare the SQL-query for selection 
	my ($kw, $str);
	my $i=0;
	for $kw (@kw){
	    $i++;
	    if ($i == 1) {
		$str .= "value = ? ";
	    } else {
		$str .= "OR value = ? ";
	    }
	}
	my $sql2 = "CREATE TABLE keywords_tmp AS SELECT * FROM keywords WHERE ".$str;
	my $sth2 = $dbh->prepare($sql2);

	$sth2->execute(@kw) || die $sth2->errstr; 
	$sth2->finish;

	# Update $kw_buffer and label
	my $kw_buffer = get_kw_buffer();
	$kw_buffer_content->configure(text => $kw_buffer);
    }
}

# Remove data for selected keyword.
# The data are stored in the table keywords_tmp for use in a subsequent 'restore' action
sub cut_kw_selected {
    my $kw_buffercontent = shift;

    my @kw = get_kw_selected($kwlist);

    if (@kw){
	# Remove current tmp table first
	my $sql1 = "DROP TABLE keywords_tmp";
	my $sth1 = $dbh->prepare($sql1);
	table_exists('keywords_tmp') && $sth1->execute(); 
	$sth1->finish;

	# Prepare the SQL-query for selection 
	my ($kw, $str);
	my $i=0;
	for $kw (@kw){
	    $i++;
	    if ($i == 1) {
		$str .= "value = ? ";
	    } else {
		$str .= "OR value = ? ";
	    }
	}
	my $sql2 = "CREATE TABLE keywords_tmp AS SELECT * FROM keywords WHERE ".$str;
	my $sth2 = $dbh->prepare($sql2);

	$sth2->execute(@kw) || die $sth2->errstr; 
	$sth2->finish;


	# Remove matching entries from keywords table
	my $sql3 = "DELETE FROM keywords WHERE ".$str;
	my $sth3 = $dbh->prepare($sql3);
	$sth3->execute(@kw); 
	$sth3->finish;

	# Remove selected list items
	for $kw (@kw){
	    $kwlist->delete('entry', $kw);	
	}


	# Update $kw_buffer and label
	my $kw_buffer = get_kw_buffer();
	$kw_buffer_content->configure(text => $kw_buffer);

    }
}

# Remove a roll and all included pictures data from the database
sub cut_rl_selected {
    my @rl_selected = get_rl_selected($rllist);

    for my $rollid (@rl_selected ){
	if ($rollid){
	    ($debug)&& print "cur_rl: removing pictures from keywords for rollid = $rollid\n";
	    my $sql = "DELETE FROM keywords WHERE pictureid IN
	    (SELECT pictureid FROM pictures WHERE rollid = ?)";
	    my $sth = $dbh->prepare($sql);
	    $sth->execute($rollid); 
	    $sth->finish;

	    ($debug)&& print "cur_rl: removing pictures from topics for rollid = $rollid\n";
	    $sql = "DELETE FROM topicscontentorder WHERE pictureid IN
	    (SELECT pictureid FROM pictures WHERE rollid = ?)";
	    $sth = $dbh->prepare($sql);
	    $sth->execute($rollid); 
	    $sth->finish;

	    $sql = "DELETE FROM topicscontent WHERE pictureid IN
	    (SELECT pictureid FROM pictures WHERE rollid = ?)";
	    $sth = $dbh->prepare($sql);
	    $sth->execute($rollid); 
	    $sth->finish;

	    ($debug)&& print "cur_rl: removing pictures for rollid = $rollid\n";
	    $sql = "DELETE FROM pictures WHERE rollid = ?";
	    $sth = $dbh->prepare($sql);
	    $sth->execute($rollid); 
	    $sth->finish;

	    ($debug)&& print "cur_rl: removing rollid = $rollid\n";
	    $sql = "DELETE FROM rolls WHERE rollid = ?";
	    $sth = $dbh->prepare($sql);
	    $sth->execute($rollid); 
	    $sth->finish;
	}
    }
}

# Remove part of the topics tree to a buffer
sub cut_tp_tree_selected {
    $tplist = shift;

    my @tp = get_tp_selected($tplist);
    my $tp_sel = $tp[0]; # if more topics are selected take the first one
    if ($tp_sel){
	my $id_sel=get_topicid($tp_sel);
	my (@ids, @ids0, @ids1, @ids2, @ids3, @ids4, @ids5, @ids6); 
	my ($id, $id0, $id1, $id2, $id3, $id4, $id5);

	# Fill @ids with all subtopics in the tree below $tp_sel 
	@ids0 = get_subtopicids($id_sel);
	push @ids, @ids0;
	for $id0 (@ids0){
	    @ids1 = get_subtopicids($id0);
	    push @ids, @ids1;
	    for $id1 (@ids1){
		@ids2 = get_subtopicids($id1);
		push @ids, @ids2;
		for $id2 (@ids2){
		    @ids3 = get_subtopicids($id2);
		    push @ids, @ids3;
		    for $id3 (@ids3){
			@ids4 = get_subtopicids($id3);
			push @ids, @ids4;
			for $id4 (@ids4){
			    @ids5 = get_subtopicids($id4);
			    push @ids, @ids5;
			    for $id5 (@ids5){
				@ids6 = get_subtopicids($id5);
				push @ids, @ids6;
			    }
			}
		    }
		}
	    }
	}


	# Remove current table topics_tmp 
	my $sql0 = "DROP TABLE topics_tmp";
	my $sth0 = $dbh->prepare($sql0);
	table_exists('topics_tmp') && $sth0->execute(); 
	$sth0->finish;

	# Remove current table topiccontent_tmp 
	my $sql1 = "DROP TABLE topicscontent_tmp";
	my $sth1 = $dbh->prepare($sql1);
	table_exists('topicscontent_tmp') && $sth1->execute(); 
	$sth1->finish;

	# Remove current table topiccontentorder_tmp 
	my $sql1a = "DROP TABLE topicscontentorder_tmp";
	my $sth1a = $dbh->prepare($sql1a);
	table_exists('topicscontentorder_tmp') && $sth1a->execute(); 
	$sth1a->finish;

	my $sql4 = "CREATE TABLE topicscontent_tmp AS SELECT * FROM topicscontent WHERE topicid = ?";
	my $sth4 = $dbh->prepare($sql4);
	my $sql5 = "INSERT INTO topicscontent_tmp  SELECT * FROM topicscontent WHERE topicid = ?";
	my $sth5 = $dbh->prepare($sql5);
	my $sql6 = "CREATE TABLE topicscontentorder_tmp AS SELECT * FROM topicscontentorder WHERE topicid = ?";
	my $sth6 = $dbh->prepare($sql6);
	my $sql7 = "INSERT INTO topicscontentorder_tmp  SELECT * FROM topicscontentorder WHERE topicid = ?";
	my $sth7 = $dbh->prepare($sql7);
	my $sql5a = "DELETE FROM topicscontent WHERE topicid = ?";
	my $sth5a = $dbh->prepare($sql5a);
	my $sql7a = "DELETE FROM topicscontentorder WHERE topicid= ?";
	my $sth7a = $dbh->prepare($sql7a);
	$sth4->execute($id_sel); 
	$sth5a->execute($id_sel); 
	$sth6->execute($id_sel); 
	$sth7->execute($id_sel); 
	$sth7a->execute($id_sel); 
	for $id (@ids){ 
	    $sth4->execute($id); 
	    $sth5->execute($id); 
	    $sth5a->execute($id); 
	    $sth6->execute($id); 
	    $sth7->execute($id); 
	    $sth7a->execute($id); 
	}
	$sth4->finish;
	$sth5->finish;
	$sth5a->finish;
	$sth6->finish;
	$sth7->finish;
	$sth7a->finish;



	my $sql2 = "CREATE TABLE topics_tmp AS SELECT * FROM topics WHERE topicid = ?";
	my $sth2 = $dbh->prepare($sql2);
	my $sql3 = "INSERT INTO topics_tmp  SELECT * FROM topics WHERE topicid = ?";
	my $sth3 = $dbh->prepare($sql3);
	my $sql3a = "DELETE FROM topics WHERE topicid = ?";
	my $sth3a = $dbh->prepare($sql3a);

	$sth2->execute($id_sel) || die $sth2->errstr; 
	for $id (@ids){ 
	    $sth3->execute($id) || die $sth3->errstr; 
	}
	# For the delete action traverse the tree in reverse order,
	# so we use reverse(@ids)
	for $id (reverse(@ids)){ 
	    $sth3a->execute($id) || die $sth3a->errstr; 
	}
	# root element of the subtree is removed last. 
	$sth3a->execute($id_sel) || die $sth2->errstr; 

	$sth2->finish;
	$sth3->finish;
	$sth3a->finish;


	# Remove selected list items
	$tplist->delete('entry', $tp_sel);	

	# Update $tp_buffer and label
	my $tp_buffer = get_tp_buffer_dcr();
	$tp_buffer_content->configure(text => $tp_buffer);
    }
}

# Display an image
# The first argument $w is the widget returned by the calling 'bind' action 
sub display_image {
    my ($w, $file) = @_;

    if(defined($file) && $file){
	my $imgwindow = new MainWindow(
	    -background => 'white',
	);
	$imgwindow->resizable('no','no');

	my $label = $imgwindow->Label();
	my $imagewidget = undef;


	$imagewidget = $label->Photo(-format => 'jpeg', -file => $file);
	if(defined($@) && $@){
	    $label->configure('-text' => "$@");
	}

	if(defined($imagewidget) && $imagewidget){
	    $label->configure(image=>$imagewidget);
	}

	$label->pack;
	$imgwindow->title($file);
    }
}

# Open a window with a table of thumbnails for selected keywords
# and admin options
sub admin_rl {
    my @rl_ed_selected = get_rl_selected($rllist);
    if (@rl_ed_selected){
	my @picids = get_rl_picids(@rl_ed_selected);
	if ($debug){
	    print "admin_rl: selected picids\n";
	    for my $id (@picids){ print "$id, "; }
	    print "\n";
	} 
	show_thumbs(\@picids,\@rl_ed_selected,undef,undef);
    } else {
	popup_mesg("No roll(s) selected");
	return
    }
}

# Open a window with a table of thumbnails for selected keywords
# and admin options
sub admin_kw {
    my @kw_ed_selected = get_kw_selected($kwlist);
    if (@kw_ed_selected){
	my @picids = get_kw_picids(@kw_ed_selected);
	show_thumbs(\@picids,undef,\@kw_ed_selected,undef);
    } else {
	popup_mesg("No keyword(s) selected");
	return
    }
}

# Open a window with a table of thumbnails for selected item
# and admin options
sub admin_tp {
    $tplist = shift;

    my @tp = get_tp_selected($tplist);
    if ($#tp > 0){
	popup_mesg("Admin topics: supported for one topic only");
	return
    }
    my $tp_ed_selected = $tp[0];
    if ($tp_ed_selected){
	my $topicid = get_topicid($tp_ed_selected);
	my @picids = get_tp_picids($topicid);
	show_thumbs(\@picids,undef,undef,$tp_ed_selected);
    } else {
	popup_mesg("No topic selected");
	return
    }
}

# Drop temporary database buffer of keywords, used in cut/paste/merge action
sub empty_kw_buffer{
    my $sql = "DROP TABLE keywords_tmp";
    my $sth = $dbh->prepare($sql);
    if(table_exists('keywords_tmp')){ 
	$sth->execute;
    }
    $sth->finish;

    $sql = "DROP TABLE keywords_tmp1";
    $sth = $dbh->prepare($sql);
    if(table_exists('keywords_tmp1')){ 
	$sth->execute;
    }
    $sth->finish;
}

# Drop temporary database buffer of topics, used in cut/paste action
sub empty_tp_buffer{
    my $sql = "DROP table topicscontent_tmp";
    my $sth = $dbh->prepare($sql);
    if(table_exists('topicscontent_tmp')){ 
	$sth->execute;
    }
    $sth->finish;

    $sql = "DROP table topics_tmp";
    $sth = $dbh->prepare($sql);
    if(table_exists('topics_tmp')){ 
	$sth->execute;
    }
    $sth->finish;
}

# Get description (topic name) for a given topicid
sub get_descr {
    my $topicid = shift;
    my $sth = $dbh->prepare(q{ SELECT * FROM topics WHERE topicid = ? });
    $sth->execute($topicid);

    my $row = $sth->fetchrow_hashref; 
    my $dcr = $row->{description};
    $sth->finish;
    return $dcr
} 

# Store keywords in the keywords_tmp table in the global variable
sub get_kw_buffer{
    my $kw_buffer;

    if(table_exists('keywords_tmp')){ 
	my $sql = "SELECT value FROM keywords_tmp group by value" ;
	my $sth = $dbh->prepare($sql);
	$sth->execute();
	my @keywords=();
	do{
	    $row = $sth->fetchrow_hashref; 
	    $kw = $row->{value};
	    ($kw) && push(@keywords,$kw);
	}while ($kw);
	$sth->finish();
	$kw_buffer = join (',', @keywords);
    }

    return $kw_buffer;
}

# Return array with picids for keywords in @kw
sub get_kw_picids{
    my @kw = @_; 

    if (@kw){
	my $kws = join (',', @kw);
	my @thumb;

	my $min_show_rate_ref = $min_show_rate_scale->cget(-variable);
	my $min_show_rate_on_ref = $min_show_rate_cb->cget(-variable);

	# Prepare the SQL-query for an ALL-keywords search 
	my ($kw, $str1, $str2, $str3, $str4);
	my $i=0;
	for $kw (@kw){
	    $i++;
	    $str1 .= "keywords AS kw"."$i, ";

	    if ($i == 1) {
		$str2 .= "kw".$i.".value = ? ";
	    } else {
		$str2 .= "AND kw".$i.".value = ? ";
	    }

	    $str3 .= "AND kw"."$i".".pictureid = pictures.pictureid ";

	    if ($$min_show_rate_on_ref){
		$str4 = "AND pictures.averagerate >= $$min_show_rate_ref "
	    } else {
		$str4 = '';
	    }

	}
	my $sql = "SELECT * FROM ".$str1."pictures WHERE ".$str2.$str3.$str4;
	my $sth = $dbh->prepare($sql);

	# Execute $sth 
	$sth->execute(@kw) || die $sth->errstr; 

	# Print the maching picture file names to $file
	my $rows = $sth->rows;
	my $picid;
	my @picids;
	if ($rows){
	    do {
		my $row = $sth->fetchrow_hashref; 
		$picid = $row->{pictureid};
		if ($picid){
		    push (@picids, $picid);
		}
	    }while ($picid);
	}
	return sort @picids;
    }
}

# Get a sorted array of the selected keywords
sub get_kw_selected{
    my $kwlist = shift;
    my @kw = $kwlist->info('selection');
    if (@kw){
	($debug) && print "get_kw_selected: @kw\n";
    } else {
	@kw=();
    }
    return @kw;
}

# Get a sorted array of the all keywords in $kwlist
sub get_kw_inbox{
    my $kwlist = shift;
    my @kwinlist = $kwlist->info('children');
    ($debug) && print "get_kw_inbox: keywords(s) in kwlist: @kwinlist\n";
    return @kwinlist;
}

# Get sorted array @keywords of current keywords from the database
sub get_kw_stored{
    my $sql = "SELECT value FROM keywords GROUP BY value";
    my $sth = $dbh->prepare($sql);
    $sth->execute;
    my $row;
    my $kw;
    my @keywords=();
    do{
	$row = $sth->fetchrow_hashref; 
	$kw = $row->{value};
	($kw) && push(@keywords,$kw);
    }while ($kw);
    $sth->finish;
    return @keywords;
}

# Return array with picids of a topicid
sub get_rl_picids{
    my @rollids = @_;
    if ($debug){ 
	print "get_rl_picids: processing: rollids\n";
	for my $rollid (@rollids){ print "$rollid, "};
    }
    print "\n";

    my @picids;
    for my $rollid (@rollids){
	if ($rollid){
	    my @thumb;

	    my $min_show_rate_ref = $min_show_rate_scale->cget(-variable);
	    my $min_show_rate_on_ref = $min_show_rate_cb->cget(-variable);

	    my $sql; 

	    if ($$min_show_rate_on_ref){
		$sql = "SELECT * FROM  pictures
		WHERE rollid = ?
		AND pictures.averagerate >= $$min_show_rate_ref "
	    } else {
		$sql = "SELECT * FROM pictures WHERE rollid = ?";
	    }

	    my $sth = $dbh->prepare($sql);

	    # Execute $sth 
	    $sth->execute($rollid) || die $sth->errstr; 

	    my $rows = $sth->rows;
	    my $picid;
	    if ($rows){
		do {
		    my $row = $sth->fetchrow_hashref; 
		    $picid = $row->{pictureid};
		    if ($picid){
			push (@picids, $picid);
		    }
		}while ($picid);
	    } else {
		print "No pictures in rollid $rollid \n";
	    }
	    $sth->finish;
	}
    }
    return sort @picids;
}

# Get an array of the selected rollids
sub get_rl_selected{
    my $rllist = shift;
    my @rl = $rllist->info('selection');
    if (@rl){
	($debug) && print "get_rl_selected: @rl\n";
    } else {
	@rl=();
    }
    my $rollid;
    my @rollids;
    for my $rollname (@rl){
	$rollid = "$username/$rollname";
	push (@rollids,$rollid);
    }
    return @rollids;
}

# Get sorted array of stored rollnames for the current user 
sub get_rl_stored{
    my $sql = "SELECT rollid FROM rolls WHERE owner = $userid GROUP BY rollid";
    my $sth = $dbh->prepare($sql);
    $sth->execute;
    my $row;
    my $rollid;	  # e.g. rob/1999a
    my $rollname; # e.g. 1999a 
    my @rollnames=();
    do{
	$row = $sth->fetchrow_hashref; 
	$rollid = $row->{rollid};
	$rollname = $rollid;
	($rollid) && $rollname =~ s/$username\///;
	($rollid) && push(@rollnames,$rollname);
    }while ($rollid);
    $sth->finish;
    return @rollnames;
}

# Get rating from array @rb of radio buttons
sub get_selected_rating{
    my $rb= shift; 

    #By default the variable selectedButton is used in cget(-variable) ;
    #its contents give the name of the button that is selected.
    #Here also 1,2,...,10
    my $selected_rating_ref = $$rb[1]->cget(-variable) ;

    my $selected_rating=$$selected_rating_ref;

    return $selected_rating;
}

# Get sorted array of current source directory names 
sub read_dir {
    my $dir = shift;
    my $ext = shift;

    my @files = qw();
    my $DIRH = undef;
    my $errflag = 0;

    opendir(DIRH, $dir) or $errflag = 1;
    if($errflag == 1){
	warn("Error:  Couldn't open directory $dir: $!\n");
	return undef;
    }

    @files = readdir(DIRH) or $errflag = 1;
    if($errflag == 1){
	warn("Error:  Couldn't read directory $srcdir:  $!\n");
	return undef;
    }

    # filter_filenames
    my @accepted;
    my $file_ext;
    foreach my $item (@files){
	if( $item =~ /.*\.(.*$)/){ $file_ext = $1}

	if ($ext){
	    if( $file_ext eq $ext &&
	    ! ( $item eq ".") && 
	    ! ( $item eq "..") ){
		push @accepted, $item;
	    }
	} else{
	    if ( ! ( $item eq ".") && 
	    ! ( $item eq "..") ){
		push @accepted, $item;
	    }
	}
    }
    @files = sort(@accepted);
    closedir(DIRH);

    return  @files;
}

# Toggle state ((in)active) of picture $w in the table $t and update hash
# %cells of active cells in the table and the array @selected_picids
sub select_picture {
    my ($w, $t, $picids, $selected_picids, $cells, $table_cols) = @_;

    my ($r, $c) = $t->Posn( $w );
    my $nr = ($r/2) * $table_cols + $c;
    if (exists($$cells{$nr})) {
	delete($$cells{$nr}); 

	# Show unselected 
	my $w;
	$w = $t->get($r, $c);
	$w->configure(-background => 'white');

	($debug) && print "select_picture: ($r,$c) unselected: ";
	($debug) && print "select_picture: picid: $$picids[$nr]\n";
    } else {
	$$cells{$nr} = int($nr); 

	# Show selected
	my $w;
	$w = $t->get($r, $c);
	$w->configure(-background => 'blue');

	($debug) && print "select_picture: ($r,$c) selected: ";
	($debug) && print "select_picture: picid: $$picids[$nr]\n";
    }

    @$selected_picids = ();
    my @nrs = keys %$cells ;
    for my $n (@nrs){
	push (@$selected_picids, $$picids[$n]); 
    }
}

# Get pictureid for given rollid and frameid 
sub get_picid{
    my $rollid = shift;
    my $frameid = shift;

    $sql = "SELECT pictureid FROM pictures WHERE rollid = ? AND frameid = ?";
    my $sth = $dbh->prepare($sql);

    $sth->execute($rollid, $frameid); 
    my $row = $sth->fetchrow_hashref; 
    $sth->finish;

    my $picid = $row->{pictureid};
    ($picid) or die "Determination of pictureid failed"; 
    ($debug) && print "get_picid: pictureid =".$picid."\n";

    return $picid;
}

# Get keywords for given pictureid
sub get_picture_keywords{
    my $picid = shift;

    my $sql = "SELECT * FROM keywords WHERE pictureid = ? ORDER BY value";
    my $sth = $dbh->prepare($sql);
    # Execute $sth 
    $sth->execute($picid) || die $sth->errstr; 

    # Print the maching picture file names to $file
    my $rows = $sth->rows;
    my $keyword;
    my @keywords;
    if ($rows){
	do {
	    my $row = $sth->fetchrow_hashref; 
	    $keyword = $row->{value};
	    if ($keyword){
		push (@keywords, $keyword);
	    }
	}while ($keyword);
    }

    return @keywords;
}

# Get topics for given pictureid
sub get_picture_topics{
    my $picid = shift;

    my $sql = "SELECT * FROM topicscontent WHERE pictureid = ? ORDER BY topicid";
    my $sth = $dbh->prepare($sql);
    # Execute $sth 
    $sth->execute($picid) || die $sth->errstr; 

    # Print the maching picture file names to $file
    my $rows = $sth->rows;
    my $topicid;
    my $topic;
    my @topics;
    if ($rows){
	do {
	    my $row = $sth->fetchrow_hashref; 
	    $topicid = $row->{topicid};
	    $topic = get_topic($topicid);
	    if ($topicid){
		push (@topics, $topic);
	    }
	}while ($topicid);
    }

    return @topics;
}

# Get get_subtopicids for given topicid
sub get_subtopicids {
    my $parenttopicid = shift;

    my @ids;
    my ($row, $dcr, $id);
    my $sth = $dbh->prepare( q{ SELECT * FROM topics WHERE parenttopicid = ?  });
    $sth->execute($parenttopicid);

    do{
	$row = $sth->fetchrow_hashref; 
	$dcr = $row->{description};
	$id = $row->{topicid};
	if ($id) {push(@ids,$id)};
    }while ($dcr);

    $sth->finish;
    return @ids
} 


# Get topic (including :-separated list of parenttopics)
# for given topicid
sub get_topic{
    my $id = shift;

    my $sql = "SELECT * FROM topics  WHERE topicid = ?";
    my $sth = $dbh->prepare($sql);
    my $topicstr = '';
    my ($row, $dsc, $pt, $id0);
    do {
	$sth->execute($id);
	$row = $sth->fetchrow_hashref; 
	$dsc = $row->{description};
	$pt = $row->{parenttopicid};

	$id0 = $id;
	$id=$pt;
	if($topicstr){
	    $topicstr = $dsc.":".$topicstr;
	}else{
	    $topicstr = $dsc;
	}
    } while ($id0);
    $sth->finish;

    return $topicstr;
}

# get topicid for given topic
sub get_topicid{
    my $topic = shift;
    my $id;
    if ($topic){
	my @dsc = split(":",$topic);

	my $sql = "SELECT * FROM topics  WHERE parenttopicid = ? AND description = ?";
	my $sth = $dbh->prepare($sql);
	my ($i, $row);

	my $pt=0;
	$id=0;
	for ($i=1; $i<= $#dsc; $i++ ){
	    # We skip the root topic ($i = 0, $pt = NULL, $dsc[0] = 'All Pictures')
	    # and start with $i=1 and $pt=0 
	    $sth->execute($pt,$dsc[$i]);
	    $row = $sth->fetchrow_hashref; 
	    $pt = $row->{parenttopicid};
	    $id = $row->{topicid};
	    $pt = $id;
	}
	$sth->finish;
    }
    return $id;
}

# get topicids (@ids) for given topics (@tp)
sub get_topicids{
    my @tp = @_;
    my @ids;
    my $id;
    if (@tp){
	for my $tp (@tp){
	    $id = get_topicid($tp);
	    push (@ids, $id);
	}
    }
    ($debug) && print "get_topicids: @ids\n";
    return @ids;
}


# returns the topic name of the current topic in the buffer 
sub get_tp_buffer_dcr{
    my $dcr; 
    if(table_exists('topics_tmp')){ 
	my $sql = "SELECT * FROM topics_tmp";
	my $sth = $dbh->prepare($sql);
	$sth->execute(); 

	my $row = $sth->fetchrow_hashref; 
	my $pt = $row->{parenttopicid};
	my $tp= $row->{topicid};
	$dcr = $row->{description};
	my $sql1 = "SELECT * FROM topics_tmp where topicid = ?";
	my $sth1 = $dbh->prepare($sql1);
	my $id;
	do{
	    $id = $pt;
	    $sth1->execute($id);
	    $row = $sth1->fetchrow_hashref; 
	    if ($row){
		$pt = $row->{parenttopicid};
		$tp= $row->{topicid};
		$dcr = $row->{description};
	    }	
	} while ($row);
    }
    return ($dcr);
}

# returns the topicid of the current topic in the buffer 
sub get_tp_buffer_id{
    my $sql = "SELECT * FROM topics_tmp";
    my $sth = $dbh->prepare($sql);
    $sth->execute();

    my $row = $sth->fetchrow_hashref; 
    my $pt = $row->{parenttopicid};
    my $tp= $row->{topicid};
    my $dcr = $row->{description};
    my $sql1 = "SELECT * FROM topics_tmp where topicid = ?";
    my $sth1 = $dbh->prepare($sql1);
    my $id;
    do{
	$id = $pt;
	$sth1->execute($id);
	$row = $sth1->fetchrow_hashref; 
	if ($row){
	    $pt = $row->{parenttopicid};
	    $tp= $row->{topicid};
	    $dcr = $row->{description};
	}	
    } while ($row);
    return ($tp);
}

# Return array with picids of a topicid
sub get_tp_picids{
    my $topicid = shift;

    if ($topicid){
	my @thumb;

	my $min_show_rate_ref = $min_show_rate_scale->cget(-variable);
	my $min_show_rate_on_ref = $min_show_rate_cb->cget(-variable);

	my $sql; 

	if ($$min_show_rate_on_ref){
	    $sql = "SELECT * FROM topicscontent, pictures
	    WHERE topicscontent.topicid = ? 
	    AND topicscontent.pictureid = pictures.pictureid
	    AND pictures.averagerate >= $$min_show_rate_ref "
	} else {
	    $sql = "SELECT * FROM topicscontent WHERE topicid = ?";
	}

	my $sth = $dbh->prepare($sql);

	# Execute $sth 
	$sth->execute($topicid) || die $sth->errstr; 

	my $rows = $sth->rows;
	my $picid;
	my @picids;
	if ($rows){
	    do {
		my $row = $sth->fetchrow_hashref; 
		$picid = $row->{pictureid};
		if ($picid){
		    push (@picids, $picid);
		}
	    }while ($picid);
	} else {
	    print "No matching pictures for topicid $topicid \n";
	}
	return sort @picids;
    }
}

# Get a sorted array of the selected topics 
sub get_tp_selected{
    my $tplist = shift;

    my @tp = $tplist->info('selection');
    if (@tp){
	($debug) && print "get_tp_selected: @tp\n";
    } else {
	@tp=();
    }
    return @tp;
}

# Link selected keywords to selected pictures
sub link_selected_keywords_to_selected_pictures{
    my $kwlist = shift;
    my $selected_picids = shift;

    my @selected_keywords = get_kw_selected($kwlist);
    for my $picid (@$selected_picids){
	store_keywords_data($picid, @selected_keywords)
    }
}

# Link selected topic to selected pictures
sub link_selected_topic_to_selected_pictures{
    my $tplist = shift;
    my $selected_picids = shift;

    my @tp = get_tp_selected($tplist);
    for my $tp_selected (@tp){
	my $tpid_selected = get_topicid($tp_selected);
	for my $picid (@$selected_picids){
	    store_topicscontent_data($picid, $tpid_selected, undef);
	    store_topicscontentorder_data($picid, $tpid_selected, undef);
	}
    }
}

sub load_settings {
    unless(open(FILE, "$toftool_cfg")) {
	print "Tofshow error: could not find file $toftool_cfg \n"; 
	exit;
    }

    while(my $line = <FILE>) {
	if( $line =~ /^debug: (.*)/)       { $debug = $1; next; }
	if( $line =~ /^dbname: (.*)/)       { $dbname = $1; next; }
	if( $line =~ /^imagedir: (.*)/)             { $imagedir = $1; next; }
	if( $line =~ /^srcdir: (.*)/)          { $srcdir = $1; next; }
	if( $line =~ /^thumbnail_options: (.*)/) { $thumbnail_options = $1; next; }
	if( $line =~ /^image_options: (.*)/)             { $image_options = $1; next; }
    }

    close FILE;
}

# Merge pictures related keywords in $kw_buffer with pictures related to
# selected keyword(s)
sub merge_kw{
    if (table_exists('keywords_tmp1')){
	# Copy table keywords_tmp to keywords_tmp1
	my $sql1 = "DROP TABLE keywords_tmp1";
	my $sth1 = $dbh->prepare($sql1);
	$sth1->execute(); 
	$sth1->finish;
    }
    if (table_exists('keywords_tmp')){
	my $sql2 = "CREATE TABLE keywords_tmp1 AS SELECT * FROM keywords_tmp"; 
	my $sth2 = $dbh->prepare($sql2);
	$sth2->execute(); 
	$sth2->finish;

	# Merge with each of the selected keywords
	my $sql3 = "UPDATE keywords_tmp1 SET value = ?";
	my $sth3 = $dbh->prepare($sql3);
	my $sql4 = "SELECT * from keywords_tmp1";
	my $sth4 = $dbh->prepare($sql4);

	my @kw_selected = get_kw_selected($kwlist);
	for my $kw_sel (@kw_selected){
	    # For each selected keyword set value in table keywords_tmp1 
	    # and update keywords table for all matching pictures
	    $sth3->execute($kw_sel); 
	    $sth4->execute();
	    my ($row, $id, $kw, $kw_prev);
	    do{
		$row = $sth4->fetchrow_hashref; 
		$id = $row->{pictureid};
		$kw = $row->{value};
		if ($id){
		    store_keywords_data($id,$kw);
		}
	    }while ($kw);
	}
	$sth3->finish;
	$sth4->finish;
    }
}

sub open_kw_admin_frame{
    $kw_admin_frame = $kw->Frame(
	-background => 'white',
    )->pack;

    my $kw_admin_frame1 = $kw_admin_frame->Frame(
	-background => 'white',
    )->pack;

    my $kwentry_label = $kw_admin_frame1->Label(
	-background => 'white',
	-text => 'New:'
    )->pack( 
	-side => 'left',
	-fill => "x"
    );

    $kwentry = $kw_admin_frame1->Entry(
	-width => 20
    )->pack(
	-side => 'left'
    );

    my $kwentrybutton = $kw_admin_frame1->Button(
	-text => "Add",
	-command => sub {
	    add_kw($kwentry)
	}
    )->pack(
	-side => 'left' 
    );

    # Keyword view buttons
    my $kw_admin_frame2 = $kw_admin_frame->Frame(
	-background => 'white',
    )->pack;

    my $kw_view_button = $kw_admin_frame2->Button(
	-text => "Update",
	-command => \&update_kw
    )->pack(
	-side => "left",
	-fill => "x"
    );

    my $kw_admin_button = $kw_admin_frame2->Button(
	-text => "Admin",
	-command => \&admin_kw
    )->pack(
	-side => "left",
	-fill => "x"
    );

    # Keyword cut/paste  buttons
    my $kw_admin_frame3 = $kw_admin_frame->Frame(
	-background => 'white',
    )->pack;

    my $kw_copy_button = $kw_admin_frame3->Button(
	-text => "Copy",
	-command => sub {
	    copy_kw($kw_buffer_content);
	}
    )->pack(
	-side => "left",
	-fill => "x"
    );

    my $kw_cut_button = $kw_admin_frame3->Button(
	-text => "Cut",
	-command => sub{
	    my @kw_selected = get_kw_selected($kwlist);
	    if(@kw_selected){
		my $window = new MainWindow(
		    -background => 'white',
		);
		$window->resizable('no','no');
		my $label = $window->Label(
		    -text => "Removing selected keyword(s), are you sure?",
		    -background => 'yellow',
		)->pack();
		my $OK    = $window->Button(
		    '-text' => 'OK',
		    '-command' => sub {
			cut_kw_selected($kw_buffer_content);
			$window->destroy(); 
		    }
		)->pack(
		    -side => 'left'
		);
		my $CANCEL = $window->Button(
		    '-text' => 'Cancel',
		    '-command' => sub { $window->destroy(); }
		)->pack(
		    '-side' => 'right'
		);
	    }
	}
    )->pack(
	-side => "left",
	-fill => "x"
    );


    my $kw_restore_button = $kw_admin_frame3->Button(
	-text => "Restore",
	-command => \&restore_kw
    )->pack(
	-side => "left",
	-fill => "x"
    );

    my $kw_merge_button = $kw_admin_frame3->Button(
	-text => "Merge",
	-command => \&merge_kw
    )->pack(
	-side => "left",
	-fill => "x"
    );

    # Keyword buffer info
    my $kw_admin_frame4 = $kw_admin_frame->Frame(
	-background => 'white',
    )->pack;

    my $kw_buffer = get_kw_buffer();

    my $kw_buffer_label = $kw_admin_frame4->Label(
	-background => 'white',
	-text => 'Buffer: '
    )->pack(
	-fill => "x",
	-side => 'left'
    );

    $kw_buffer_content = $kw_admin_frame4->Label(
	-text => $kw_buffer,
	-background => 'white'
    )->pack(
	-fill => "x",
	-side => 'left'
    );
}

sub open_rl_admin_frame{
    $rl_admin_frame = $rl->Frame(
	-background => 'white',
    )->pack;
    my $rl_admin_frame1 = $rl_admin_frame->Frame(
	-background => 'white',
    )->pack;

    my $rlentry_label = $rl_admin_frame1->Label(
	-background => 'white',
	-text => 'New:'
    )->pack(
	-fill => "x",
	-side => 'left'
    );

    $rlentry = $rl_admin_frame1->Entry(
	width => 20
    )->pack(
	-side => "left",
	-fill => "x"
    );
    my $rlentrybutton = $rl_admin_frame1->Button(
	-text => "Add",
	-command => sub{
	    add_rl();
	}
    )->pack(
	-side => 'left' 
    );


    my $rl_admin_frame2 = $rl_admin_frame->Frame(
	-background => 'white',
    )->pack;
    $rl_admin_frame2->Button(
	-text => "Update",
	-command => \&update_rl
    )->pack(
	-side => "left",
	-fill => "x"
    );
    $rl_admin_frame2->Button(
	-text => "Import",
	-command => \&import_rl
    )->pack(
	-side => "left",
	-fill => "x"
    );

    $rl_admin_frame2->Button(
	-text => "Admin",
	-command => \&admin_rl
    )->pack(
	-side => "left",
	-fill => "x"
    );

    my $rl_admin_frame3 = $rl_admin_frame->Frame(
	-background => 'white',
    )->pack;

    $rl_admin_frame3->Button(
	-text => "Delete",
	-command => sub{
	    my @rl_selected = get_rl_selected($rllist);
	    if(@rl_selected){
		my $window = new MainWindow(
		    -background => 'white',
		);
		$window->resizable('no','no');
		my $label = $window->Label(
		    -text => "Removing selected roll(s), are you sure?",
		    -background => 'yellow',
		)->pack();
		my $OK    = $window->Button('-text' => 'OK',
		'-command' => sub {
		    cut_rl_selected();
		    # remove $srcdir (if empty)
		    for my $dir (@rl_selected){
			$dir =~ s/$username\///;
			rmdir "$srcdir/$dir";
		    }
		    $window->destroy(); 
		    show_rllist();
		}
	    )->pack(
		-side => 'left'
	    );
	    my $CANCEL = $window->Button(
		'-text' => 'Cancel',
		'-command' => sub { $window->destroy(); }
	    )->pack(
		'-side' => 'right'
	    );
	}
    }
)->pack(
    -side => "left",
    -fill => "x"
);
}

sub open_tp_admin_frame {
    my $tp_buffer_content_ref = shift;

    $tp_admin_frame = $tp->Frame(
	-background => 'white',
    )->pack;
    my $tp_admin_frame1 = $tp_admin_frame->Frame(
	-background => 'white',
    )->pack;

    my $tpentry_label = $tp_admin_frame1->Label(
	-background => 'white',
	-text => 'New:'
    )->pack(
	-fill => "x",
	-side => 'left'
    );

    $tpentry = $tp_admin_frame1->Entry(
	-width => 20
    )->pack(
	-side => "left",
	-fill => "x"
    );
    my $tpentrybutton = $tp_admin_frame1->Button(
	-text => "Add",
	-command => sub{
	    add_tp($tplist)
	}
    )->pack(
	-side => 'left' 
    );


    # Topics buttons
    my $tp_admin_frame2 = $tp_admin_frame->Frame(
	-background => 'white',
    )->pack;

    my $topic_view_button = $tp_admin_frame2->Button(
	-text => "Update",
	-command => sub{
	    update_tp($tplist)
	}
    )->pack(
	-side => "left",
	-fill => "x"
    );

    my $tp_admin_button = $tp_admin_frame2->Button(
	-text => "Admin",
	-command => sub{
	    admin_tp($tplist)
	}
    )->pack(
	-side => "left",
	-fill => "x"
    );

    # Topics cut/paste  buttons
    my $tp_admin_frame3 = $tp_admin_frame->Frame(
	-background => 'white',
    );
    $tp_admin_frame3->pack;

    my $tp_cut_button = $tp_admin_frame3->Button(
	-text => "Cut",
	-command => sub{
	    my @tp_selected = get_tp_selected($tplist);
	    if ($#tp_selected > 0){
		popup_mesg("Cut: supported only for one topic");
		return
	    }
	    if(@tp_selected){
		my $window = new MainWindow(
		    -background => 'white',
		);
		$window->resizable('no','no');
		my $label = $window->Label(
		    -text => "Removing selected topic and subtopics, are you sure?",
		    -background => 'yellow',
		)->pack();
		my $OK    = $window->Button(
		    '-text' => 'OK',
		    '-command' => sub {
			cut_tp_tree_selected($tplist);
			$window->destroy(); 
		    }
		)->pack(
		    -side => 'left'
		);
		my $CANCEL = $window->Button(
		    '-text' => 'Cancel',
		    '-command' => sub { $window->destroy(); }
		)->pack(
		    '-side' => 'right'
		);
	    }
	}
    )->pack(
	-side => "left",
	-fill => "x"
    );

    my $tp_restore_button = $tp_admin_frame3->Button(
	-text => "Restore",
	-command => \&restore_tp
    )->pack(
	-side => "left",
	-fill => "x"
    );

    my $tp_paste_button = $tp_admin_frame3->Button(
	-text => "Paste",
	-command => sub{
	    paste_tp($tplist);
	}
    )->pack(
	-side => "left",
	-fill => "x"
    );

    # Topic buffer info
    my $tp_admin_frame4 = $tp_admin_frame->Frame(
	-background => 'white',
    )->pack;
    my $tp_buffer = get_tp_buffer_dcr();

    my $tp_buffer_label = $tp_admin_frame4->Label(
	-background => 'white',
	-text => 'Buffer: '
    )->pack(
	-fill => "x",
	-side => 'left'
    );

    $tp_buffer_content = $tp_admin_frame4->Label(
	-text => $tp_buffer,
	-background => 'white'
    )->pack(
	-fill => "x",
	-side => 'left'
    );
}

# Open frame with buttons for view or slideshow selection 
sub open_view_frame {
    $view_frame = $mw->Frame(
	-background => '#bbccff',
    )->pack(
	-side => 'top',
	-fill => 'x',
    );

    my $view_frame_line1 = $view_frame->Frame(
    )->pack(
	-side => 'top',
    );

    #default rolls setting: select any 
    $rl_rb_any->invoke;
    #default kw setting: select all 
    $kw_rb_any->invoke;
    #default tp setting: select any 
    $tp_rb_any->invoke;

    my $view_button;
    my $slideshow_button;
    $view_button = $view_frame_line1->Button(
	-text => "Thumbnails",
	-command => sub{
	    run_selection($rllist,$kwlist,$tplist);
	    view_selection();
	}
    )->pack(
	-side => "left",
    );
    $slideshow_button = $view_frame_line1->Button(
	-text => "Slideshow",
	-command => sub{
	    run_selection($rllist,$kwlist,$tplist);
	    slideshow_selection();
	}
    )->pack(
	-side => "left",
    );
}

# Paste topics list in cut-buffer at selected node in topics tree
sub paste_tp {
    my $tplist = shift;

    my @tp = get_tp_selected($tplist);
    if ($#tp > 0){
	popup_mesg("Paste: select just one topic");
	return
    }
    my $selected_tp = $tp[0];

    if(table_exists('topics_tmp') && $selected_tp ){ 
	my $buffer_topicid = get_tp_buffer_id;
	my $selected_tpid=get_topicid($selected_tp);

	my $sql = "UPDATE topics_tmp SET parenttopicid = ?  WHERE topicid = ?";
	my $sth = $dbh->prepare($sql);
	$sth->execute($selected_tpid,$buffer_topicid) ;
	$sth->finish;

	my $sql1 = "INSERT into TOPICS SELECT * FROM TOPICS_TMP";
	my $sth1 = $dbh->prepare($sql1);
	$sth1->execute();
	$sth1->finish;

	my $row;
	my $picid;
	my $topicid;
	my $tp_order;
	my $sql2 = "SELECT * FROM topicscontent_tmp"; 
	my $sth2 = $dbh->prepare($sql2);
	$sth2->execute();
	do{
	    $row = $sth2->fetchrow_hashref; 
	    $topicid = $row->{topicid};
	    $picid= $row->{pictureid};
	    store_topicscontent_data($picid, $topicid, undef);
	}while($topicid);
	$sth2->finish;

	my $sql3 = "SELECT * FROM topicscontentorder_tmp"; 
	my $sth3 = $dbh->prepare($sql3);
	$sth3->execute();
	do{
	    $row = $sth3->fetchrow_hashref; 
	    $topicid = $row->{topicid};
	    $tp_order= $row->{tp_order};
	    $picid= $row->{pictureid};
	    store_topicscontentorder_data($picid, $topicid, $tp_order);
	}while($topicid);
	$sth3->finish;

	$tplist->delete('all');
	empty_tp_buffer();
	show_tptree($tplist);
	# Update $tp_buffer and label
	my $tp_buffer = get_tp_buffer_dcr();
	$tp_buffer_content->configure(text => $tp_buffer);
    }
}

sub popup_mesg(@@) {
    my $popup = new MainWindow(
	-background => 'white',
    );
    $popup->resizable('no','no');
    foreach my $mesg (@_){
	my $label = $popup->Label('-text' => "$mesg", -background => 'yellow');
	$label->pack;
    }
    my $ok    = $popup->Button('-text'    => "OK",
    '-command' => sub { $popup->destroy; });
    $ok->pack();
}

# Help
sub print_help{
    print "
    -----------------------------------------------------------------------------
    $0
    -----------------------------------------------------------------------------
    Usage: $0 <options>


    Options:

    -d  <database name>
    -u  <username>
    -h	This message.
    -----------------------------------------------------------------------------
    ";
}

# Exit gracefully
sub quit {
    $dbh->disconnect;
    unlink $tmp_collfile;
    exit;
}

# Insert or update rating of a picture
sub rate_picture{
    my $userid = shift;
    my $picid = shift;
    my $rating = shift;

    # See if picuture is rated already by the user
    my $sql0 = q{SELECT * FROM notes WHERE userid = ? AND pictureid = ?};
    my $sth0 = $dbh->prepare($sql0);
    $sth0->execute($userid, $picid);
    my $rows = $sth0->rows;
    if ($rows == 0) { # not yet rated	
	# insert new row
	my $sql1 = q{INSERT INTO notes
	("userid", "pictureid", "note")
	VALUES
	(?,?,?)};
	my $sth1 = $dbh->prepare($sql1);
	$sth1->execute($userid, $picid, $rating);
	$sth1->finish;

	my $sql1a = qq{UPDATE pictures SET nbrates=nbrates+1, 
	sumrates = (sumrates + ?), 
	maxrate = (SELECT MAX(note) FROM notes WHERE pictureid=$picid), 
	minrate = (SELECT MIN(note) FROM notes WHERE pictureid=$picid)
	WHERE pictureid= ? };
	my $sth1a = $dbh->prepare($sql1a);
	$sth1a->execute($rating, $picid);
	$sth1a->finish;
	print "Rated: rating, pictureid: ($rating, $picid)\n";

    } else { # rated already earlier
	# recall the previous rating
	my $row = $sth0->fetchrow_hashref; 
	my $previous= $row->{note};
	# update matching row
	my $sql2 = q{UPDATE notes SET note = ?  WHERE pictureid= ? AND userid= ?};
	my $sth2 = $dbh->prepare($sql2);
	$sth2->execute($rating, $picid, $userid);
	$sth2->finish;

	my $sql2a = qq{UPDATE pictures SET
	sumrates = (sumrates - $previous + ?),
	maxrate = (SELECT MAX(note) FROM notes WHERE pictureid=$picid),
	minrate = (SELECT MIN(note) FROM notes WHERE pictureid=$picid)
	WHERE pictureid= ?};

	my $sth2a = $dbh->prepare($sql2a);
	print "Updated: previous, rating, pictureid: ($previous,$rating, $picid)\n";

	$sth2a->execute($rating, $picid);
	$sth2a->finish;
    }
    $sth0->finish;

    my $sql3 = q{UPDATE pictures SET averagerate=float4(sumrates) / nbrates WHERE pictureid= ?};
    my $sth3 = $dbh->prepare($sql3);
    $sth3->execute($picid);
    $sth3->finish;
}

# Used in show_thumbs
sub rate_selected_pictures{
    my ($rb,$selected_picids) = @_;

    my $selected_rating  = get_selected_rating($rb);
    if ($selected_rating && $selected_picids){
	for my $picid (@$selected_picids){
	    print "rate_picture($userid, $picid, $selected_rating)\n";
	    rate_picture($userid, $picid, $selected_rating);
	}
    }
}


# Reset kw selection and entry box
sub reset_kw {
    my $kwlist = shift;

    $kwlist->delete('all');
    my @keywords= get_kw_stored();
    show_kwlist($kwlist,@keywords);

    # $kwentry is defined only if admin frame is open so check: 
    if (defined $kwentry) {$kwentry->delete(0,'end')}
}

# Reset rl selection and entry box
sub reset_rl {
    $rllist->delete('all');
    show_rllist();

    if (defined $rlentry) {$rlentry->delete(0,'end')}
}

# Clear %cells hash of selected cells and reset background color in table
sub reset_pictures {
    my ($t, $picids, $cells, $table_cols, $rb) = @_;

    my $picid;

    my $nr=0;
    my $r=0;
    my $c=0;


    for $picid (@$picids){
	if ($c == $table_cols){$r+=2; $c=0}
	my $nr = ($r/2) * $table_cols + $c;
	if (exists($$cells{$nr})) {
	    delete($$cells{$nr}); 
	    my $w;
	    $w = $t->get($r, $c);
	    $w->configure(-background => 'white');
	}

	$c++;
	$nr++;
    }

    # deselect radiobuttons
    for (my $r =1; $r<=10; $r++){
	$$rb[$r]->deselect;
    }
}

# Reset tp selection and entry boes
sub reset_tp {
    my $tplist = shift;

    $tplist->delete('all');
    show_tptree($tplist);

    # $tpentry is defined only if admin frame is open so check: 
    if (defined $tpentry) {$tpentry->delete(0,'end')}
}

# Restore keywords list from cut-buffer
sub restore_kw {
    if(table_exists('keywords_tmp')){ 
	my $sql = "SELECT * FROM keywords_tmp ORDER BY VALUE";
	my $sth = $dbh->prepare($sql);
	$sth->execute();

	my ($row, $id, $kw, $kw_prev);
	do{
	    $row = $sth->fetchrow_hashref; 
	    $id = $row->{pictureid};
	    $kw = $row->{value};
	    $kw_prev = $kw;
	    if ($id){
		store_keywords_data($id,$kw);
	    }
	}while ($kw);
	$kwlist->delete(0,'end');
	my @keywords = get_kw_stored;
	show_kwlist($kwlist,@keywords);
    }
}

# Restore topics list in cut-buffer at previous node in topics tree
sub restore_tp {
    if(table_exists('topics_tmp')){ 
	my $sql1 = "INSERT into TOPICS SELECT * FROM TOPICS_TMP";
	my $sth1 = $dbh->prepare($sql1);
	$sth1->execute();
	$sth1->finish;

	my $row;
	my $picid;
	my $topicid;
	my $tp_order;
	my $sql2 = "SELECT * FROM topicscontent_tmp"; 
	my $sth2 = $dbh->prepare($sql2);
	$sth2->execute();
	do{
	    $row = $sth2->fetchrow_hashref; 
	    $topicid = $row->{topicid};
	    $picid= $row->{pictureid};
	    store_topicscontent_data($picid, $topicid);
	}while($topicid);
	$sth2->finish;

	my $sql3 = "SELECT * FROM topicscontentorder_tmp"; 
	my $sth3 = $dbh->prepare($sql3);
	$sth3->execute();
	do{
	    $row = $sth3->fetchrow_hashref; 
	    $topicid = $row->{topicid};
	    $tp_order= $row->{tp_order};
	    $picid= $row->{pictureid};
	    store_topicscontentorder_data($picid, $topicid, $tp_order);
	}while($topicid);
	$sth3->finish;


	$tplist->delete('all');
	empty_tp_buffer();
	show_tptree($tplist);
	# Update $tp_buffer and label
	my $tp_buffer = get_tp_buffer_dcr();
	$tp_buffer_content->configure(text => $tp_buffer);
    }
}

# Remove keywwords freom database
sub rm_keywords {
    my @kw = shift;

    if (@kw){
	my $str;
	# First remove keywords for current selection from keywords table
	# Prepare sql query string
	my $i=0;
	for $kw (@kw){
	    $i++;
	    if ($i == 1) {
		$str .= "value = ? ";
	    } else {
		$str .= "OR value = ? ";
	    }
	}
	my $sql = "DELETE FROM keywords WHERE ".$str;
	my $sth = $dbh->prepare($sql);
	$sth->execute(@kw); 
	$sth->finish;
    }
}

# Remove selected pictures from admin-collection.
# If the selection is based upon keywords, the keywords are unset for the
# selected pictures. If the selection is based upon a topic, the topic is
# unset for the selected pictures.
sub rm_pictures_from_selection{
    my ($rl_ed_selected,$kw_ed_selected,$tp_ed_selected,$selected_picids) = @_;

    if ($rl_ed_selected){

	my $sql = "DELETE FROM keywords WHERE pictureid = ?"; 
	my $sth = $dbh->prepare($sql);
	for my $picid (@$selected_picids){
	    $sth->execute($picid); 
	}
	$sth->finish;

	$sql = "DELETE FROM topicscontentorder WHERE pictureid= ?";
	$sth = $dbh->prepare($sql);
	for my $picid (@$selected_picids){
	    $sth->execute($picid); 
	}
	$sth->finish;

	$sql = "DELETE FROM topicscontent WHERE pictureid= ?"; 
	$sth = $dbh->prepare($sql);
	for my $picid (@$selected_picids){
	    $sth->execute($picid); 
	}
	$sth->finish;

	$sql = "DELETE FROM pictures WHERE pictureid = ?"; 
	$sth = $dbh->prepare($sql);
	for my $picid (@$selected_picids){
	    $sth->execute($picid); 
	}
	$sth->finish;
    }

    if ($kw_ed_selected){
	my $kws = join (',', @$kw_ed_selected);

	my ($kw, $str);
	my $i=0;
	for $kw (@$kw_ed_selected){
	    $i++;
	    if ($i == 1) {
		$str .= "pictureid = ? AND ( value = ? ";
	    } else {
		$str .= "OR value = ? ";
	    }
	}
	$str .= ")";
	my $sql = "DELETE FROM keywords WHERE ".$str;
	my $sth = $dbh->prepare($sql);
	for my $picid (@$selected_picids){
	    $sth->execute($picid,@$kw_ed_selected); 
	    ($debug)&& print "kw_ed_selected: removing picture $picid for keyword(s) $kws\n";
	}
	$sth->finish;
    }

    if ($tp_ed_selected){
	my $topicid=get_topicid($tp_ed_selected);
	my $sql = "DELETE FROM topicscontent WHERE pictureid= ? AND topicid = ?";
	my $sth = $dbh->prepare($sql);
	my $sql1 = "DELETE FROM topicscontentorder WHERE pictureid= ? AND topicid = ?";
	my $sth1 = $dbh->prepare($sql);
	for my $picid (@$selected_picids){
	    $sth1->execute($picid,$topicid); 
	    $sth->execute($picid,$topicid); 
	    ($debug)&& print "kw_ed_selected: removing picture $picid for topic $tp_ed_selected\n";
	}
	$sth->finish;
	$sth1->finish;
    }
}

# Remove topic from database
sub rm_topic {
    my $tp = shift;

    if($tp){
	my $topic_path = $tp; 
	$topic_path =~ s/:/\//g;

	my $topicid=get_topicid($tp);

	# First clear the table topicscontent for this topicid
	my $sql = "DELETE FROM topicscontent WHERE topicid = ?";
	my $sth = $dbh->prepare($sql);
	$sth->execute($topicid);
	$sth->finish;

	$sql = "DELETE FROM topicscontentorder WHERE topicid = ?";
	$sth = $dbh->prepare($sql);
	$sth->execute($topicid);
	$sth->finish;
    }
}

# Create query for given selection of rolls, keywords and topics
# and write $tmp_collfile
sub run_selection {
    my $rllist = shift;
    my $kwlist = shift;
    my $tplist = shift;
    my @selected_rolls = get_rl_selected($rllist);
    ($debug) && print "run_selection: rl=@selected_rolls\n";
    my @selected_keywords = get_kw_selected($kwlist);
    ($debug) && print "run_selection: kw=@selected_keywords\n";
    my @tp = get_tp_selected($tplist);
    ($debug) && print "run_selection: tp=@tp\n";
    my @id_sel=get_topicids(@tp);

    my $min_show_rate_on_ref = $min_show_rate_cb->cget(-variable);
    if (@selected_rolls || @selected_keywords || @id_sel || $$min_show_rate_on_ref ){
	unlink $tmp_collfile;
	write_collfile(\@selected_rolls,\@selected_keywords,\@id_sel);
    }
}

# View thumbnails of current $tmp_collfile

sub view_selection {
    unless(open(FILE, "$tmp_collfile")) { return }

    my $cmd = "gqview -t $tmp_collfile >/dev/null";
    system $cmd;
}



# Store keywords in the listbox
sub show_kwlist {
    my ($kwlist, @keywords) = @_; 
    for $kw (@keywords){
	$kwlist->add("$kw", -text => "$kw");
    }
}

# Store rolls names in the listbox
sub show_rllist {
    my @rollnames = read_dir($srcdir,undef);
    $rllist->delete('all');
    for $rl (@rollnames){
	$rllist->add("$rl", -text => "$rl");
    }
}


# Display window with table thumbnails of pictures in @$picids 
sub show_thumbs {
    my $picids = shift;
    my $rl_ed_selected = shift;
    my $kw_ed_selected = shift;
    my $tp_ed_selected = shift;
    my $kwbox_ed;
    my $header;
    if ($kw_ed_selected) {
	my $kws = join (', ', @$kw_ed_selected);
	$header .= "Keywords: $kws"
    }
    if ($tp_ed_selected) {$header .= "Topic: $tp_ed_selected"}
    if ($rl_ed_selected) {
	my $rls = join (', ', @$rl_ed_selected);
	$header .= "Rolls: $rls"
    }

    $header.="\n Use left mouse-button to (de)select or right button to show pictures";

    my @selected_picids;
    my %cells;
    my $table;
    my $table_rows = 4;
    my $table_cols = 5;

    my $mwp = new MainWindow(
	-background => 'white',
    );
    $mwp->resizable('no','no');

    my $topframe = $mwp->Frame(
	-background => 'white',
	-borderwidth => 4 
    )->pack(-fill => 'y');
    $topframe->Label(
	-background => 'white',
	-text => $header
    )->pack(-fill => 'y');

    $topframe->Label(
	-background => 'white',
	-text => "Show picture info:"
    )->pack (-side => 'left');
    my $cb_nr_info=$topframe->Checkbutton(
	-background => 'white',
	-text => "numbers"
    )->pack( -side => 'left' );
    my $cb_rl_info=$topframe->Checkbutton(
	-background => 'white',
	-text => "roll"
    )->pack( -side => 'left' );
    my $cb_kw_info=$topframe->Checkbutton(
	-background => 'white',
	-text => "keywords"
    )->pack( -side => 'left' );
    my $cb_tp_info=$topframe->Checkbutton(
	-background => 'white',
	-text => "topics"
    )->pack( -side => 'left' );
    my $cb_rt_info=$topframe->Checkbutton(
	-background => 'white',
	-text => "ratings"
    )->pack( -side => 'left' );

    # Select the checkbutton if $min_show_rate_on is selected
    my $min_show_rate_on_ref = $min_show_rate_cb->cget(-variable);
    if ($$min_show_rate_on_ref) {
	$cb_rt_info->select;
    }

    my $tableframe = $mwp->Frame(
	-background => 'white',
	-borderwidth => 4 
    )->pack(-fill => 'y');
    my $kw = $tableframe->Frame(
	-background => 'white',
    )->pack(-side => 'left');
    $kw->Label(
	-text => "Keywords",
	-background => '#bbccff',
    )->pack(-fill => 'x');

    $kwbox_ed = $kw->Scrolled(
	'HList',
	-selectmode => 'multiple',
	-background => 'white',
	-width => 0,
	-height => 20
    )->pack;

    my $kw3 = $kw->Frame(
	-background => 'white',
    )->pack;

    $kw3->Button(
	-text => "Clear",
	-command => sub{reset_kw($kwbox_ed)}
    )->pack(
	-side => "left",
	-fill => "x");

	my @keywords = get_kw_inbox($kwlist);
	show_kwlist($kwbox_ed,@keywords);

	my $tp = $tableframe->Frame(
	    -background => 'white',
	)->pack(-side => 'right');
	my $tpbox_frame = $tp->Frame(
	    -background => 'white',
	)->pack;
	$tpbox_frame->Label(
	    -text => "Topics",
	    -background => '#bbccff',
	)->pack(-fill => 'x');

	my $tplist_ed = $tpbox_frame->Scrolled (
	    'HList',
	    -background => 'white',
	    -separator => ':',
	    -width => 0,
	    -height => 20,
	    -selectmode => 'extended'
	)->pack;

	my $tp3 = $tp->Frame(
	    -background => 'white',
	)->pack;
	my $tp_reset_button = $tp3->Button(
	    -text => "Clear",
	    -command => sub{reset_tp($tplist_ed)}
	)->pack(
	    -side => "left",
	    -fill => "x"
	);

	show_tptree($tplist_ed);

	$table = $tableframe->Table(
	    -background => 'white',
	    -rows => $table_rows,
	    -columns => $table_cols, 
	    -scrollbars  => 'se',
	)->pack( -expand => 'yes', fill => 'both');

	# Create Button bar
	my $buttons1 = $mwp->Frame( 
	    -background => 'white',
	    -borderwidth => 4
	)->pack(-fill => 'y');

	my $buttons2 = $mwp->Frame(
	    -background => 'white',
	    -borderwidth => 4 
	)->pack(-fill => 'y');

	my @rb;
	for (my $r =1; $r<=10; $r++){
	    $rb[$r] = $buttons1->Radiobutton(
		-background => 'white',
		-text => $r, 
		-value => $r,
	    )->pack( -side => 'left' );
	}

	$buttons1->Button( 
	    -text    => "Rate",
	    -width   => 10,
	    -command => sub { rate_selected_pictures ( \@rb,\@selected_picids);
	    $cb_rt_info->select;
	    write_picture_labels($table, $picids,
	    $table_cols,\$cb_nr_info,\$cb_rl_info,\$cb_kw_info,\$cb_tp_info,\$cb_rt_info );
	    reset_pictures ($table, $picids, \%cells, $table_cols, \@rb);
	}
    )->pack(-side  => 'left', -padx => 2 );

    $buttons2->Button( 
	-text    => "Select All",
	-width   => 10,
	-command => [\&select_all_pictures, $table,
	$picids,\%cells,\@selected_picids, $table_cols ]
    )->pack(
	-side  => 'left', -padx => 2 
    );

    $buttons2->Button( 
	-text          => "Remove",
	-width        => 10,
	-command => sub{
	    rm_pictures_from_selection($rl_ed_selected, $kw_ed_selected,$tp_ed_selected,\@selected_picids);

	    # rewrite table
	    my @new_picids;
	    if ($rl_ed_selected) {
		@new_picids = get_rl_picids(@$rl_ed_selected);
	    }elsif ($kw_ed_selected){
		@new_picids = get_kw_picids(@$kw_ed_selected);
	    } else {
		my $topicid = get_topicid($tp_ed_selected);
		@new_picids = get_tp_picids($topicid);
	    }
	    $table->destroy;
	    $table = $tableframe->Table(
		-background => 'white',
		-rows => $table_rows,
		-columns => $table_cols, 
		-scrollbars  => 'se',
	    );
	    $table->pack(-expand => 'yes', fill => 'both');
	    %cells=();
	    @selected_picids=();
	    write_picture_thumbs($mwp,$table,\@new_picids,\%cells,\@selected_picids, $table_cols);
	    write_picture_labels($table,\@new_picids,$table_cols,
	    \$cb_nr_info,\$cb_rl_info, \$cb_kw_info, \$cb_tp_info, \$cb_rt_info );
	}
    )->pack( -side  => 'left', -padx => 2 );

    $buttons2->Button( 
	-text    => "Add keywords",
	-width   => 10,
	-command => sub{
	    $cb_kw_info->select;
	    link_selected_keywords_to_selected_pictures($kwbox_ed, \@selected_picids);
	    write_picture_labels($table,$picids,$table_cols,
	    \$cb_nr_info,\$cb_rl_info, \$cb_kw_info, \$cb_tp_info, \$cb_rt_info );
	    reset_pictures ($table, $picids, \%cells, $table_cols, \@rb);
	    reset_kw($kwbox_ed);
	}
    )->pack(-side  => 'left', -padx => 2 );

    $buttons2->Button( 
	-text    => "Add topics",
	-width   => 10,
	-command => sub{
	    $cb_tp_info->select;
	    link_selected_topic_to_selected_pictures($tplist_ed, \@selected_picids);
	    write_picture_labels($table,$picids,$table_cols,
	    \$cb_nr_info,\$cb_rl_info, \$cb_kw_info, \$cb_tp_info, \$cb_rt_info );
	    reset_pictures ($table, $picids, \%cells, $table_cols, \@rb);
	    reset_tp($tplist_ed);
	}
    )->pack(-side  => 'left', -padx => 2 );

    $buttons2->Button( 
	-text    => "Reset",
	-width   => 10,
	-command => [\&reset_pictures , $table, $picids, \%cells, $table_cols, \@rb ]
    )->pack(-side  => 'left', -padx => 2 );


    $buttons2->Button( -text          => "Rewrite",
    -width        => 10,
    -command => sub { 
	my @new_picids; 
	if ($rl_ed_selected){
	    @new_picids = get_rl_picids(@$rl_ed_selected);
	} elsif ($kw_ed_selected){
	    @new_picids = get_kw_picids(@$kw_ed_selected);
	} else {
	    my $topicid = get_topicid($tp_ed_selected);
	    @new_picids = get_tp_picids($topicid);
	}
	write_picture_thumbs($mwp,$table,\@new_picids,\%cells,\@selected_picids, $table_cols);
	write_picture_labels($table,\@new_picids,$table_cols,
	\$cb_nr_info,\$cb_rl_info, \$cb_kw_info, \$cb_tp_info, \$cb_rt_info );
	reset_kw($kwbox_ed);
	reset_tp($tplist_ed)
    }
)->pack( -side  => 'left', -padx => 2);

$buttons2->Button(
    -text          => "Close",
    -width        => 10,
    -command => sub {$mwp->destroy }
)->pack(-side  => 'left', -padx => 2 );

write_picture_thumbs($mwp,$table,$picids,\%cells,\@selected_picids, $table_cols);
write_picture_labels($table,$picids,$table_cols,\$cb_nr_info,\$cb_rl_info, \$cb_kw_info, \$cb_tp_info, \$cb_rt_info );

MainLoop();
}

# Used in show_thumbs
sub select_all_pictures{
    my ($table, $picids,$cells,$selected_picids, $table_cols) = @_;

    my $row;
    my $picid;

    my $nr=0;
    my $r=0;
    my $c=0;

    for $picid (@$picids){
	if ($picid){
	    if ($c == $table_cols){$r+=2; $c=0}
	    my $nr = ($r/2) * $table_cols + $c;

	    $$cells{$nr} = int($nr); 

	    # Show selected
	    my $w;
	    $w = $table->get($r, $c);
	    $w->configure(-background => 'blue');

	    ($debug) && print "select_all_pictures: ($r,$c) selected: ";
	    ($debug) && print "select_all_pictures: picid: $$picids[$nr]\n";

	    $c++;
	    $nr++;
	}
    }
    @$selected_picids = ();
    my @nrs = keys %$cells ;
    for my $n (@nrs){
	push (@$selected_picids, $$picids[$n]); 
    }
}

# Fill topics-tplist of the GUI with corrent topics in database
sub show_tptree{
    my $tplist = shift;

    my (@ids, @ids1, @ids2, @ids3, @ids4, @ids5, @ids6); 
    my ($id, $id0, $id1, $id2, $id3, $id4, $id5);
    my ($topic, $topic0, $topic1, $topic2, $topic3, $topic4, $topic5, $topic6);
    my ($dcr0, $dcr1, $dcr2, $dcr3, $dcr4, $dcr5);


    $id=0;
    $topic0="All Pictures";
    $tplist->add("$topic0", -text => "$topic0" );
    @ids = get_subtopicids($id);

    for $id0 (@ids){
	$dcr0 = get_descr($id0);
	$topic1 = $topic0.":".$dcr0;
	$tplist->add("$topic1", -text => "$dcr0" );
	@ids1 = get_subtopicids($id0);
	for $id1 (@ids1){
	    $dcr1 = get_descr($id1);
	    $topic2 = $topic1.":".$dcr1;
	    $tplist->add("$topic2", -text => "$dcr1" );
	    @ids2 = get_subtopicids($id1);
	    for $id2 (@ids2){
		$dcr2 = get_descr($id2);
		$topic3 = $topic2.":".$dcr2;
		$tplist->add("$topic3", -text => "$dcr2" );
		@ids3 = get_subtopicids($id2);
		for $id3 (@ids3){
		    $dcr3 = get_descr($id3);
		    $topic4 = $topic3.":".$dcr3;
		    $tplist->add("$topic4", -text => "$dcr3" );
		    @ids4 = get_subtopicids($id3);
		    for $id4 (@ids4){
			$dcr4 = get_descr($id4);
			$topic5 = $topic4.":".$dcr4;
			$tplist->add("$topic5", -text => "$dcr4" );
			@ids5 = get_subtopicids($id4);
			for $id5 (@ids5){
			    $dcr5 = get_descr($id5);
			    $topic6 = $topic5.":".$dcr5;
			    $tplist->add("$topic6", -text => "$dcr5" );
			    @ids6 = get_subtopicids($id5);
			}
		    }
		}
	    }
	}
    }
    if (@ids6) {
	print "Topics of more than 6 levels in the hierarchy not supported";
	quit();
    }
}

# Slideshow of current $tmp_collfile
sub slideshow_selection{ 
    unless(open(FILE, "$tmp_collfile")) { return }

    # create tmp directory with links to selected files
    my $tmpdir = "/tmp/toftool_tmp_slideshow$$";
    mkdir $tmpdir;
    my $nr=0;	# $nr: hack to maintain order of $tmp_collfile in slideshow
    while(my $line = <FILE>) {
	if( $line =~ /.*\.jpg/)       { 
	    $nr++;
	    my $nrstr= sprintf("%.4i",$nr);
	    chop $line;
	    $line =~ s/"//g;
	    my $name =$line;
	    $name =~ s|[/].*[/]||;
	    $name = $nrstr."_".$name;
	    symlink $line, "$tmpdir/$name";
	    ($debug) && print "slideshow: symlink $line, $tmpdir/$name\n";
	}
    }

    # Slideshow
    my $cmd = "gqview -t -f -s $tmpdir/*.jpg >/dev/null";
    # $tmpdir/*.jpg used instead of $tmpdir
    # seems to be needed for proper order if pictures in gqview
    system $cmd;

    # Cleanup
    seek FILE,0,0;
    $nr=0;
    while(my $line = <FILE>) {
	if( $line =~ /.*\.jpg/)       { 
	    $nr++;
	    my $nrstr= sprintf("%.4i",$nr);
	    chop $line;
	    $line =~ s/"//g;
	    my $name =$line;
	    $name =~ s|[/].*[/]||;
	    $name = $nrstr."_".$name;
	    unlink "$tmpdir/$name";
	    ($debug) && print "slideshow: unlink $tmpdir/$name\n";
	}
    }
    if ( -d $tmpdir ){
	rmdir $tmpdir; 
    }
}

# store data of pictures listed in  $collfile in the database
# for $topicid and keywords listed in @kw 
sub store_collfile_data{
    my $collfile = shift;
    my $topicid = shift;
    my @kw = shift;

    my $photo_src_file;
    my $rollid;
    my $frameid;

    ($debug) && print "store_collfile_data: Processing file: $collfile\n";
    open(GQV_FILE,$collfile) || die "Error: cannot open file $collfile";
    my $line;
    my $tp_order = 0;
    while ($line = <GQV_FILE>){
	$line =~ s/"//g;
	chop $line;
	if ($line !~ /^#/ && $line =~ /[.]jpg$/) { 	# Currently only .jpg files 
	    # Determine order number of picture in current file.
	    $tp_order++;

	    my $photo_src_file = $line; 
	    ($debug) && print "-----------------------------------------------------------------------\n";
	    ($debug) && print "store_collfile_data: Processing: $line\n";

	    # Determine $rollname and $rollid:
	    my $rollname = $photo_src_file; 
	    # strip /....jpg/ part and directory part 
	    $rollname =~ s|[/][^/]*[.]jpg$||;
	    $rollname =~ s|[/].*[/]||;
	    my $rollid = $username."/".$rollname;

	    # Create directory $imagedir/$rollid if needed:
	    mkdir $imagedir."/".$rollid;

	    # Determine $frameid:
	    my $frameid = $photo_src_file; 
	    $frameid =~ s|[/].*[/]||;
	    $frameid =~ s/[.]jpg$//;

	    # Create, thumbnale and image files using kdc2jpeg
	    write_imagefiles ($rollid, $frameid ,$photo_src_file);

	    # Store picture data in database
	    store_rolls_data($rollid);
	    store_pictures_data($rollid,$frameid);

	    my $picid = get_picid($rollid,$frameid);
	    store_topicscontent_data($picid, $topicid, undef);
	    store_topicscontentorder_data($picid, $topicid, $tp_order);
	    store_permissions_data($picid);
	    store_keywords_data($picid,@kw)
	}
    }
}

# Store data in table topics 
sub store_topics_data{
    my $topic = shift;

    my $currtopicid;
    my $dcr;
    my $pdcr;
    my $ptopicid;
    my $parenttopicid;
    my $row;
    my $topicid;

    if ($topic eq 'All Pictures'){
	# In this case use the explict assignments:
	$currtopicid = 0;
	$dcr = 'All Pictures';
	$ptopicid = 'NULL';
    } else {
	# Remove the 'All Pictures' part:
	my $shorttopic = $topic;
	$shorttopic =~ s/All\ Pictures://;
	my @tps = split(":",$shorttopic);

	my $sql = "SELECT topicid  FROM topics WHERE parenttopicid = ? AND description = ?";
	my $sth2 = $dbh->prepare($sql);

	$pdcr =  "All Pictures";
	$ptopicid = 0;

	for $tp  (@tps) {
	    $sth2->execute($ptopicid, $tp); 

	    $row = $sth2->fetchrow_hashref; 
	    $topicid = $row->{topicid};

	    $parenttopicid = $ptopicid;

	    $pdcr =  $tp ;
	    $ptopicid = $topicid;
	}
	$dcr = $pdcr;

	# Update topics table for current topic if needed 
	my $rows = $sth2->rows;
	if ($rows == 0) { 
	    $sql = q{INSERT INTO "topics" 
	    ("topicid", "parenttopicid", "description", "summary")
	    VALUES 
	    (NEXTVAL('"topics_topicid_seq"'::text), ?,?, '')};
	    my $sth2a = $dbh->prepare($sql);
	    # Update for $parenttopicid, $dcr
	    $sth2a->execute($parenttopicid, $dcr); 
	    $sth2a->finish;

	    # Determine $currtopicid
	    $sth2->execute($parenttopicid, $dcr); 
	    $row = $sth2->fetchrow_hashref; 
	    $currtopicid = $row->{topicid};

	    ($debug) && print "store_topics_data: New topic: $topic:\n";
	    ($debug) && print "store_topics_data: parenttopicid: $parenttopicid\t";
	    ($debug) && print "store_topics_data: currtopicid = $currtopicid\t";
	    ($debug) && print "store_topics_data: dcr = $dcr \n";
	} else {
	    ($debug) && print "store_topics_data: no update needed of table topics for topic $dcr\n";
	}
	$sth2->finish;
    }
}

# Store data in table rolls
sub store_rolls_data{
    my $rollid = shift;

    my $sql;
    # Store "rollid" and "owner" in table rolls if needed
    $sql = "SELECT * FROM rolls WHERE rollid = ? AND owner = ?";
    my $sth = $dbh->prepare($sql);
    $sth->execute($rollid, $userid); 
    my $rows = $sth->rows;
    $sth->finish;
    ($debug) && print "store_rolls_data: rollid, userid: $rollid, $userid \n";
    if ($rows == 0) {
	$sql = q{INSERT INTO "rolls" ("rollid", "owner") VALUES (?,?)};
	my $sth = $dbh->prepare($sql);
	$sth->execute($rollid, $userid);
	$sth->finish;
	($debug) && print "store_rolls_data: table rolls updated \n";
    } else {
	($debug) && print "store_rolls_data: no update needed for table rollid \n";
    }
}

# Store data in table pictures
sub store_pictures_data{
    my $rollid = shift;
    my $frameid = shift;

    my $sql;

    # Store  $rollid, $frameid, $userid in table pictures if needed
    $sql = "SELECT * FROM pictures WHERE rollid = ? AND frameid = ? AND owner = ?";
    my $sth4x = $dbh->prepare($sql);

    $sth4x->execute($rollid, $frameid, $userid); 
    my $rows = $sth4x->rows;
    $sth4x->finish;
    ($debug) && print "store_pictures_data: frameid, userid: $rollid, $frameid, $userid \n";
    if ($rows == 0) {
	$sql = q{ INSERT INTO pictures
	("pictureid", "rollid", "frameid", "description", "filename", "owner",
	"entrydate", "nbclick", "nbrates", "maxrate", "minrate", "averagerate", "sumrates")
	VALUES 
	(NEXTVAL('pictures_pictureid_seq'::text),?,?, NULL, NULL, ?,
	now(), '0', '0', '', '', '', '0')};
	my $sth4 = $dbh->prepare($sql);
	$sth4->execute($rollid, $frameid, $userid); 
	$sth4->finish;
	($debug) && print "store_pictures_data: table pictures updated \n";
    } else {
	($debug) && print "store_pictures_data: no update needed for table pictures \n";
    }
}

# Store data in table permissions
sub store_permissions_data{
    my $picid = shift;

    # Store $groupid, $picid in table permissions if needed
    my $sql = "SELECT * FROM permissions WHERE groupid = ? AND pictureid = ?"; 
    my $sth = $dbh->prepare($sql);
    $sth->execute($groupid, $picid);
    my $rows = $sth->rows;
    $sth->finish;
    ($debug) && print "store_permissions_data: groupid, pictureid: $groupid, $picid \n";
    if ($rows == 0) {
	$sql = q{	INSERT INTO "permissions" 
	("groupid","pictureid")
	VALUES (?,?)};
	my $sth = $dbh->prepare($sql);
	$sth->execute($groupid, $picid);
	$sth->finish;
	($debug) && print "store_permissions_data: table permissions  updated \n";
    } else {
	($debug) && print "store_permissions_data: no update needed for table permissions \n";
    }
}

# Store data in table keywords 
sub store_keywords_data{
    my ($picid, @keywords) = @_;

    # Keyword type variable not used: set to NULL
    my $sql ="SELECT * FROM keywords WHERE type IS NULL AND pictureid = ? AND VALUE = ?";
    my $sth = $dbh->prepare($sql);
    my $rows;
    my $kw;
    for $kw (@keywords){ 
	if ($kw){
	    $sth->execute($picid,$kw);
	    $rows = $sth->rows;
	    $sth->finish;
	    ($debug) && print "store_keywords_data: pictureid, keyword: $picid, $kw \n";
	    if ($rows == 0) {
		# Keyword type variable not used:  set to NULL
		$sql = q{INSERT INTO "keywords" ("type","pictureid","value")
		VALUES (NULL,?,?)};
		my $sth1 = $dbh->prepare($sql);
		$sth1->execute($picid,$kw);
		$sth1->finish;
		($debug) && print "store_keywords_data: table keywords  updated \n";
	    } else {
		($debug) && print "store_keywords_data: no update needed for table keywords \n";
	    }
	}
    }
}

# Store data in table topicscontent
sub store_topicscontent_data{
    my $picid = shift;
    my $topicid = shift;

    my ($sql, $sth, $rows);
    if ($picid && $topicid) {
	$sql = "SELECT * FROM topicscontent WHERE topicid = ? AND pictureid = ?"; 
	$sth = $dbh->prepare($sql);
	$sth->execute($topicid, $picid);
	$rows = $sth->rows;
	$sth->finish;
	($debug) && print "store_topicscontent_data: topicid, pictureid: $topicid, $picid\n"; 
	if ($rows == 0) {
	    $sql = q{INSERT INTO "topicscontent" ("topicid","pictureid","direct")
	    VALUES (?,?,'y') };
	    $sth = $dbh->prepare($sql);
	    $sth->execute($topicid, $picid);
	    $sth->finish;
	    ($debug) && print "store_topicscontent_data: Picture $picid added to table topicscontent\n";
	} else {
	    ($debug) && print "store_topicscontent_data: no update needed for table topicscontent \n";
	}
    }
}

# Store data in table topicscontentorder
sub store_topicscontentorder_data{
    my $picid = shift;
    my $topicid = shift;
    my $tp_order = shift;

    my ($sql, $sth, $rows);
    if ($picid && $topicid) {
	$sql = "SELECT * FROM topicscontentorder WHERE topicid = ? AND pictureid = ?"; 
	$sth = $dbh->prepare($sql);
	$sth->execute($topicid, $picid);
	$rows = $sth->rows;
	$sth->finish;
	($debug) && print "store_topicscontentorder_data: topicid, pictureid: $topicid, $picid\n"; 
	if ($rows == 0) {
	    $sql = q{INSERT INTO "topicscontentorder" ("topicid","pictureid","tp_order")
	    VALUES (?,?,?) };
	    $sth = $dbh->prepare($sql);
	    $sth->execute($topicid, $picid, $tp_order);
	    $sth->finish;
	    ($debug) && print "store_topicscontentorder_data: Picture $picid added\n";
	    ($debug && $tp_order) && print "table topicscontentorder updated with tp_order $tp_order \n";
	} else {
	    $sql = "UPDATE topicscontentorder SET tp_order = ? WHERE topicid = ? AND pictureid = ?";
	    $sth = $dbh->prepare($sql);
	    $sth->execute($tp_order, $topicid, $picid);
	    $sth->finish;
	    ($debug) && print "store_topicscontentorder_data: Table topicscontentorder updated: ";
	    ($debug && $tp_order) && print "setting tp_order $tp_order for picture $picid \n";
	}
    }
}

# Check if table exits
sub table_exists{
    my $table = shift;
    my $sql = "SELECT 1 FROM pg_class WHERE relname=?";
    my $sth = $dbh->prepare($sql);
    $sth->execute($table);
    my @row = $sth->fetchrow_array; 
    $sth->finish;
    if (@row) {
	return 1;
    }else {
	return 0;
    }
}

# View a picture collection for selected keyword(s)
sub update_kw {
    my @selected_keywords = get_kw_selected($kwlist);
    if ($#selected_keywords > 0){
	popup_mesg("Update: supported only for one keyword");
	return
    }
    if (@selected_keywords){
	write_collfile(undef,\@selected_keywords,undef);
	my $cmd = "gqview +t $srcdir  $tmp_collfile >/dev/null";
	system($cmd);
	rm_keywords(@selected_keywords);
	store_collfile_data ($tmp_collfile,undef,@selected_keywords);
	unlink $tmp_collfile;
    }
}

# View a picture collection for selected roll(s)
sub update_rl {
    my @selected_rolls = get_rl_selected($rllist);
    if (@selected_rolls){
	for my $rl (@selected_rolls){
	    my @roll = ($rl);
	    write_collfile(\@roll,undef,undef);
	    $rl =~ s/$username\///;
	    my $cmd = "gqview +t $srcdir/$rl $tmp_collfile >/dev/null";
	    system($cmd);
	    store_collfile_data ($tmp_collfile,undef,undef);
	    unlink $tmp_collfile;
	}
    }
}

# Import all pictures of selected roll(s)
sub import_rl {
    my @selected_rolls = get_rl_selected($rllist);
    if (@selected_rolls){
	for my $rl (@selected_rolls){
	    my @roll = ($rl);
	    my $rolldir = $rl;
	    $rolldir =~ s/$username\///;
	    my @pictures = read_dir($srcdir."/".$rolldir,"jpg");
	    (@pictures) || print "No picture (.jpg) files found in $srcdir/$rolldir\n";

	    my $picfile;
	    open (FILE, ">$tmp_collfile") || die "cannot open $tmp_collfile\n";
	    for $picfile (@pictures){
		($debug) && print "import_rl: $picfile\n";
		print FILE '"'.$srcdir."/".$rolldir."/".$picfile.'"'."\n";
	    }
	    close (FILE);

	    store_collfile_data ($tmp_collfile,undef,undef);
	    unlink $tmp_collfile;
	}
    }
}

# View a picture collection for selected topic
sub update_tp {
    my $tplist = shift;

    my @tp = get_tp_selected($tplist);
    if ($#tp > 0){
	popup_mesg("Update: supported only for one topic");
	return
    }
    my $selected_topic = $tp[0];
    if (@tp){
	my @id_sel=get_topicids(@tp);
	write_collfile(undef,undef,\@id_sel);
	my $cmd = "gqview +t $srcdir $tmp_collfile >/dev/null";
	system($cmd);
	rm_topic($selected_topic);
	# Then store again the new content of this collection
	store_collfile_data ($tmp_collfile,$id_sel[0],undef);
	unlink $tmp_collfile;
    }
}

# Write $tmp_collfile with picture-file names for given keywords and topics
sub write_collfile {
    my $rl_ref = shift;
    my $kw_ref = shift;
    my $tp_ref = shift;

    my @rl;
    my @kw;
    my @tp;

    my $min_show_rate_ref = $min_show_rate_scale->cget(-variable);
    my $min_show_rate_on_ref = $min_show_rate_cb->cget(-variable);

    if (defined $rl_ref) {@rl = @$rl_ref}
    if (defined $kw_ref) {@kw = @$kw_ref} 
    if (defined $tp_ref) {@tp = @$tp_ref} 

    if (!(@rl || @kw || @tp || $min_show_rate_on_ref )){ return 0 }

    # Prepare the SQL-query 
    my ($rl, $rl_from_str1, $rl_where_str1, $rl_where_str2);
    my $i=0;
    if (@rl){
	for $rl (@rl){
	    $i++;
	    $rl_from_str1 .= "rolls AS rl"."$i, ";

	    if ($i == 1) {
		$rl_where_str1 .= "rl".$i.".rollid = ? ";
	    } else {
		if ($rl_rb eq 'any'){
		    $rl_where_str1 .= "OR rl".$i.".rollid = ? ";
		} elsif ($rl_rb eq 'all'){
		    $rl_where_str1 .= "AND rl".$i.".rollid = ? ";
		}
	    }
	    $rl_where_str2 .= "AND rl"."$i".".rollid = pictures.rollid\n";
	}
    }


    my ($kw, $kw_from_str1, $kw_where_str1, $kw_where_str2);
    $i=0;
    if (@kw){
	for $kw (@kw){
	    $i++;
	    $kw_from_str1 .= "keywords AS kw"."$i,";

	    if ($i == 1) {
		$kw_where_str1 .= "kw".$i.".value = ? ";
	    } else {
		if ($kw_rb eq 'any'){
		    $kw_where_str1 .= "OR kw".$i.".value = ? ";
		} elsif ($kw_rb eq 'all'){
		    $kw_where_str1 .= "AND kw".$i.".value = ? ";
		}

	    }

	    $kw_where_str2 .= "AND kw"."$i".".pictureid = pictures.pictureid\n";
	}
    }

    my ($tp, $tp_from_str1, $tp_from_str2, $tp_from_str3, $tp_where_str1, $tp_where_str2,
    $tp_order_str1,$tp_order_str2);
    $i=0;

    if (@tp){
	for $tp (@tp){
	    $i++;
	    $tp_from_str1 .= "topics AS tp"."$i,\n";
	    $tp_from_str2 .= "topicscontent AS tpc"."$i,\n";
	    $tp_from_str3 .= "topicscontentorder AS tpo"."$i,\n";

	    if ($i == 1) {
		$tp_where_str1 .= "tp".$i.".topicid = ?\n";
	    } else {
		if ($tp_rb eq 'any'){
		    $tp_where_str1 .= "OR tp".$i.".topicid = ?\n";
		} elsif ($tp_rb eq 'all'){
		    $tp_where_str1 .= "AND tp".$i.".topicid = ?\n";
		}

	    }

	    $tp_where_str2 .= "AND tp".$i.".topicid = tpc".$i.".topicid\n";
	    $tp_where_str2 .= "AND tp".$i.".topicid = tpo".$i.".topicid\n";
	    $tp_where_str2 .= "AND tpc".$i.".pictureid = pictures.pictureid\n";
	    $tp_where_str2 .= "AND tpo".$i.".pictureid = pictures.pictureid\n";
	}
    }

    $sql = "SELECT DISTINCT pictures.pictureid, pictures.rollid, pictures.frameid\n";
    if (@tp && $#tp == 0){ $sql .= ",tpo1.tp_order\n" }
    $sql .= "FROM ";
    if (@rl){ $sql .=$rl_from_str1 }
    if (@kw){ $sql .=$kw_from_str1 }
    if (@tp){ $sql .=$tp_from_str1 }
    if (@tp){ $sql .=$tp_from_str2 }
    if (@tp){ $sql .=$tp_from_str3 }
    $sql .= "pictures\n";
    $sql .= "WHERE ";
    if (@rl) {$sql .= "($rl_where_str1)"."\n".$rl_where_str2}
    if (@kw) {
	if (@rl){ $sql .= "AND "}
	$sql .= "($kw_where_str1)"."\n".$kw_where_str2;
    }
    if (@tp) {
	if (@rl || @kw){ $sql .= "AND "}
	$sql .= "($tp_where_str1)"."\n".$tp_where_str2;
    }
    if ($$min_show_rate_on_ref){
	if (@rl || @kw || @tp){ $sql .= "AND "}
	$sql .= "pictures.averagerate >= $$min_show_rate_ref "
    }
    # In case of one topic the results are ordered by tp_order
    # in other cases by pictureid
    $sql .= "ORDER BY ";
    if (@tp && $#tp == 0){
	$sql .= "tpo1.tp_order\n"
    } else {
	$sql .= "pictures.pictureid\n";
    }
    ($debug) && print "$sql\n";
    my $sth = $dbh->prepare($sql);

    # Execute $sth 
    my @var;
    my $rls = join(',',@rl);
    my $kws = join(',',@kw);
    if (@rl) { foreach (@rl){ push (@var, $_)}};
    if (@kw) { foreach (@kw){ push (@var, $_)}};
    if (@tp) {push (@var, @tp)};
    ($debug) && print "write_collfile: sth->execute(@var)\n"; 
    $sth->execute(@var) || die $sth->errstr; 

    # Print the maching pictures to $tmp_collfile
    my $rows = $sth->rows;

    open (FILE, ">$tmp_collfile") || die "cannot open $tmp_collfile\n";
    if ($rows){
	my $frameid;
	my $rolldir;
	do {
	    my $row = $sth->fetchrow_hashref; 
	    my $rollid = $row->{rollid};
	    # remove $username part from rollid
	    if ($rollid){
		$rolldir = $rollid;
		$rolldir =~ s/.*\///;
	    }
	    $frameid = $row->{frameid};
	    if ($frameid){
		print FILE '"'.$srcdir."/".$rolldir."/".$frameid.".jpg".'"'."\n";
		($debug) && print 'write_collfile: "'.$srcdir."/".$rolldir."/".$frameid.".jpg".'"'."\n";
	    }
	}while ($frameid);
	close (FILE);
    } else {
	print "No matching pictures\n";
    }
    return $rows;
}


# Create, thumbnale and image file for a picture, using kdc2jpeg
sub write_imagefiles {
    my $rollid = shift;
    my $frameid = shift;
    my $photo_src_file = shift;

    my $image_file = $imagedir."/".$rollid."/".$frameid."-w.jpg";
    my $thumb_file =  $imagedir."/".$rollid."/".$frameid."-t.jpg";

    if ( -e $photo_src_file && -e $thumb_file && -e $image_file ){
	my $age_image_file = ( -M $image_file );
	my $age_thumb_file = ( -M $thumb_file );
	my $age_photo_src_file = ( -M $photo_src_file );
	($debug) && print "write_imagefiles: age_image_file = $age_image_file\n";
	($debug) && print "write_imagefiles: age_thumb_file = $age_thumb_file\n";
	($debug) && print "write_imagefiles: age_photo_src_file = $age_photo_src_file\n";

	if ( $age_photo_src_file < $age_thumb_file ) {
	    ($debug) && print "\nwrite_imagefiles: creating thumbnail file $thumb_file \n";
	    my $cmd = "kdc2jpeg ".$photo_src_file." ".$thumbnail_options." ".$thumb_file;
	    system($cmd);
	} else {
	    ($debug) && print "\nwrite_imagefiles: no update needed fot thumbnail file $thumb_file \n";
	}
	if ( $age_photo_src_file < $age_image_file ) {
	    ($debug) && print "\nwrite_imagefiles: creating image file $image_file \n";
	    my $cmd = "kdc2jpeg ".$photo_src_file." ".$image_options." ".$image_file;
	    system($cmd);
	} else {
	    ($debug) && print "write_imagefiles: no update needed for imagefile $image_file \n";
	}
    } elsif ( -e $photo_src_file ) {
	($debug) && print "\nwrite_imagefiles: creating thumbnail file $thumb_file \n";
	my $cmd = "kdc2jpeg ".$photo_src_file." ".$thumbnail_options." ".$thumb_file;
	system($cmd);

	($debug) && print "\nwrite_imagefiles: creating image file $image_file \n";
	$cmd = "kdc2jpeg ".$photo_src_file." ".$image_options." ".$image_file;
	system($cmd);
    } else {
	($debug) && print "write_imagefiles: $photo_src_file: file not found\n";
    }
}


# Used in show_thumbs
sub write_picture_thumbs{
    my $mwp = shift;
    my $table =shift; 
    my $picids = shift;
    my $cells = shift;
    my $selected_picids = shift;
    my $table_cols = shift;

    my $row;
    my $picid;
    my $info_txt;
    my @thumbs;
    my @photos;
    my $rollid;
    my $frameid;

    my $nr=0;
    my $r=0;
    my $c=0;

    my @image;
    my @widget;

    my $sql = "SELECT * FROM pictures WHERE pictureid = ?";
    my $sth = $dbh->prepare($sql);

    for $picid (@$picids){
	if ($picid){
	    $sth->execute($picid); 
	    $row = $sth->fetchrow_hashref; 

	    $rollid = $row->{rollid};
	    $frameid = $row->{frameid};
	    $thumbs[$nr] = "$imagedir/$rollid/$frameid"."-t.jpg"; 	
	    $photos[$nr] = "$imagedir/$rollid/$frameid"."-w.jpg"; 	
	    $image[$nr] = $mwp->Photo('-format' => 'jpeg', -file => $thumbs[$nr]);

	    # Each time two cells are filled:  in ($r, $c) a picture: $img and at the next
	    # row in ($r+1, $c) information about the picture: $img_info
	    if ($c == $table_cols){$r+=2; $c=0}
	    my $img =  $table->Label( -image => $image[$nr], -background => 'white',);
	    $table->put ($r, $c, $img);

	    # Note that 'bind' makes that the widget $img is called as
	    # the first argument in select_picture
	    $img->bind("<Button-1>", [ \&select_picture, $table,
	    $picids, $selected_picids, $cells, $table_cols ]);
	    $img->bind("<Button-3>", [ \&display_image, $photos[$nr] ]);  
	    $c++;
	    $nr++;
	}
    }
}

# Used in show_thumbs
sub write_picture_labels{
    my $table =shift; 
    my $picids = shift;
    my $table_cols = shift;
    my $cb_nr_info = shift;
    my $cb_rl_info = shift;
    my $cb_kw_info = shift;
    my $cb_tp_info = shift;
    my $cb_rt_info = shift;

    my $show_nr_info = $$cb_nr_info->cget(-variable);
    my $show_rl_info = $$cb_rl_info->cget(-variable);
    my $show_kw_info = $$cb_kw_info->cget(-variable);
    my $show_tp_info = $$cb_tp_info->cget(-variable);
    my $show_rt_info = $$cb_rt_info->cget(-variable);

    my $row;
    my $picid;
    my $info_txt;

    my $nr=0;
    my $r=0;
    my $c=0;

    my @image;
    my @widget;

    my $sql = "SELECT * FROM pictures WHERE pictureid = ?";
    my $sth = $dbh->prepare($sql);

    for $picid (@$picids){
	if ($picid){
	    my @topics = get_picture_topics($picid); 
	    my @keywords = get_picture_keywords($picid);
	    # Each time two cells are filled:  in ($r, $c) a picture: $img and at the next
	    # row in ($r+1, $c) information about the picture: $img_info
	    if ($c == $table_cols){$r+=2; $c=0}

	    $info_txt = "";
	    if ($$show_nr_info){ 
		$info_txt .= "nr:      $picid\n";
	    }
	    if ($$show_rl_info){ 
		$sth->execute($picid);
		$row = $sth->fetchrow_hashref; 
		$sth->finish;
		my $rollid = $row->{rollid};
		my $rollname = $rollid;
		($rollid) && $rollname =~ s/$username\///;
		$info_txt .= "rl:      $rollname\n";
	    }
	    if ($$show_tp_info && @topics){ 
		for my $tp (@topics){
		    my $tp = substr($tp, -15);
		    $info_txt .= "tp:  ..."."$tp\n";
		}
	    }
	    if ($$show_kw_info && @keywords){ 
		for my $kw (@keywords){
		    $info_txt .= "kw:     $kw\n";
		}
	    }
	    $sth->execute($picid);
	    $row = $sth->fetchrow_hashref; 
	    my $rating = $row->{averagerate};
	    if ($$show_rt_info && $rating){ $info_txt .="rating: $rating\n" }

	    my $img_info = $table->Label( -text => $info_txt,
	    -anchor => 'nw', -justify => 'left');
	    $table->put ($r+1, $c, $img_info);

	    $c++;
	    $nr++;
	}
    }
}

