<commit_before>#! /usr/bin/perl -w
use strict;
use CGI;
use CGI::Carp 'fatalsToBrowser';
use HTML::Template;
use Data::Dumper;
use CGI::Ajax;

use Benchmark;
use File::Path;
use DBI;
use POSIX;
use Digest::MD5 qw(md5_base64);
no warnings 'redefine';

use CoGe::Accessory::Web;
use CoGe::Accessory::genetic_code;
use CoGe::Accessory::LogUser;
use CoGeX;

use vars qw($P $DBNAME $DBHOST $DBPORT $DBUSER $DBPASS $connstr $DATE $DEBUG $TEMPDIR $TEMPURL $USER $FORM $DIAGSDIR $coge $COOKIE_NAME);
$P = CoGe::Accessory::Web::get_defaults($ENV{HOME}.'coge.conf');
$ENV{PATH} = $P->{COGEDIR};
$DIAGSDIR = $P->{DIAGSDIR};

# set this to 1 to print verbose messages to logs
$DEBUG = 0;
#$TEMPDIR = $P->{TEMPDIR}."SynSub";
#$TEMPURL = $P->{TEMPURL}."SynSub";
#mkpath ($TEMPDIR, 0,0777) unless -d $TEMPDIR;
$| = 1; # turn off buffering
$DATE = sprintf( "%04d-%02d-%02d %02d:%02d:%02d",
		 sub { ($_[5]+1900, $_[4]+1, $_[3]),$_[2],$_[1],$_[0] }->(localtime));

$FORM = new CGI;
$DBNAME = $P->{DBNAME};
$DBHOST = $P->{DBHOST};
$DBPORT = $P->{DBPORT};
$DBUSER = $P->{DBUSER};
$DBPASS = $P->{DBPASS};
$connstr = "dbi:mysql:dbname=".$DBNAME.";host=".$DBHOST.";port=".$DBPORT;
$coge = CoGeX->connect($connstr, $DBUSER, $DBPASS );

$COOKIE_NAME = $P->{COOKIE_NAME};

my ($cas_ticket) =$FORM->param('ticket');
$USER = undef;
($USER) = CoGe::Accessory::Web->login_cas(cookie_name=>$COOKIE_NAME, ticket=>$cas_ticket, coge=>$coge, this_url=>$FORM->url()) if($cas_ticket);
($USER) = CoGe::Accessory::LogUser->get_user(cookie_name=>$COOKIE_NAME,coge=>$coge) unless $USER;

my $pj = new CGI::Ajax(
		       gen_data=>\&gen_data,
		      );
$pj->JSDEBUG(0);
$pj->DEBUG(0);
#print $pj->build_html($FORM, \&gen_html);
print "Content-Type: text/html\n\n";print gen_html($FORM);
sub gen_html
  {
    my ($body) = gen_body();
    
    my $template = HTML::Template->new(filename=>$P->{TMPLDIR}.'generic_page.tmpl');
    $template->param(PAGE_TITLE=>'SynSub');
    $template->param(TITLE=>'Synteny Substitution Matrix');
    $template->param(HEAD=>qq{});
    $template->param(HELP=>"/wiki/index.php?title=SynSub");
    my $name = $USER->user_name;
    $name = $USER->first_name if $USER->first_name;
    $name .= " ".$USER->last_name if $USER->first_name && $USER->last_name;
    $template->param(USER=>$name);
    
    $template->param(LOGON=>1) unless $USER->user_name eq "public";
    $template->param(DATE=>$DATE);
    $template->param(LOGO_PNG=>"SynSub-logo.png");
    $template->param(BODY=>$body);
    my $html = $template->output;
    return $html;
  }
  

