目前分類:perl (12)

瀏覽方式: 標題列表 簡短摘要

Source: http://www.perlmonks.org/?node_id=287647

open FILEHANDLE, 'somefile.txt' or die $!;
my $string = do { local $/; <FILEHANDLE> };

How it works
The first piece of this code is the do "function", which returns the value of the last expression executed in it's block. In this case, that last expression is simply <FILEHANDLE>.

The expression <FILEHANDLE> will either return the next line from the filehandle if it is called in scalar context, or it will return the entire contents from the filehandle as a list if called in list context:

my $scalar = <FILEHANDLE>;    # one line
my @array  = <FILEHANDLE>;    # whole file

The reason why <FILEHANDLE> only returns one line is because by default, the built-in Perl variable $/ is set to one newline. $/ is the input record seperator, and it can be used to modify the behavior of how many records are read in when you use the diamond operators (<FILEHANDLE>). The docs explain that if $/ is set to undef, then accessing <FILEHANDLE> in scalar context will grab everything until the end of the file:

undef $/;
my $scalar = <FILEHANDLE>;   # whole file

However, changing Perl's built-in variables can be dangerous. Imagine you wrote a module that others use. Inside this module you set $/ to undef, thinking that everywhere else $/ will be the default value. Well, wrong. You just changed $/ for everyone that uses your module. This is one of those few places where local is the right choice.

Which brings us to the FIRST expression in our do block:

local $/;

This is the same thing as explicitly assigning $/ to undef:

local $/ = undef;

But not the same as:

$/ = undef;           # Danger Will Robinson! Danger!

Because we are inside a do block when we use local, the value of $/ is temporarily changed, and we can rest assured that it will not affect code outside of our block (or scope). If we were not inside another block or scope, local $/ will only affect the package it was encountered in, but it's better to contain local $/ inside a temporay scope, unless you enjoy debugging hard to find bugs. 

wenching520 發表在 痞客邦 留言(0) 人氣()

http://www.perlmonks.org/?node_id=517176

$array = \(); doesn't create a reference to an empty array. You probably want $array = [];

\() creates individual references to each entity inside of the ().

Since there is no entity inside of your (), no reference is created.

[] is the anonymous array constructor. That's what you're looking for.

$array = [];

wenching520 發表在 痞客邦 留言(0) 人氣()

http://www.perl.com/pub/a/2004/06/18/variables.html

The Field Record Separators

Next, we'll look at $/ and $\ which are the input and output record separators respectively.

wenching520 發表在 痞客邦 留言(0) 人氣()

#!/usr/bin/perl -w

use warnings;
use strict;


main();
exit(0);

sub main {
 my @aAry = ( 1, 2, 3 );
 print( "Before calling subroutine1...\n" );
 print( "Array in main:" );
 foreach my $iPiece ( @aAry ) {
  print( "\t$iPiece" );
 }
 print( "\n" );
 
 &_subroutine1( \@aAry );
 
 print( "After calling subroutine1 and Before calling subroutine2...\n" );
 print( "Array in main:" );
 foreach my $iPiece ( @aAry ) {
  print( "\t$iPiece" );
 }
 print( "\n" );
 
 &_subroutine2( \@aAry );
 
 print( "After calling subroutine2...\n" );
 print( "Array in main:" );
 foreach my $iPiece ( @aAry ) {
  print( "\t$iPiece" );
 }
 print( "\n" );
 
}

sub _subroutine1 {
 my @aAry = @{shift @_};
 
 @aAry = reverse @aAry;
 
 print( "Array in subroutine1:" );
 foreach my $iPiece ( @aAry ) {
  print( "\t$iPiece" );
 }
 print( "\n" );
}

sub _subroutine2 {
 my $raAry = shift;
 
 @{$raAry} = reverse @{$raAry};
 
 print( "Array in subroutine2:" );
 foreach my $iPiece ( @{$raAry} ) {
  print( "\t$iPiece" );
 }
 print( "\n" );
}

