package RundbWebUtils;

# $Id: RundbWebUtils.pm,v 1.2 2003/08/11 23:28:18 andr Exp $
#
# Andrei Gaponenko, December 2002
#

use strict;

use Pg;
use CGI;
use CGI::Carp qw(fatalsToBrowser);

sub rundb_trailer($);
sub rundb_header($$$);
		 
sub escapeSQLString($);
sub get_required_tapes($);


BEGIN {
    use Exporter   ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    
    # set the version for version checking
    $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };

    @ISA         = qw(Exporter);
    @EXPORT      = qw(&rundb_trailer &rundb_header 
		      &escapeSQLString
		      &make_table_head &make_table_rows 
		      &formatHtmlTable
		      &get_required_tapes
		      );
    %EXPORT_TAGS = ( all => [qw( &rundb_trailer &rundb_header 
				 &escapeSQLString
				 &make_table_head &make_table_rows
				 &formatHtmlTable
				 &get_required_tapes
				 )] 
		     );

    # your exported package globals go here,
    # as well as any optionally exported functions
    @EXPORT_OK   = qw( 
		      );
}
our @EXPORT_OK;
use vars @EXPORT_OK;

#================================================================
# Why there is no such thing in Pg?
sub escapeSQLString($) {
    my $str = shift;
    $str =~ s{'}{''}gs; ## this is a comment '};
    $str =~ s{\\}{\\\\}gs;
    return $str;
}
#================================================================
sub rundb_header($$$) {
    my ($title, $q, $username) = @_;
    
    my @links = (
		 CGI::a({-class=>'rundbheader', -href=>'tapes.pl'}, 'Tapes'),
		 CGI::a({-class=>'rundbheader', -href=>'tapes.pl?lazylast=1'}, 'Lazy records'),
		 CGI::a({-class=>'rundbheader', -href=>'drives.pl'}, 'Tape Drives'),
		 CGI::a({-class=>'rundbheader', -href=>'requests.pl'}, 'Run Requests'),
		 CGI::a({-class=>'rundbheader', -href=>'disks.pl'}, 'Disks'),
#	       CGI::a({-href=>'runs.pl'}, 'List of Runs'),
		 );
    
    push @links, CGI::a({-class=>'rundbheader', -href=>$q->url() . "?logout=1"},
			"Logout $username") if $username;
    
    return 
	$q->start_html(-style=>{-src=>'styles.css'}, 
		       -title=>$title)
	. CGI::div({-class=>'rundbheader'}, 
		   CGI::span({-class=>'rundbheader'}, \@links));
		   # join(" ",@links));

#	. CGI::div({-class=>'rundbheader'}, 
#		   CGI::table({-frame=>'void', 
#			       -border=>'0',
#			       -rules=>'none',
#			       -cellpadding=>'0%',
#			       -width=>'80%',
#			       },
#			      CGI::Tr(CGI::td({-class=>'rundbheader'}, \@links))
#			      )
#		   );
}
#================================================================
sub rundb_trailer($) {
    my $conn = shift;

    my $sql =  "select to_char( max(entrydate),"
	."'Dy FMMonth DD HH24:MI TZ YYYY') from commits;";

    my $res = $conn->exec($sql);
    my $lastmod = (($res->resultStatus == PGRES_TUPLES_OK) && $res->ntuples)?
	("Last modified on " . $res->getvalue(0,0)): "";

    return CGI::div({-class=>'rundbtrailer'},
		    CGI::hr(). "TWIST run database.  $lastmod" )
	. CGI::end_html() 
	. "\n";

}
#================================================================
# args are: 
# 1) Pg result 
# 2) optional hash reference to map Pg field names into table headers
sub make_table_head {
    my ($res, $names) = @_;
    
    my @headings;
    for(my $i=0; $i < $res->nfields; $i++) {
	my $rawname = $res->fname($i);
	push @headings, (defined $$names{$rawname}) ? 
	    $$names{$rawname} : $rawname;
    }
    return \@headings;
#    return CGI::th({-class=>'tapetable'},\@headings);
}

#================================================================
# args are: 
# 1) Pg result 
# 2) optional hash reference to give formatter functions for field names
# 3) optional hash reference to give <td> attributes
sub make_table_rows {
    my ($res, $formatters, $tdattr) = @_;
    
#    print $tdattr ? "\n\ntdattr defined\n\n" : "\n\ntdattr undef\n\n";
    
    my @rows;
    for(my $j=0; $j < $res->ntuples; $j++) {
	my @row;
	for(my $i=0; $i < $res->nfields; $i++) {
	    my $val = $res->getvalue($j, $i);
	    my $formatter = $$formatters{$res->fname($i)};

	    ## wrong number of cols in the header if skip a cell here
	    # next if $formatter eq 'skip';

	    $val = (defined $formatter ? &$formatter($val) : $val );
	    $val = '&nbsp;' unless (defined $val and $val ne '');
	    push @row, $val;
	}
	push @rows, ($tdattr? CGI::td($tdattr, \@row) : CGI::td(\@row));
    }
    return \@rows;
}

