#!/usr/local/bin/perl -w

###############################################################################
# Program gaggleStore.cgi    
# $Id: $
#
# Description : utility cgi to handle fetching/storing of gaggle data snapshots
#
# SBEAMS is Copyright (C) 2000-2006 Institute for Systems Biology
# This program is governed by the terms of the GNU General Public License (GPL)
# version 2 as published by the Free Software Foundation.  It is provided
# WITHOUT ANY WARRANTY.  See the full description of GPL terms in the
# LICENSE file distributed with this software.
#
###############################################################################

use strict;
use lib qw (../../lib/perl);
use File::Basename;

use SBEAMS::Connection qw($q $log);
use SBEAMS::Connection::Settings;
use SBEAMS::Connection::Tables;
use SBEAMS::BioLink::Tables;

my @p = $q->param();
for my $p ( @p ) { print STDERR "CGI: $p => " . $q->param( $p ) . "\n"; }

## Globals ##
my $program = basename( $0 );

# sbeams object 
my $sbeams = new SBEAMS::Connection;
 

{ # Main 

  # Authenticate user.
  my $username = $sbeams->Authenticate() || die "Authentication failed";
  my $contact_id = $sbeams->getCurrent_contact_id();

  # Process parameters
  my $params = process_params();
  for my $p ( keys %$params ) { print STDERR "$p -> $params->{$p}\n"; }
  my %rs_params = $sbeams->parseResultSetParams(q => $q);

  my $table = 'gaggle_store';
  my @columns = $sbeams->returnTableInfo( $table, 'ordered_columns' );
  my @input_types = $sbeams->returnTableInfo( $table, 'input_types' );
  
  $params->{apply_action} ||= '';
  my $content = 'nada';
  my $sql = '';
  print STDERR "action is $params->{apply_action}\n";

  # Decision block, what type of page are we going to display?
  if ( $params->{apply_action} eq 'list_accessible_projects' ) {
    $sql = accessible_project_sql( $params );

  } elsif ( $params->{apply_action} eq 'get_writable_projects' ) {
    $sql = writable_project_sql( $params );

  } elsif ( $params->{apply_action} eq 'list_gaggle_stores'  ) {
    $sql = gaggle_store_list_sql( $params );

  } elsif ( $params->{apply_action} eq 'gaggle_store_details'  ) {
    $sql = gaggle_store_details_sql( $params );
    $log->debug( $sql );

  } elsif ( $params->{apply_action} eq 'get_host_user'  ) {
    $sql = host_user_sql( $params );

  } elsif ( $params->{apply_action} eq 'get_user_host'  ) {
    $sql = user_host_sql( $params );

  } elsif ( $params->{apply_action} eq 'new_gaggle_store'  ) {
    print STDERR "We be sushi\n";
    new_gaggle_store($params);
    # Return a tsv message. 
    exit;

  } elsif ( $params->{apply_action} eq 'fetch_gaggle_store'  ) {
    print STDERR "We be fetching\n";
    fetch_gaggle_store($params);
    # Return a tsv message. 
    exit;

  } else {
    print STDERR "We belushi\n";
#Stupid, make auth work
    $sql = writable_project_sql( $params );
#die "Unknown action: $params->{apply_action}";
  }

  # resultset hashref 
  my $rs = {};

  #### Fetch the results from the database server
  $sbeams->fetchResultSet( sql_query => $sql,
                       resultset_ref => $rs );


  $sbeams->printPageHeader();
  $log->debug( "Rs has size: " . length( %{$rs}) );

  $sbeams->displayResultSet( 
      resultset_ref=>$rs,
      query_parameters_ref=>$params,
      rs_params_ref=>\%rs_params,
      url_cols_ref=>{},
      hidden_cols_ref=>{},
      column_titles_ref=>$rs->{column_list_ref},
      base_url=>$PHYSICAL_BASE_DIR . '/' . $program
      );
  
  # Print cgi headers
#  $sbeams->printUserContext();
#  print $content;
  $sbeams->printPageFooter();


  

} # end Main