wenching520 發表在 痞客邦 留言(0) 人氣()

http://dev.mysql.com/doc/refman/5.0/en/blob.html

10.4.3. The BLOB and TEXT Types
A BLOB is a binary large object that can hold a variable amount of data. The four BLOB types are TINYBLOB, BLOB, MEDIUMBLOB, and LONGBLOB. These differ only in the maximum length of the values they can hold.

BLOB columns are treated as binary strings (byte strings). TEXT columns are treated as non-binary strings (character strings). BLOB columns have no character set, and sorting and comparison are based on the numeric values of the bytes in column values. TEXT columns have a character set, and values are sorted and compared based on the collation of the character set.

http://www.icewalkers.com/Perl/5.8.0/lib/DBI/FAQ.html#5.2%20How%20do%20I%20handle%20BLOB%20data%20with%20DBI%3f 

5.2 How do I handle BLOB data with DBI?
XX

wenching520 發表在 痞客邦 留言(0) 人氣()

E.g.,
By using repeat operator 'x', you could initialize multiple variables at one time.

my ( $iX, $iY, $iZ ) = (1) x 3;

my ($sX, $sY, $sZ ) = (undef) x 3; or
my ($sX, $sY, $sZ ) = "test" x 3;

wenching520 發表在 痞客邦 留言(0) 人氣()

http://www.itworld.com/nl/perl/09202001/

Repeating Yourself: The X Operator
Andrew Johnson

The x operator can return repeated lists if used in list context and if the left operand is a literal list (i.e., wrapped in parentheses):

my @array = (1,2,3) x 2;
print "@array" # prints: 1 2 3 1 2 3

You need to be careful to put the left operand in parentheses for list repetition --- using a plain array will not behave as desired:

my @array = (1,12,42);
@array = @array x 2; print "@array\n"; # prints: 33

In this case, because the left operand is not in parentheses it is evaluated as a scalar, and an array in scalar context returns the number of elements in the array --- in this case 3 --- thus the x operator has returned the string '3' repeated twice.

Is this operator practical? Consider a case where you want to define a ten-element array and initialize each element to 1:

my @array = (1) x 10; # my @array = (1,1,1,1,1,1,1,1,1,1);

Another useful case is initializing a hash when we've read in (or otherwise obtained) a list of keys we wish to initialize to 1:

my @keys = qw(a b c d);
my %hash; @hash{@keys} = (1) x @keys;

Lastly, a minor cautionary note --- remember that 'x' is not the multiplication operator:

my $value = 15 x 2 / 3;
print "$value\n"; # prints: 505

Here the number 15 is treated as a string and repeated twice to get 1515 which is then treated as a number and divided by 3 to get 505 (rather than the result of 10 you might have wanted). This is one case where Perl's natural conversion between numbers and strings without warning can mean that a simple typo ('x' instead of '*') can lead to strange results and is difficult to track down. So, if you have calculations in your code and you are getting bizarre results you might want to check for this particular typo.

wenching520 發表在 痞客邦 留言(0) 人氣()

Reference: http://mamchenkov.net/wordpress/2005/07/06/analysis-of-two-perl-lines/

Usage:
test_statement ? true_event : false_event

wenching520 發表在 痞客邦 留言(1) 人氣()

Source: http://www.bioperl.org/wiki/HOWTO:SearchIO
use strict;
use Bio::SearchIO;
my $usage = "Bio_SearchIO_blast.pl infile\n";
my $sInFile = shift or die $usage;
my $in = new Bio::SearchIO(-format => 'blast', -file   => $sInFile);

