genex-cvs-commit Mailing List for GeneX Gene Expression Database (Page 35)

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/genex/genex-server/site/webtools
In directory usw-pr-cvs1:/tmp/cvs-serv19323

Added Files:
      Tag: Rel-1_0_1-branch
	add_analysis.pl 
Log Message:
Initial draft

--- NEW FILE: add_analysis.pl ---
#!/usr/bin/perl -w

=head1 NAME
 
  act_analysis -  add an analysis to the list of possible analyses

=head1 SYNOPSIS

 ./act_analysis

=head1 DESCRIPTION
  The act_analysis is intended to configure an new analysis for use 
 with in the gene analsys system.  It does the following:
   - adds appropriate records to the database based on the config file
   - puts supplied scripts in appropriate locations
   - verifies syntax and runnability of scripts
   - verifies the existence of documentation

=cut

    use strict;
    use DBI;

    use Getopt::Long 2.13;
    use AppConfig qw(:expand :argcount);
    require "sessionlib.pl";


    my $config = AppConfig->new();
    $config->define('name', {ARGCOUNT => ARGCOUNT_ONE},
        'cmdstr', {ARGCOUNT => ARGCOUNT_ONE},
        'up', { ARGCOUNT => ARGCOUNT_LIST },
        'filetype',{ ARGCOUNT => ARGCOUNT_LIST },
        'sp', { ARGCOUNT => ARGCOUNT_LIST },
        'outputfile', { ARGCOUNT => ARGCOUNT_LIST,},
        'inputfile', { ARGCOUNT => ARGCOUNT_LIST,});
    $config->define('configfile', {ARGCOUNT => ARGCOUNT_ONE},
                    'action', {ARGCOUNT => ARGCOUNT_ONE},
                    'debug', {ARGCOUNT => ARGCOUNT_ONE});
    $config->getopt(\@ARGV);


    my $cfgfile = $config->get('configfile');
    my $debug = $config->get('debug');
    usage() if (!defined $cfgfile);
    $config->file($cfgfile);

    modifyDB($config);

# end main

sub modifyDB
{
    my ($config) = @_;

    my $action = $config->get('action');

    # open handle to database
    my $dbh = new_connection();

    if ($action eq 'insert')
    {
        # insert appropriate values in appropriate tables
        # we need to add filetypes (optional)
        act_filetype($dbh, $config->get('filetype'), $action);    

        # we need to add the analysis
        act_analysis($dbh, $config->get('name'), $config->get('cmdstr'),
             $action);  

        # we need to add the input links to filetypes
        act_file_links($dbh, "input", $config->get('inputfile'), 
            $config->get('name'), $action);    

        # we need to add the output links to filetypes
        act_file_links($dbh, "output", $config->get('outputfile'),
            $config->get('name'), $action);    

        # we need to add the sysparams
        act_sysparams($dbh, $config->get('sp'), $config->get('name'), $action); 

        # we need to add the userparams
        act_userparams($dbh, $config->get('up'), $config->get('name'), $action);    
    }
    elsif ($action eq "remove")
    {
        # note: removing must be done in a somewhat opposite
        # order to adding

        # we need to add the input links to filetypes
        act_file_links($dbh, "input", $config->get('inputfile'), 
            $config->get('name'), $action);    

        # we need to add the output links to filetypes
        act_file_links($dbh, "output", $config->get('outputfile'),
            $config->get('name'), $action);    

        # we need to add the sysparams
        act_sysparams($dbh, $config->get('sp'), $config->get('name'), $action);

        # we need to add the userparams
        act_userparams($dbh, $config->get('up'), $config->get('name'), $action);

        # we need to add the analysis
        act_analysis($dbh, $config->get('name'), $config->get('cmdstr'),
             $action);  
        # insert appropriate values in appropriate tables
        # we need to add filetypes (optional)
        act_filetype($dbh, $config->get('filetype'), $action);    
    } 
    else
    {
        print "Unrecognized action: $action\n";
        usage();
    }   
    $dbh->commit();
    $dbh->disconnect(); 

} # addToDB

sub parse_into_records
{
  my @input = @_;
  my @return = ();
  my %rec = ();

  while (my $element = shift(@input))
  { 
    my ($key, $value) = split(/=/, $element);
    #remove spaces from key
    $key =~ tr/ //d;
    if (exists $rec{$key})
    {
      my %dup = %rec;
      push(@return, \%dup);
      %rec = ();
    }
    $rec{$key} = $value;
  }
  push(@return, \%rec);
  return(@return);
  
} #parse_into_record

sub act_filetype
{

  my ($dbh, $filetype, $action) = @_;
  
  my $stm = "";
  my $record;

  my @records = parse_into_records(@$filetype);

  # TODO - handle spaces in keys
  foreach $record (@records)
  {
    my %rec = %$record;
    my $name = $rec{name};
    my $ext = $rec{extension};
    my $comment = $rec{comment};

    checkValidFields([ "name" ], ["name", "extension", "comment"], $record);

    if ($action eq "remove")
    {
      $stm = "delete from filetypes where name = '$name'";
    }
    else
    {
      $stm = "insert into filetypes (name, extension, comment) " . 
        "values ('$name', '$ext', '$comment');";
    }
    print "$stm\n" if $debug;
    my $sth = $dbh->prepare( $stm ); 
    $sth->execute();
  }
  $dbh->commit();
} # act_filetype    