#+
#
#-
sub new_gaggle_store {
  my $params = shift;
  print STDERR "Dobby wants socks!\n";
  for my $p ( qw( project_id clob name ) ) {
    die "Missing $p\n" unless defined $params->{$p}
  }
  $params->{desc} = '' if !defined $params->{desc};

  my $dataref = { project_id => $params->{project_id},
                  store_name => $params->{name},
                  data_path  => 'gaggle_payload',
                  comment    => $params->{desc} };


  my $pk;
  eval {
  $pk = $sbeams->updateOrInsertRow( rowdata_ref => $dataref,
                                        table_name => $TBBL_GAGGLE_STORE,
                                            insert => 1,
                              add_audit_parameters => 1,
                                         return_PK => 1
                                     );
  };
  if ( $@ ) { print STDERR $@ . "\n"; }
  unless ( $pk ){
    print STDERR "Aw crizzle-nap";
    die "crizzle";
  }
  store_file( $params, $pk );
  print STDERR "gonna print the response\n";
  print "Content-type: text/tab-separated-values\n\n";
  print "$pk";
#  print "OK\t$pk\n";
  print STDERR "printed the response\n";
  exit 0;
}


#+
#
#-
sub fetch_gaggle_store {
  my $params = shift;
  print STDERR "Fetch Dobby\n";
  for my $p ( qw( gaggleStoreID ) ) {
    die "Missing $p\n" unless defined $params->{$p}
  }

  my $clobref = fetch_file( $params->{gaggleStoreID} );
  print STDERR "gonna print the response\n";
  print "Content-type: text/tab-separated-values\n\n";
  print "$$clobref";
#  print "OK\t$pk\n";
  print STDERR "printed the response\n";
  exit 0;
}

sub store_file {
  my $params = shift;
  my $pk = shift;
  my $file = $UPLOAD_DIR . "/gaggle_store/" . $pk . "_data_path.dat";
  open FIL, ">$file" || die "Unable to open file";
  print FIL $params->{clob};
  close FIL;
  print STDERR "Clobby is " . length( $params->{clob} ) . " bytes\n";
}

sub fetch_file {
  my $pk = shift;
  my $file = $UPLOAD_DIR . "/gaggle_store/" . $pk . "_data_path.dat";
  open FIL, "$file" || die "Unable to open file";
  undef local $/;
  my $clob = <FIL>;
  close FIL;
  print STDERR "Read clob, it was " . length( $clob ) . " bytes\n";
  return \$clob;
}

#+
#+
# Read/process CGI parameters
#-
sub process_params {
  my $params = {};

  # Standard SBEAMS processing
  $sbeams->parse_input_parameters( parameters_ref => $params, q => $q );

#for ( keys( %$params ) ){ print "$_ = $params->{$_}<BR>" } 

  # Process "state" parameters
  $sbeams->processStandardParameters( parameters_ref => $params );

  return $params;
}

sub user_host_sql {
  my $params = shift;
  die unless $params->{username};

##$TB_USAGE_LOG 
  return <<"  END";
  SELECT username, remote_host, COUNT(*) FROM sbeams.dbo.usage_log
  WHERE username LIKE '$params->{username}%'
  GROUP BY remote_host, username
  ORDER BY COUNT(*) DESC
  END
}

sub host_user_sql {
  my $params = shift;
  die unless $params->{host};

##$TB_USAGE_LOG 
#  WHERE remote_host = '$params->{host}' OR remote_host = '$params->{host}.systemsbiology.net'
  return <<"  END";
  SELECT username, remote_host, COUNT(*) FROM sbeams.dbo.usage_log
  WHERE remote_host LIKE '$params->{host}%'
  GROUP BY username, remote_host
  ORDER BY COUNT(*) DESC
  END
}

sub writable_project_sql {
  my @projects = $sbeams->getWritableProjects();

  my $project_list = join( ",", @projects );
  die unless $project_list;

  return <<"  END";
  SELECT project_id, name AS project_name FROM $TB_PROJECT 
  WHERE project_id IN ($project_list)
  END
}

sub gaggle_store_list_sql {
  my @projects = $sbeams->getAccessibleProjects();

  my $project_list = join( ",", @projects );
  die unless $project_list;

  return <<"  END";
  SELECT gaggle_store_id, store_name, gs.date_created, 
         username AS owner, name AS project_name
  FROM $TBBL_GAGGLE_STORE gs JOIN $TB_PROJECT p
  ON gs.project_id = p.project_id
  JOIN $TB_USER_LOGIN u
  ON gs.created_by_id = u.contact_id
  WHERE p.project_id IN ($project_list)
  END
}

sub gaggle_store_details_sql {
  my $params = shift;
  die unless $params->{store_details_id};

  my @projects = $sbeams->getAccessibleProjects();
  my $project_list = join( ",", @projects );
  die unless $project_list;

  return <<"  END";
  SELECT * FROM $TBBL_GAGGLE_STORE 
  WHERE gaggle_store_id = $params->{gaggle_store_id}
  AND project_id IN ($project_list)
  END
}