sub gen_body
  {
    my $form = shift || $FORM;
    my $template = HTML::Template->new(filename=>$P->{TMPLDIR}.'SynSub.tmpl');

    my $dsgid1 = $form->param('dsgid1');
    my $dsgid2 = $form->param('dsgid2');
    return "Need two dsgids to run." unless $dsgid1 && $dsgid2;
    my ($dsg1) = $coge->resultset('Genome')->find($dsgid1);
    my ($dsg2) = $coge->resultset('Genome')->find($dsgid2);

    my $color_type = $form->param('ct'); #color type for matrices output
    $color_type = "RYB" unless $color_type;
    #get gc content of genomes
    unless ($dsg1 && $dsg2)
      {
	return "<span class=alert>Problem generating dataset group objects for ids:  $dsgid1, $dsgid2.</span>";
      }
    my $org_name1 = $dsg1->organism->name;
    my $org_name2 = $dsg2->organism->name;
    ($dsgid1, $dsg1, $org_name1, $dsgid2, $dsg2, $org_name2) = ($dsgid2, $dsg2, $org_name2, $dsgid1, $dsg1, $org_name1) if ($org_name2 lt $org_name1);
    #generate directory tree
    my $tmp1 = $org_name1;
    my $tmp2 = $org_name2;
    foreach my $tmp ($tmp1, $tmp2)
      {
	$tmp =~ s/\///g;
	$tmp =~ s/\s+/_/g;
	$tmp =~ s/\(//g;
	$tmp =~ s/\)//g;
	$tmp =~ s/://g;
	$tmp =~ s/;//g;
	$tmp =~ s/#/_/g;
      }
    my $basedir = $DIAGSDIR."/".$tmp1."/".$tmp2;
    my $basename = $dsgid1."_".$dsgid2.".CDS-CDS";
    my $sqlite = $basedir."/".$basename.".sqlite";
    my ($freq_dna, $org1_dna_counts, $org2_dna_counts, $total_dna_counts, $freq_prot, $org1_prot_counts, $org2_prot_counts, $total_prot_counts, $org1_percent_gc_cds, $org2_percent_gc_cds, $org1_percent_gc_wobble, $org2_percent_gc_wobble) = get_counts(sqlite=>$sqlite);
    my ($dna_matrix1, $dna_matrix2) = gen_matrix(freq=>$freq_dna, org1_counts => $org1_dna_counts, org2_counts=>$org2_dna_counts);
    my ($prot_matrix1, $prot_matrix2) = gen_matrix(freq=>$freq_prot, org1_counts => $org1_prot_counts, org2_counts=>$org2_prot_counts);

    my ($org1_gc, $org1_length) = get_gc_dsg($dsg1);
    my ($org2_gc, $org2_length) = get_gc_dsg($dsg2);
    my $temp_name1 = $org_name1;
    my $temp_name2 = $org_name2;
    $temp_name1 =~ s/(^\S+\s+\S+)\s/$1<br>/;<commit_msg>Updated creation of directory for data files to new format.<commit_after>#! /usr/bin/perl -w
use strict;
use CGI;
use CGI::Carp 'fatalsToBrowser';
use HTML::Template;
use Data::Dumper;
use CGI::Ajax;

use Benchmark;
use File::Path;
use DBI;
use POSIX;
use Digest::MD5 qw(md5_base64);
no warnings 'redefine';

use CoGe::Accessory::Web;
use CoGe::Accessory::genetic_code;
use CoGe::Accessory::LogUser;
use CoGeX;

use vars qw($P $DBNAME $DBHOST $DBPORT $DBUSER $DBPASS $connstr $DATE $DEBUG $TEMPDIR $TEMPURL $USER $FORM $DIAGSDIR $coge $COOKIE_NAME);
$P = CoGe::Accessory::Web::get_defaults($ENV{HOME}.'coge.conf');
$ENV{PATH} = $P->{COGEDIR};
$DIAGSDIR = $P->{DIAGSDIR};

# set this to 1 to print verbose messages to logs
$DEBUG = 0;
#$TEMPDIR = $P->{TEMPDIR}."SynSub";
#$TEMPURL = $P->{TEMPURL}."SynSub";
#mkpath ($TEMPDIR, 0,0777) unless -d $TEMPDIR;
$| = 1; # turn off buffering
$DATE = sprintf( "%04d-%02d-%02d %02d:%02d:%02d",
		 sub { ($_[5]+1900, $_[4]+1, $_[3]),$_[2],$_[1],$_[0] }->(localtime));

$FORM = new CGI;
$DBNAME = $P->{DBNAME};
$DBHOST = $P->{DBHOST};
$DBPORT = $P->{DBPORT};
$DBUSER = $P->{DBUSER};
$DBPASS = $P->{DBPASS};
$connstr = "dbi:mysql:dbname=".$DBNAME.";host=".$DBHOST.";port=".$DBPORT;
$coge = CoGeX->connect($connstr, $DBUSER, $DBPASS );

$COOKIE_NAME = $P->{COOKIE_NAME};

my ($cas_ticket) =$FORM->param('ticket');
$USER = undef;
($USER) = CoGe::Accessory::Web->login_cas(cookie_name=>$COOKIE_NAME, ticket=>$cas_ticket, coge=>$coge, this_url=>$FORM->url()) if($cas_ticket);
($USER) = CoGe::Accessory::LogUser->get_user(cookie_name=>$COOKIE_NAME,coge=>$coge) unless $USER;

my $pj = new CGI::Ajax(
		       gen_data=>\&gen_data,
		      );
$pj->JSDEBUG(0);
$pj->DEBUG(0);
#print $pj->build_html($FORM, \&gen_html);
print "Content-Type: text/html\n\n";print gen_html($FORM);
sub gen_html
  {
    my ($body) = gen_body();
    
    my $template = HTML::Template->new(filename=>$P->{TMPLDIR}.'generic_page.tmpl');
    $template->param(PAGE_TITLE=>'SynSub');
    $template->param(TITLE=>'Synteny Substitution Matrix');
    $template->param(HEAD=>qq{});
    $template->param(HELP=>"/wiki/index.php?title=SynSub");
    my $name = $USER->user_name;
    $name = $USER->first_name if $USER->first_name;
    $name .= " ".$USER->last_name if $USER->first_name && $USER->last_name;
    $template->param(USER=>$name);
    
    $template->param(LOGON=>1) unless $USER->user_name eq "public";
    $template->param(DATE=>$DATE);
    $template->param(LOGO_PNG=>"SynSub-logo.png");
    $template->param(BODY=>$body);
    my $html = $template->output;
    return $html;
  }
  

sub gen_body
  {
    my $form = shift || $FORM;
    my $template = HTML::Template->new(filename=>$P->{TMPLDIR}.'SynSub.tmpl');

    my $dsgid1 = $form->param('dsgid1');
    my $dsgid2 = $form->param('dsgid2');
    return "Need two dsgids to run." unless $dsgid1 && $dsgid2;
    my ($dsg1) = $coge->resultset('Genome')->find($dsgid1);
    my ($dsg2) = $coge->resultset('Genome')->find($dsgid2);

    my $color_type = $form->param('ct'); #color type for matrices output
    $color_type = "RYB" unless $color_type;
    #get gc content of genomes
    unless ($dsg1 && $dsg2)
      {
	return "<span class=alert>Problem generating dataset group objects for ids:  $dsgid1, $dsgid2.</span>";
      }
    my $org_name1 = $dsg1->organism->name;
    my $org_name2 = $dsg2->organism->name;
    ($dsgid1, $dsg1, $org_name1, $dsgid2, $dsg2, $org_name2) = ($dsgid2, $dsg2, $org_name2, $dsgid1, $dsg1, $org_name1) if ($org_name2 lt $org_name1);
    my ($dir1, $dir2) = sort ($dsgid1, $dsgid2);

    my $basedir = "$DIAGSDIR/$dir1/$dir2";
    my $basename = $dsgid1."_".$dsgid2.".CDS-CDS";
    my $sqlite = $basedir."/".$basename.".sqlite";
    my ($freq_dna, $org1_dna_counts, $org2_dna_counts, $total_dna_counts, $freq_prot, $org1_prot_counts, $org2_prot_counts, $total_prot_counts, $org1_percent_gc_cds, $org2_percent_gc_cds, $org1_percent_gc_wobble, $org2_percent_gc_wobble) = get_counts(sqlite=>$sqlite);
    my ($dna_matrix1, $dna_matrix2) = gen_matrix(freq=>$freq_dna, org1_counts => $org1_dna_counts, org2_counts=>$org2_dna_counts);
    my ($prot_matrix1, $prot_matrix2) = gen_matrix(freq=>$freq_prot, org1_counts => $org1_prot_counts, org2_counts=>$org2_prot_counts);

    my ($org1_gc, $org1_length) = get_gc_dsg($dsg1);
    my ($org2_gc, $org2_length) = get_gc_dsg($dsg2);
    my $temp_name1 = $org_name1;
    my $temp_name2 = $org_name2;
    $temp_name1 =~ s/(^\S+\s+\S+)\s/$1<br>/;
{'fraction_non_alphanumeric': 0.21045694200351495, 'fraction_numerical': 0.024384885764499122, 'mean_word_length': 4.780952380952381, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 161, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7410040', 'n_tokens_mistral': 3970, 'n_tokens_neox': 3869, 'n_words': 688}