view release on metacpan or  search on metacpan

scripts/create_genex_class.pl  view on Meta::CPAN

  print OUT "sub pkey_name {return \'$PKEY\';}\n\n";
  print OUT "sub linking_table {return 0;}\n";
}

if (scalar @controlled) {
  my $vocab_string = join(' ',@controlled);
  # start a section with *no* variable expansion
  print OUT <<"EOT";

sub get_terms {
  return map {\$_->term_string} shift->get_all_objects();
}
sub get_vocabs {
  return qw($vocab_string);
}
EOT
}

# start a section with variable expansion *enabled*
unless ($IS_LINKING_TABLE) {
  print OUT <<"EOT";
sub insert_db {
  my (\$self,\$dbh) = \@_;
  assert_dbh(\$dbh);

  # iterate over the fields and add them to the INSERT
  my \%values;
  foreach my \$col (\@{\$COLUMN_NAMES}) {
    no strict 'refs';

    # we don't want Bio::Genex::undefined() to get called
    next unless defined \$self->get_attribute(\$col);

    \$values{\$col} = \$self->\$col();
  }

  # don't store a primary key
  delete \$values{'$PKEY'};

  if (grep {\$_ eq 'last_updated'} \@{\$COLUMN_NAMES}) {
    # we set the 'last_updated' field ourselves
    my \$timeformat = '\%r \%A \%B \%d \%Y'; 
    \$values{last_updated} = strftime(\$timeformat, localtime);
  }

  # execute the INSERT
  my \$sql = create_insert_sql(\$dbh,'$module_name',\\\%values);
  \$dbh->do(\$sql);
  
  # on error
  if (\$dbh->err) {
    warn "$ {full_module_name}::insert_db: SQL=<\$sql>, DBI=<\$DBI::errstr>";
    return undef;
  }
  my \$pkey = fetch_last_id(\$dbh,'$module_name');
  \$self->id(\$pkey);
  \$self->$PKEY(\$pkey);
  return \$pkey;
}

sub update_db {
  my (\$self,\$dbh) = \@_;
  assert_dbh(\$dbh);
  die "$ {full_module_name}::update_db: object not in DB"
    unless defined \$self->id() && defined \$self->$PKEY();

  # we must pre-fetch all the attributes 
  \$self->fetch();

  # iterate over the fields and add them to the INSERT
  my \%values;
  foreach my \$col (\@{\$COLUMN_NAMES}) {
    no strict 'refs';

    # we don't want Bio::Genex::undefined() to get called
    next unless defined \$self->get_attribute(\$col);

    \$values{\$col} = \$self->\$col();
  }

  if (grep {\$_ eq 'last_updated'} \@{\$COLUMN_NAMES}) {
    # we set the 'last_updated' field ourselves
    my \$timeformat = '\%r \%A \%B \%d \%Y'; 
    \$values{last_updated} = strftime(\$timeformat, localtime);
  }

  # execute the UPDATE
  my \$WHERE = '$PKEY=' . \$dbh->quote(\$self->$PKEY());
  my \$sql = create_update_sql(\$dbh,
			      TABLE=>'$module_name',
			      SET=>\\\%values,
			      WHERE=>\$WHERE);
  \$dbh->do(\$sql);

  # on error
  if (\$dbh->err) {
    warn "$ {full_module_name}::update_db: SQL=<\$sql>, DBI=<\$DBI::errstr>";
    return undef;
  }
  return 1;
}
EOT
}


# start a section with *no* variable expansion
print OUT <<'EOT';
#
# a workhorse function for retrieving ALL objects of a class
#
sub get_all_objects {
  my ($class) = shift;
  my @objects;
  my $COLUMN2FETCH;
  my $VALUE2FETCH;
  my $pkey_name;
  my $has_args = 0;
EOT

if ($IS_LINKING_TABLE) {
  # start a section with variable expansion *enabled*