#================================================================
sub getHashRef {
    my ($r, $res, $i, $val)  = @_;
    if($r) {
	if(ref($r) eq "HASH") {
	    return $r;
	}
	elsif(ref($r) eq "CODE") {
	    return &$r($val, $res, $i);
	}
	else {
	    croak("getHashRef(): bad r type: ".ref($r)."\n");
	}
    }
    return undef;
}
#================================================================
sub formatHtmlTable($$) {
    my ($res, $h) = @_;

    my ($tableattr, $headrow_attr, $th_default_attr, $bodyrow_attr, $cols) = $h ?
	($h->{'tableattr'}, $h->{'headrow_attr'}, $h->{'th_default_attr'}, 
	 $h->{'bodyrow_attr'}, $h->{'cols'}) 
	:({}, {}, {}, {});
    
    my %headmap;
    my $headrow_str = '';
    for(my $i=0; $i < $res->nfields; $i++) {
	my $rawname = $res->fname($i);
	
	# pass undefs from the cols hash to $colhead
	$headmap{$rawname} = exists($cols->{$rawname}->{'head'}) ? 
	    $cols->{$rawname}->{'head'} : $rawname;
	

	my $thattr = $cols->{$rawname}->{'thattr'};
	$thattr = $th_default_attr unless defined $thattr;

	# skip columns marked by 'colname'=>undef in the cols hash.
	# but not empty stings (or zeroes).
	$headrow_str .= ($thattr ? CGI::th($thattr, $headmap{$rawname}) 
			 : CGI::th($headmap{$rawname}) )
	    if defined $headmap{$rawname};
    }

    $headrow_str = $headrow_attr ? CGI::Tr($headrow_attr, $headrow_str) : CGI::Tr($headrow_str);
   
    #----------------------------------------------------------------
    my $body_str = '';
    for(my $j=0; $j < $res->ntuples; $j++) {
	my $row_str = '';
	#----------------------------------------------------------------
	for(my $i=0; $i < $res->nfields; $i++) {
	    my $rawname = $res->fname($i);
	    next unless defined $headmap{$rawname};

	    my $val = $res->getvalue($j, $i);

	    my $formatted  = getHashRef($cols->{$rawname}->{'content'}, $res, $j, $val);

	    my $content = defined ($formatted)  ?  $formatted :
		((defined $val and $val ne '')? $val : '&nbsp;');
	    
	    my $tdattr  = getHashRef($cols->{$rawname}->{'tdattr'}, $res, $j, $val);
	    $row_str .= $tdattr ? CGI::td($tdattr, $content) : CGI::td($content);
	}
	my $trattr  = getHashRef($bodyrow_attr, $res, $j);
	$body_str .= ($trattr? CGI::Tr($trattr, $row_str) : CGI::Tr($row_str));
    }

    #----------------------------------------------------------------

    my $table_str = "<thead>\n$headrow_str</thead>\n<tbody>$body_str</tbody>\n";

    return $tableattr ? CGI::table($tableattr, $table_str) : CGI::table($table_str);
}

#================================================================
sub get_required_tapes($) {
    my $conn = shift;
    my @tlist_now = ();
    if(1) {
	#----------------
	my $sql = "SELECT DISTINCT tapenum FROM todo_summary where can_go "
	    ." EXCEPT (SELECT tapenum FROM tape_robot_storage "
	    ." UNION SELECT tapenum FROM tape_drive_status);";
	
	my $res = $conn->exec($sql);
	if($res->resultStatus != PGRES_TUPLES_OK) {
	    die "Error doing \"$sql\" : " . $conn->errorMessage . "\n";
	}
	for(my $i=0; $i < $res->ntuples; $i++) {
	    push @tlist_now, sprintf("TW%04d", $res->getvalue($i, 0));
	}
    }

    #----------------
    my @tlist_later = ();
    if(1) {
	#----------------
	my $sql = "SELECT DISTINCT tapenum FROM todo_summary where NOT can_go"
	    ." EXCEPT (SELECT DISTINCT tapenum FROM todo_summary where can_go"
	    ." UNION SELECT tapenum FROM tape_robot_storage "
	    ." UNION SELECT tapenum FROM tape_drive_status);";

	my $res = $conn->exec($sql);
	if($res->resultStatus != PGRES_TUPLES_OK) {
	    die "Error doing \"$sql\" : " . $conn->errorMessage . "\n";
	}
	for(my $i=0; $i < $res->ntuples; $i++) {
	    push @tlist_later, sprintf("TW%04d", $res->getvalue($i, 0));
	}
    }
    return (\@tlist_now, \@tlist_later);
}
#================================================================
END { }       # module clean-up code here (global destructor)

################################################################
# make this file return 1
1;

################################################################