while( my $result = $in->next_result ) {
        print "result_algorithm: " . $result->algorithm() . " \n";
        print "result_algorithm_version: " . $result->algorithm_version() . " \n";
        print "result_query_name: " . $result->query_name() . " \n";
        print "result_query_accession: " . $result->query_accession() . " \n";
        print "result_query_length: " . $result->query_length() . " \n";
        print "result_query_description: " . $result->query_description() . " \n";
        print "result_database_name: " . $result->database_name() . " \n";
        print "result_database_letters: " . $result->database_letters() . " \n";
        print "result_database_entries: " . $result->database_entries() . " \n";
        print "result_available_statistics: " . $result->available_statistics() . " \n";
        print "result_available_parameters: " . $result->available_parameters() . " \n";
        print "result_num_hits: " . $result->num_hits() . " \n";

        while( my $hit = $result->next_hit ) {
                print "\n";
                print "hit_name: " . $hit->name() . " \n";
                print "hit_Length of the Hit sequence: " . $hit->length() . " \n";
                print "hit_accession: " . $hit->accession() . " \n";
                print "hit_hit description: " . $hit->description() . " \n";
                print "hit_algorithm: " . $hit->algorithm() . " \n";
                print "hit_hit raw score: " . $hit->raw_score() . " \n";
                print "hit_hit significance: " . $hit->significance() . " \n";
                print "hit_hit bits: " . $hit->bits() . " \n";
                print "hit_number of HSPs in hit: " . $hit->num_hsps() . " \n";
                print "hit_locus name: " . $hit->locus() . " \n";

                while( my $hsp = $hit->next_hsp ) {
                        print "\n";
                        print "hsp_algorithm: " . $hsp->algorithm() . " \n";
                        print "hsp_evalue: " . $hsp->evalue() . " \n";
                        print "hsp_alias for evalue(): " . $hsp->expect() . " \n";
                        print "hsp_frac_identical: " . $hsp->frac_identical() . " \n";
                        print "hsp_frac_conserved: " . $hsp->frac_conserved() . " \n";
                        print "hsp_number of gaps: " . $hsp->gaps() . " \n";
                        print "hsp_query string from alignment: " . $hsp->query_string() . " \n";
                        print "hsp_hit string from alignment: " . $hsp->hit_string() . " \n";
                        print "hsp_string from alignment: " . $hsp->homology_string() . " \n";
                        print "hsp_length of HSP (including gaps) : " . $hsp->length('total') . " \n";
                        print "hsp_length of hit participating in alignment minus gaps: " . $hsp->length('hit') . " \n";
                        print "hsp_length of query participating in alignment minus gaps: " . $hsp->length('query') . " \n";
                        print "hsp_Length of the HSP (including gaps) alias for length('total'): " . $hsp->hsp_length() . " \n";
                        print "hsp_frame: " . $hsp->frame() . " \n";
                        print "hsp_number of conserved residues: " . $hsp->num_conserved() . " \n";
                        print "hsp_number of identical residues: " . $hsp->num_identical() . " \n";
                        print "hsp_rank: " . $hsp->rank() . " \n";
                        print "hsp_identical positions as array: " . $hsp->seq_inds('query','identical') . " \n";
                        print "hsp_conserved, but not identical positions as array: " . $hsp->seq_inds('query','conserved-not-identical') . " \n";
                        print "hsp_conserved or identical positions as array: " . $hsp->seq_inds('query','conserved') . " \n";
                        print "hsp_identical positions as array: " . $hsp->seq_inds('hit','identical') . " \n";
                        print "hsp_conserved not identical positions as array: " . $hsp->seq_inds('hit','conserved-not-identical') . " \n";
                        print "hsp_conserved or identical positions as array, with runs of consecutive numbers compressed: " . $hsp->seq_inds('hit','conserved',1) . " \n";
                        print "hsp_score: " . $hsp->score() . " \n";
                        print "hsp_score in bits: " . $hsp->bits() . " \n";
                        print "hsp_start and end as array of query: " . $hsp->range('query') . " \n";
                        print "hsp_start and end as array of hit: " . $hsp->range('hit') . " \n";
                        print "hsp_% identical: " . $hsp->percent_identity() . " \n";
                        print "hsp_strand of the hit: " . $hsp->strand('hit') . " \n";
                        print "hsp_strand of the query: " . $hsp->strand('query') . " \n";
                        print "hsp_start position from alignment of query: " . $hsp->start('query') . " \n";
                        print "hsp_end position from alignment of query: " . $hsp->end('query') . " \n";
                        print "hsp_start position from alignment of hit: " . $hsp->start('hit') . " \n";
                        print "hsp_end position from alignment of hit: " . $hsp->end('hit') . " \n";
                        print "hsp_number of identical and conserved as array of hit: " . $hsp->matches('hit') . " \n";
                        print "hsp_number of identical and conserved as array of query: " . $hsp->matches('query') . " \n";
                }
        }
}

