view release on metacpan or  search on metacpan

scripts/db2xml.pl.in  view on Meta::CPAN

    foreach my $spc_db (Bio::Genex::Species->get_all_objects()) {
      do_species($spc_db);
    }
  }

  # for now all contact and group info is written
  do_all_contact();
#  do_all_group();

  do_all_db();
  do_all_scanner();
  do_all_spotter();
  do_all_software();
  do_all_protocol();
  unless ($OPTIONS{debug_no_als}) {
    if ($OPTIONS{profile}) {
      my $t = timeit(1, sub {do_all_al()});
      print STDERR "Time for ALS = ", timestr($t), "\n";
    } else {
      do_all_al();
    }
  }
}
sub do_experiment {
  my $es_db = shift;

  # make the node for the experiment set
  my $es_node = create_element('experiment_set');
  my $id = create_id('ExperimentSet', $es_db->es_pk);
  $es_node->setAttribute('id',$id);
  
  # create the header and add it to the experiment set
  my $es_header_node = create_element('experiment_set_header');
  $es_node->appendChild($es_header_node);

  # this is not strictly necessary, but since we're going
  # to be writing out all the information, might as well
  $es_db->fetch();
  
  #
  # Handle the foreign keys
  #
  
  # do the species
  my $dbh = Bio::Genex::current_connection();
  my $spc_db = fetch_es_species($dbh,$es_db->es_pk);
  do_species($spc_db);

  # do the citations
  if (defined $es_db->cit_obj) {
    $es_node->setAttribute('citation_ids',do_citation($es_db->cit_obj));
  } else {
    # not all experiments have citations, so this is not a warning
  }

  # get the owner's contact information
  my $owner_id = do_contact($es_db->provider_con_obj);
  $es_node->setAttribute('owner_contact_id', $owner_id);

  # do the group
  my $gid = do_group($es_db->gs_obj);
  $es_node->setAttribute('group_id', $gid);

  # add an experiment_factors_list to the header
  do_factor_list($es_header_node,$es_db);
  my %column2name = %{Bio::Genex::ExperimentSet->column2name()};
  foreach my $column (keys %column2name) {
    # because we are under the restrictions of 'use strict'
    # we need this to get away with the dynamic cuteness of 
    # $obj->$func_name()
    no strict 'subs';
    
    # we need a way to deal with exporting the accession number
    # so we don't bother printing out the experiment set primary key
    # but if the local accession number isn't defined we declare it
    # as local to NCGR
    next if $column eq 'es_pk';
    if ($column eq 'local_accession') {
      if (defined $es_db->local_accession && 
	  $es_db->local_accession !~ /^\s*$/) {
	$es_node->setAttribute($EXPERIMENT2GENEXML{$column},$es_db->$column());
      } else {
	# this experiment set is local to NCGR, so we use the 
	# primary key as the local accession
	$es_node->setAttribute($EXPERIMENT2GENEXML{$column},
			       'NCGR.ORG:' . $es_db->es_pk);
      }
    } elsif ($column =~ /type/) {
      my $type = $es_db->$column();
      next unless defined $type;
      $type  =~ s/ /_/g;
      $es_node->setAttribute($column, $type);      
    } elsif ($column =~ /^(?:analysis_description|
			   biology_description)$/x) {
      # some data maps to the header
      my $node = create_element($column);
      $node->addText($es_db->$column());
      $es_header_node->appendChild($node);
    } else {
      # we only print things if we should
      next unless exists $EXPERIMENT2GENEXML{$column};
      
      # the default case is just to add it as an attribute
      # we may need to remap the column names to fit the DTD 
      $es_node->setAttribute($EXPERIMENT2GENEXML{$column},
			     $es_db->$column());      
    }
  }
  $es_node->setAttribute("name",$es_db->name);

  # now handle the arrays
  unless ($OPTIONS{debug_no_ams}) {
    my $code = sub {
      my @array_list = fetch_am_ids($es_db->es_pk,@AM_TYPES);
      unless (scalar @array_list) {
	warn "No arrays found for experiment: " . $es_db->name();
	return $es_node;
      }
      @array_list = Bio::Genex::ArrayMeasurement->get_objects(@array_list);
      do_arrays($es_node,$es_db,@array_list);
    };
    if ($OPTIONS{profile}) {

scripts/db2xml.pl.in  view on Meta::CPAN

    # handle the array layout
    my $array_layout_db = $am_db->al_obj();
    if (defined $array_layout_db) {
      my $id;
      if ($OPTIONS{profile}) {
	my $t = timeit(1, sub {
			 $id = do_al($array_layout_db);
		       });
	print STDERR "Time for ALS = ", timestr($t), "\n";
      } else {
	$id = do_al($array_layout_db);
      }
      $am_node->setAttribute('array_layout_id',$id);
    }

    # handle the spotter software
    my $software_db = $am_db->spotter_sw_obj();
    if (defined $software_db) {
      # don't enter it if it already exists
      my $id = do_software($software_db);
      $am_node->setAttribute('spotter_sw_id',$id);
    }

    # handle the scanner software
    $software_db = $am_db->scan_sw_obj();
    if (defined $software_db) {
      # don't enter it if it already exists
      my $id = do_software($software_db);
      $am_node->setAttribute('scanner_sw_id',$id);
    }

    # handle the image analysis software
    $software_db = $am_db->image_anal_sw_obj();
    if (defined $software_db) {
      # don't enter it if it already exists
      my $id = do_software($software_db);
      $am_node->setAttribute('image_analysis_sw_id',$id);
    }

    # handle the spotter hardware
    my $hardware_db = $am_db->sptr_obj();
    if (defined $hardware_db) {
      # don't enter it if it already exists
      my $id = do_spotter($hardware_db);
      $am_node->setAttribute('spotter_hw_id',$id);
    }

    # handle the scanner hardware
    $hardware_db = $am_db->scn_obj();
    if (defined $hardware_db) {
      # don't enter it if it already exists
      my $id = do_scanner($hardware_db);
      $am_node->setAttribute('scanner_hw_id',$id);
    }

    # get the owner's contact information
    my $owner_id = do_contact($am_db->us_obj->con_obj);
    $am_node->setAttribute('owner_contact_id', $owner_id);

    # do the group
    my $gid = do_group($am_db->gs_obj);
    $am_node->setAttribute('group_id', $gid);

    # handle the ArrayMeasurement columns general to all
    # measurements in the hybridization group
    foreach my $column (@ARRAY_COLUMNS) {
      if ($column =~ /^(?:hybridization_stringency|
			instance_code|
		       )
	              $/x) {
	$am_node->setAttribute($ARRAY2GENEXML{$column},$am_db->$column());
      } else {
	$am_node->setAttribute($column,$am_db->$column());
      }
    }

    # add the sub elements of <array>
    foreach my $column (qw /spotter_hw_params
			spotter_sw_params
			scan_hw_params
			scan_sw_params
			image_anal_sw_params /) {
      next unless defined $am_db->$column();

      die "do_arrays: Invalid column name: $column" 
	unless defined $ARRAY2GENEXML{$column};
      my $node = create_element($ARRAY2GENEXML{$column});
      $node->addText($am_db->$column());
      $am_node->appendChild($node);
    }

    # now we enter the specific information for each array measurement
    foreach my $am (@hyb_list) {
      if ($OPTIONS{profile}) {
	my $t = timeit(1, sub {
			 do_array_measurement($am_node,$am);
		       });
	print STDERR "Time for Array = ", timestr($t), "\n";
      } else {
	do_array_measurement($am_node,$am);
      }
      last if $OPTIONS{debug_one_ams};
    }
    last if $OPTIONS{debug_one_hyb};
  }
}

sub do_user {
  my $us_db = shift;
}

#
# Subroutines for on-demand writing of DB objects as XML
#   these are called when it is discovered that the object
#   does not yet exist in the GeneXML header.
#
#   These really belong in XMLUtils.pm

package Bio::Genex::ArrayLayout;

sub add_genexml_entry {
  my ($class,$pkey) = @_;