sub act_analysis
{
  my ($dbh, $name, $cmdstr, $action) = @_; 
  my $stm = "";

  if ($action eq "remove")
  {
    $stm = "delete from analysis where name = '$name'";
  }
  else
  {
    $stm = "insert into analysis (name, cmdstr) values ('$name', '$cmdstr');";
  }

  print "$stm\n" if $debug;
  my $sth = $dbh->prepare( $stm ); 
  $sth->execute();
  $dbh->commit();
} # act_analysis   

sub act_file_links
{
  my ($dbh, $table, $filelist, $name, $action) = @_;    

  my $stm = "";
  my $record;

  $table = "analysis_ft_input_link" if $table eq "input";
  $table = "analysis_ft_output_link" if $table eq "output";

  # select the analysis pk for the analysis
  $stm = $dbh->prepare("select anal_pk from analysis where name = '$name'");
  $stm->execute();

  # get result
  my $an_fk = $stm->fetchrow_array();
  if (!defined $an_fk)
  { 
    warn "Unable to get analysis key value for $name";
    return;
  }
  
  foreach my $rec (@$filelist)
  {
    
    # select the filetypes pk for the filetype
    $stm = $dbh->prepare("select ft_pk from filetypes where name = '$rec'");
    $stm->execute();

    my $ft_fk = $stm->fetchrow_array();
    if (!defined $ft_fk)
    { 
      warn "Unable to get filetypes key value for $rec";
    }
    else
    {
        if ($action eq "remove")
        {
            $stm = "delete from $table where anal_fk = '$an_fk'";
        }
        else
        {
            $stm = "insert into $table (anal_fk, ft_fk) " . 
               "values ('$an_fk', '$ft_fk');";
        }
        print "$stm\n" if $debug;
        my $sth = $dbh->prepare( $stm ); 
        $sth->execute();
    }
  }
} # act_file_links

sub act_sysparams
{
  my ($dbh, $sp, $name, $action) = @_; 
  
  my $stm = "";
  my $record;

  my @records = parse_into_records(@$sp);

  # select the analysis pk for the analysis
  $stm = $dbh->prepare("select anal_pk from analysis where name = '$name'");
  $stm->execute();

  # get result
  my $an_fk = $stm->fetchrow_array();
  if (!defined $an_fk)
  { 
    warn "Unable to get analysis key value for $name";
    return;
  }

  foreach $record (@records)
  {
    my %rec = %$record;

    checkValidFields([ "name" ], ["name", "default"], $record);

    my $name = $rec{name};
    my $default ="NULL";

    $default = "'$rec{default}'" if exists($rec{default});
    if ($action eq "remove")
    {
      $stm = "delete from sys_parameter_names where anal_fk = '$an_fk'";
    }
    else
    {
      $stm = "insert into sys_parameter_names (anal_fk, sp_name, sp_default) values ('$an_fk', '$name', $default);";
    }
    print "$stm\n" if $debug;
    my $sth = $dbh->prepare( $stm ); 
    $sth->execute();
  }

  $dbh->commit();
} # act_sysparams   

sub act_userparams
{
  my ($dbh, $up, $name, $action) = @_; 
  
  my $stm = "";
  my $record;

  my @records = parse_into_records(@$up);

  # select the analysis pk for the analysis
  $stm = $dbh->prepare("select anal_pk from analysis where name = '$name'");
  $stm->execute();

  # get result
  my $an_fk = $stm->fetchrow_array();
  if (!defined $an_fk)
  { 
    warn "Unable to get analysis key value for $name";
    return;
  }

  # TODO - handle spaces in keys
  foreach $record (@records)
  {
    my %rec = %$record;
    my $name = $rec{name};
    my $display_name = $rec{display_name};
    my $type = $rec{type};
    my $default ="NULL";

    $default = "'$rec{default}'" if exists($rec{default});

    checkValidFields([ "name", "display_name", "type" ],
         ["name", "display_name", "type", "default"], $record);
    if ($action eq "remove")
    {
      $stm = "delete from user_parameter_names where anal_fk = '$an_fk'";
    }
    else
    {
      $stm = "insert into user_parameter_names (anal_fk, up_name, up_display_name, up_type, up_default) values ('$an_fk', '$name', '$display_name', '$type', $default);";
    }
    print "$stm\n" if $debug;
    my $sth = $dbh->prepare( $stm ); 
    $sth->execute();
  }
} # act_userparams 

sub checkValidFields
{
    my ($reqref, $fieldsref, $record) = @_;

    my @req = @$reqref;
    my @fields = @$fieldsref;
    my %rec = %$record;

    foreach my $req (@req)
    {
        warn "Incorrect configuration. Sys params requires $req field.\n" 
            if (!exists $rec{$req});
    }

    foreach my $key (keys(%rec))
    {
        my $found = 0;
        foreach my $field (@fields)
        {
            $found = 1 if ($field eq $key);
        }
        if (! $found)
        {
            warn "Invalid sys param field: $key.\n";
            warn "Valid field names are: @fields\n";
        }
    }
} # checkValidFields

sub usage
{
      print "Usage: \n";
      print "./act_analysis.pl --configfile <filename>\n";
} # usage

2002	Jan	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep	Oct (267)	Nov (344)	Dec (119)
2003	Jan (23)	Feb (15)	Mar (16)	Apr (388)	May	Jun (4)	Jul	Aug	Sep (4)	Oct	Nov	Dec

genex-cvs-commit Mailing List for GeneX Gene Expression Database (Page 35)

genex-cvs-commit — CVS commit messages