wenching520 發表在 痞客邦 留言(0) 人氣()

http://www.learningperl6.com/Chapters/10.dirhandles.html
http://linux.tnc.edu.tw/techdoc/perl_intro/x843.html
http://perldoc.perl.org/File/Glob.html
http://www.unix.org.ua/orelly/perl/prog3/ch32_22.htm
http://www.physiol.ox.ac.uk/Computing/Online_Documentation/Perl-5.8.6/File/Glob.html

use File::Glob;

my @a = glob( ''$targetDir/*'' );
foreach( @a ) {
# do something here: $_
}

wenching520 發表在 痞客邦 留言(0) 人氣()

1. Upgrade CPAN
1.1. >perl -MCPAN -e shell
1.2.
cpan>install Bundle::CPAN
1.3.
cpan>q

2. Install/upgrade Module::Build
2.1. >cpan
2.2. cpan>install Module::Build
2.3. cpan>o conf prefer_installer MB [prefer_installer   [MB]]
2.4. cpan>o conf commit [commit: wrote '/etc/perl/CPAN/Config.pm']

3 Install bioperl
3.1. >sudo wget http://bioperl.org/DIST/current_core_unstable.tar.gz
3.2. >sudo tar -zxvf
current_core_unstable.tar.gz
3.3. >cd bioperl-1.5.2_102/
3.4. >sudo perl Makefile.PL (***If choosing 'a' instead of 'n': Install [a]ll optional external modules, [n]one, or choose [i]nteractively? [n] a***)
3.5. >./Build test
3.6. >./Build install


4. may occurs some following ERRORS

......
Install [a]ll optional external modules
......
What do you want to build?

  1) Interface to Ace socket server and local databases (pure Perl)
  2) The above plus XS optimizations (requires C compiler)
  3) The above plus RPC server interface (requires C compiler)

Enter your choice:  [1]

Do you want to install Ace::Browser?  [n]
......

Install bioperl by cpan
1. >sudo su- [http://linux.vbird.org/linux_basic/0410accountmanager.php#sudo]
2. >cpan [get into cpan interface]
2.1. cpan> o conf [find out where config.pm is]
  CPAN::Config options from /etc/perl/CPAN/Config.pm
2.2. cpan>q [quit cpan]
2.3. vi /etc/perl/CPAN/Config.pm [add available ftp url into config.pm]
  'urllist' => [q[ftp://cpan.nctu.edu.tw/], q[ftp://ftp.perl.org/pub/CPAN/]],
3. >perl -MCPAN -e shell [Upgrade CPAN]
4. >cpan
5. cpan>install S/SE/SENDU/bioperl-1.5.2_102.tar.gz [2008.0418: bioperl-1.5.2_102.tar.gz]
file: $CPAN/authors/id/S/SE/SENDU/bioperl-1.5.2_102.tar.gz
size: 5919092 bytes
md5: 4890481c5beb33e129b65b922fb0c126
'bioperl-1.5.2_102.tar.gz' => {
'md5' => '4890481c5beb33e129b65b922fb0c126',
'md5-ungz' => '575cd48e80c3e864e46f2add6c045ddc',
'mtime' => '2007-02-14',
'sha256' => '277c74c785afc05ad1d9dbe938677639c33130487d15bdc4a7a10e033137bada',
'sha256-ungz' => 'd070644aa42f876f9d2cfc5fd727df7f4663f4bca7dd9cfae034a74762453d4a',
'size' => '5919092'
}

Install bioperl by cpan

 

[ERROR]
Error: Can't locate the perl binary used to run this script in...
Solution: http://rt.cpan.org/Public/Bug/Display.html?id=19465 [unset LANG]

 

[ERROR]
t/SeqFeature.................ok 76/211                                      
-------------------- WARNING ---------------------
MSG: [1/5] tried to fetch http://umn.dl.sourceforge.net/sourceforge/song/sofa.definition, but server threw 500.  retrying...
---------------------------------------------------
chmod 666 /root/.cpan/build/bioperl-1.5.2_102-ldCKbN/blib/lib/Bio/Ontology/DocumentRegistry.pm
vi /root/.cpan/build/bioperl-1.5.2_102-ldCKbN/blib/lib/Bio/Ontology/DocumentRegistry.pm
    change Line 85 & 86:
        ontology => 'http://umn.dl.sourceforge.net/sourceforge/song/sofa.ontology',
        definitions =>'http://umn.dl.sourceforge.net/sourceforge/song/sofa.definition',
        to [http://www.movoin.com/index.php/archives/171]
        ontology => 'http://heanet.dl.sf.net/sourceforge/song/sofa.ontology',
        definitions =>'http://heanet.dl.sf.net/sourceforge/song/sofa.definition',
chmod 444 /root/.cpan/build/bioperl-1.5.2_102-ldCKbN/blib/lib/Bio/Ontology/DocumentRegistry.pm
chmod 666 /root/.cpan/build/bioperl-1.5.2_102-ldCKbN/Bio/Ontology/DocumentRegistry.pm
    change Line 85 & 86 [Dead Link]:
        ontology => 'http://umn.dl.sourceforge.net/sourceforge/song/sofa.ontology',
        definitions =>'http://umn.dl.sourceforge.net/sourceforge/song/sofa.definition',
        to [http://www.movoin.com/index.php/archives/171]
        ontology => 'http://heanet.dl.sf.net/sourceforge/song/sofa.ontology',
        definitions =>'http://heanet.dl.sf.net/sourceforge/song/sofa.definition',
chmod 444 /root/.cpan/build/bioperl-1.5.2_102-ldCKbN/Bio/Ontology/DocumentRegistry.pm
t/HtSNP......................Can't use string ("9") as an ARRAY ref while "strict refs" in use at /root/.cpan/build/bioperl-1.5.2_102-ldCKbN/blib/lib/Bio/PopGen/HtSNP.pm line 1075.

[Solution]
Ctrl + C to terminate the process here
chmod 666 /root/.cpan/build/bioperl-1.5.2_102-O63JGV/blib/lib/Bio/PopGen/HtSNP.pm
vi /root/.cpan/build/bioperl-1.5.2_102-O63JGV/blib/lib/Bio/PopGen/HtSNP.pm
    change Line 1075: foreach my $value (@{@$aref} ){
        to: foreach my $value (@$aref){ and save
chmod 444 /root/.cpan/build/bioperl-1.5.2_102-O63JGV/blib/lib/Bio/PopGen/HtSNP.pm

Install the CPAN module Class::Inspector
[http://www.bioperl.org/wiki/FAQ#Why_can.27t_I_easily_get_a_list_of_all_the_methods_a_object_can_call.3F]
1. >cpan
2. cpan> install A/AD/ADAMK/Class-Inspector-1.22.tar.gz
Create a perl script with the following code, put it into your path, and run it, e.g, >perl Inspector.pl Bio::Seq
#!/usr/bin/perl -w
use Class::Inspector;
$class = shift || die "Usage: methods perl_class_name\n";
eval "require $class";
print join ("\n", sort @{Class::Inspector->methods($class,'full','public')}), "\n";

http://doc.bioperl.org/releases/bioperl-1.0.1/Bio/SeqIO.html

perl Inspector.pl Bio::SeqIO
[
Bio::Root::IO::catfile
Bio::Root::IO::close
Bio::Root::IO::dup
Bio::Root::IO::exists_exe
Bio::Root::IO::file
Bio::Root::IO::flush
Bio::Root::IO::gensym
Bio::Root::IO::mode
Bio::Root::IO::noclose
Bio::Root::IO::qualify
Bio::Root::IO::qualify_to_ref
Bio::Root::IO::rmtree
Bio::Root::IO::tempdir
Bio::Root::IO::tempfile
Bio::Root::IO::ungensym
Bio::Root::Root::confess
Bio::Root::Root::debug
Bio::Root::Root::throw
Bio::Root::Root::verbose
Bio::Root::RootI::carp
Bio::Root::RootI::deprecated
Bio::Root::RootI::stack_trace
Bio::Root::RootI::stack_trace_dump
Bio::Root::RootI::throw_not_implemented
Bio::Root::RootI::warn
Bio::Root::RootI::warn_not_implemented
Bio::SeqIO::DESTROY
Bio::SeqIO::PRINT
Bio::SeqIO::READLINE
Bio::SeqIO::TIEHANDLE
Bio::SeqIO::alphabet
Bio::SeqIO::fh
Bio::SeqIO::location_factory
Bio::SeqIO::new
Bio::SeqIO::newFh
Bio::SeqIO::next_seq
Bio::SeqIO::object_factory
Bio::SeqIO::sequence_builder
Bio::SeqIO::sequence_factory
Bio::SeqIO::write_seq

]

perl Inspector.pl Bio::Seq
[
Bio::AnnotatableI::croak
Bio::FeatureHolderI::get_all_SeqFeatures
Bio::IdentifiableI::lsid_string
Bio::IdentifiableI::namespace_string
Bio::PrimarySeqI::moltype
Bio::PrimarySeqI::revcom
Bio::PrimarySeqI::translate
Bio::PrimarySeqI::trunc
Bio::Root::Root::confess
Bio::Root::Root::debug
Bio::Root::Root::throw
Bio::Root::Root::verbose
Bio::Root::RootI::carp
Bio::Root::RootI::deprecated
Bio::Root::RootI::stack_trace
Bio::Root::RootI::stack_trace_dump
Bio::Root::RootI::throw_not_implemented
Bio::Root::RootI::warn
Bio::Root::RootI::warn_not_implemented
Bio::Seq::DESTROY
Bio::Seq::accession
Bio::Seq::accession_number
Bio::Seq::add_SeqFeature
Bio::Seq::all_SeqFeatures
Bio::Seq::alphabet
Bio::Seq::annotation
Bio::Seq::authority
Bio::Seq::can_call_new
Bio::Seq::desc
Bio::Seq::description
Bio::Seq::display_id
Bio::Seq::display_name
Bio::Seq::feature_count
Bio::Seq::flush_SeqFeature
Bio::Seq::flush_SeqFeatures
Bio::Seq::get_SeqFeatures
Bio::Seq::id
Bio::Seq::is_circular
Bio::Seq::length
Bio::Seq::namespace
Bio::Seq::new
Bio::Seq::object_id
Bio::Seq::primary_id
Bio::Seq::primary_seq
Bio::Seq::remove_SeqFeatures
Bio::Seq::seq
Bio::Seq::species
Bio::Seq::subseq
Bio::Seq::top_SeqFeatures
Bio::Seq::validate_seq
Bio::Seq::version
Bio::SeqI::write_GFF
]

wenching520 發表在 痞客邦 留言(0) 人氣()

#!/usr/bin/perl

use Benchmark;

# declare array
my @data;

# start timer
$start = new Benchmark;

#PUT YOUR CODE HERE

# end timer
$end = new Benchmark;

# calculate difference
$diff = timediff($end, $start);

# report
print "Time taken was ", timestr($diff, 'all'), " seconds";

wenching520 發表在 痞客邦 留言(0) 人氣()