<![CDATA[
#!perl -w
use strict;
# documentation written in pod, perldoc perlpod
=head1 NAME
seqfun.pl
=head1 DESCRIPTION
Simple example of building objects for sequences.
=head1 SYNOPSIS
seqfun.pl [man|help]
seqfun.pl [all|cat|dna2rna] [sequence=<sequence>] ... [filename=<filename>] ...
=head1 OPTIONS
All options must have a single or double hyphen in front of the name. Only
the minimum name that is unique is required.
=over 4
=item --all
Execute all sequence functions.
=item --cat
Concatenate each sequences into one big sequence.
=item --dna2rna
Transcribe each sequences from dna to rna.
=item --eg
Show the EXAMPLES section from documentation.
=item --filename
Read in a filename or a list of filenames separated by commas
or specified from the command line.
--filename=one --filename=two --filename="three,four,five"
Each file will add each line to the list of sequences.
=item --help or ?
Show a help page
=item --man
Show a man page or complete reference.
=item --reversecomplement
Changes each sequence to the reverse complement.
=item --sequence
Read in a sequence or list of sequences separated by commas
or specified from the command line.
=item --test
Test all functions.
=item --verbose
Show original sequences before executing any functions.
=back
=head1 EXAMPLES
perl seqfun.pl --cat --seq='ACGGTTATAGC','ATAGTTAGTA'
perl seqfun.pl --dna2rna --seq='ACGGGAGGACGGGAAAATTACTACGGCATTAGC'
perl seqfun.pl --all --seq='ACGGTTATAGC','ATAGTTAGTA'
perl seqfun.pl --v --all filename='NM_021964fragment.pep'
=head1 NOTES
Working with sequences shows the need to work with nucleotides
and proteins, and to be able to manipulate back and forth with
various utilities.
=head1 AUTHOR
Written by David Scott to tease out a super simple library.
=cut
package main; # default namespace
# Perl libraries
use English; # English names on special variables
use SelfLoader; # Autoload for test routines
use Pod::Usage; # documentation reader library, pod2usage()
use Getopt::Long; # option reader library, GetOptions()
# User libraries
use SeqFun qw/show_eg/;
use Seq;
pod2usage(0) if $#ARGV == -1; # no arguments if @ARGV has no entries
# general options
my $all = ""; # run everything, false by default
my $help = ""; # no help by default
my $man = ""; # no man page by default
my $quiet = ""; # opposite of verbose
my $showeg = ""; # no examples by default
my $test = ""; # test routine
my $verbose = ""; # false by default
# application options
my @sequence = (); # empty list of sequences
my @filename = (); # empty list of filenames
my $cat = ""; # false, concatenate
my $dna2rna = ""; # false, transcribe dna to rna
my $rc = ""; # false, reverse complement
GetOptions( "verbose!" => \$verbose, quiet => sub { $verbose = 0; },
all => \$all, 'help|?' => \$help, man => \$man, eg => \$showeg,
test => \$test,
"sequence:s" => \@sequence, "filename:s" => \@filename,
cat => \$cat, dna2rna => \$dna2rna, reversecomplement => \$rc,
);
pod2usage(1) if $help;
pod2usage(-message => 'Spurious argument(s) left: ' . "@ARGV",
-verbose => 1) if $#ARGV != -1;
pod2usage(-exitstatus => 0, -verbose => 2) if $man;
if ( $showeg ) {
print show_eg(`podselect -s "EXAMPLES" $PROGRAM_NAME`);
exit(0);
}
test() if $test;
# Enable comma separated sequences
@sequence = split(/,/,join(',',@sequence));
# Clear out sequence quoting from the command line
my @clearance = ();
foreach my $seq (@sequence) {
$seq =~ s/\"//g;
$seq =~ s/\'//g;
push @clearance, Seq->new($seq);
}
@sequence = ();
@sequence = @clearance;
# Enable comma separated filenames
@filename = split(/,/,join(',',@filename));
# Clear out filename quoting from the command line
my @clearname = ();
foreach my $filename (@filename) {
$filename =~ s/\"$//;
$filename =~ s/^\"//;
$filename =~ s/\'$//;
$filename =~ s/^\'//;
push @clearname, $filename;
}
@filename = ();
@filename = @clearname;
# Add any filename sequences to the list of sequences
foreach my $filename (@filename) {
push @sequence, Seq->read($filename);
@clearance = ();
@clearance = @sequence;
}
# Show the original sequences if verbose
if ( $verbose ) {
print "Sequences:\n";
foreach my $seq (@sequence) {
print $seq->print();
print "\n";
}
}
# concatenate all sequences from @clearance
my $bigseq = "";
if ( $cat or $all ) {
$bigseq = shift @clearance;
foreach my $seq (@clearance) {
$bigseq = $bigseq->concatenate($seq->seq);
}
print "Result of concatenating sequences:\n\n";
print $bigseq->print();
}
# dna transcribed to rna
if ( $dna2rna or $all ) {
print "\n" if $cat or $all;
print "Transcribing DNA to RNA:\n\n";
foreach my $seq (@sequence) {
print $seq->dna->dna2rna()->print;
}
print $bigseq->dna->dna2rna()->print if $bigseq;
}
# reverse complement of sequence(s)
if ( $rc or $all ) {
print "\n" if $rc or $all;
print "Reverse Complement \n\n";
foreach my $seq (@sequence) {
print $seq->dna->revcom()->print;
}
print $bigseq->dna->revcom()->print if $bigseq;
}
# Successful Exit
exit 0;
__DATA__
# test functions
#
sub test {
system("perl t/seqfun.t");
system("perl t/gettersetter.t");
system("perl t/seq.t");
# successful exit
exit (0);
}
]]>