How can I fake STDIN in Perl? - perl

I am unit testing a component that requires user input. How do I tell Test::More to use some input that I predefined so that I don't need to enter it manually?
This is what I have now:
use strict;
use warnings;
use Test::More;
use TestClass;
*STDIN = "1\n";
foreach my $file (#files)
{
#this constructor asks for user input if it cannot find the file (1 is ignore);
my $test = TestClass->new( file=> #files );
isa_ok( $test, 'TestClass');
}
done_testing;
This code does press enter but the function is retrieving 0 not 1;

If the program reads from STDIN, then just set STDIN to be the open filehandle you want it to be:
#!perl
use strict;
use warnings;
use Test::More;
*STDIN = *DATA;
my #a = <STDIN>;
is_deeply \#a, ["foo\n", "bar\n", "baz\n"], "can read from the DATA section";
my $fakefile = "1\n2\n3\n";
open my $fh, "<", \$fakefile
or die "could not open fake file: $!";
*STDIN = $fh;
my #b = <STDIN>;
is_deeply \#b, ["1\n", "2\n", "3\n"], "can read from a fake file";
done_testing;
__DATA__;
foo
bar
baz
You may want to read more about typeglobs in perldoc perldata and more about turning strings into fake files in the documentation for open (look for "Since v5.8.0, perl has built using PerlIO by default.") in perldoc perlfunc.

The following minimal script seems to work:
#!/usr/bin/perl
package TestClass;
use strict;
use warnings;
sub new {
my $class = shift;
return unless <STDIN> eq "1\n";
bless {} => $class;
}
package main;
use strict;
use warnings;
use Test::More tests => 1;
{
open my $stdin, '<', \ "1\n"
or die "Cannot open STDIN to read from string: $!";
local *STDIN = $stdin;
my $test = TestClass->new;
isa_ok( $test, 'TestClass');
}
Output:
C:\Temp> t
1..1
ok 1 - The object isa TestClass

Related

Display full taxon path from NCBI GI number

I prepared the following script that takes a GI ID number from NCBI that I prepared in my tsv file and prints the scientific name associated with the ID:
#!/usr/bin/perl
use strict;
use warnings;
use Bio::DB::Taxonomy;
my ($filename) = #ARGV;
open my $fh, '<', $filename or die qq{Unable to open "$filename": $!};
while(<>) {
my ($taxonid, $counts) = (split /\t/);
for my $each($taxonid) {
print "$each\n";
my $db = Bio::DB::Taxonomy->new(-source => 'entrez');
my $taxon = $db->get_taxon(-taxonid => $taxonid);
print "Taxon ID is $taxon->id, \n";
print "Scientific name is ", $taxon->scientific_name, "\n";
}
}
With this script, I receive the following:
1760
Taxon ID is Bio::Taxon=HASH(0x33a91f8)->id,
Scientific name is Actinobacteria
What I want to do
Now the next step is for me to list the full taxon path of the bacteria in question. So for the above example, I want to see k__Bacteria; p__ Actinobacteria; c__ Actinobacteria as output. Furthermore, I want the GI IDs on my table to be repliaced with this full taxon path.
In which direction should I go?
First, I notice you open $filename which is your first command line argument, but you don't use the file pointer $fh you created.
So, these two lines are not needed in your case because you already do the trick with <>
my ($filename) = #ARGV;
open my $fh, '<', $filename or die qq{Unable to open "$filename": $!};
Next. I don't know what is inside your filename and your database so I cannot help you more. Can you provide an example of what is inside your database and your file?
One more thing, what I can see here is that you may not need to create your $db instance inside the loop.
#!/usr/bin/perl
use strict;
use warnings;
use Bio::DB::Taxonomy;
my $db = Bio::DB::Taxonomy->new(-source => 'entrez');
while(<>) {
my ($taxonid, $counts) = (split /\t/);
for my $each($taxonid) {
print "$each\n";
my $taxon = $db->get_taxon(-taxonid => $taxonid);
print "Taxon ID is $taxon->id, \n";
print "Scientific name is ", $taxon->scientific_name, "\n";
}
}
Edit
From your command Is is hard to help you. When you write
my $taxon = $db->get_taxon(-taxonid => $taxonid);
You receive a Bio::Taxon node where the documentation ca be found here
I don't know what k__Bacteria; p__ Actinobacteria; c__ Actinobacteria representy for you. Is it an information offered by a Bio::Taxon node?
Anyway, you can still explore $taxon with this:
#!/usr/bin/env perl
# Author: Yves Chevallier
# Date:
use strict;
use warnings;
use Data::Dumper;
use Bio::DB::Taxonomy;
my $db = Bio::DB::Taxonomy->new(-source => 'entrez');
while(<DATA>) {
my ($taxonid, $counts) = (split /\t/);
for my $each($taxonid) {
print "$each\n";
my $taxon = $db->get_taxon(-taxonid => $taxonid);
print Dumper $taxon;
print "Taxon ID is $taxon->id, \n";
print "Scientific name is ", $taxon->scientific_name, "\n";
}
}
__DATA__
12 1760

Undefined subroutines &main error in Perl

I am trying to extract a DNA sequence from this FASTA file to a specified length of bases per line, say 40.
> sample dna (This is a typical fasta header.)
agatggcggcgctgaggggtcttgggggctctaggccggccacctactgg
tttgcagcggagacgacgcatggggcctgcgcaataggagtacgctgcct
gggaggcgtgactagaagcggaagtagttgtgggcgcctttgcaaccgcc
tgggacgccgccgagtggtctgtgcaggttcgcgggtcgctggcgggggt
Using this Perl module (fasta.pm):
package fasta;
use strict;
sub read_fasta ($filename) {
my $filename = #_;
open (my $FH_IN, "<", $filename) or die "Can't open file: $filename $!";
my #lines = <$FH_IN>;
chomp #lines;
return #lines;
}
sub read_seq (\#lines) {
my $linesRef = #_;
my #lines = #{$linesRef};
my #seq;
foreach my $line (#lines) {
if ($line!~ /^>/) {
print "$line\n";
push (#seq, $line);
}
}
return #seq;
}
sub print_seq_40 (\#seq) {
my $linesRef = #_;
my #lines = #{$linesRef};
my $seq;
foreach my $line (#lines) {
$seq = $seq.$line;
}
my $i= 0;
my $seq_line;
while (($i+1)*40 < length ($seq)) {
my $seq_line = substr ($seq, $i*40, 40);
print "$seq_line\n";
$i++;
}
$seq_line = substr ($seq, $i*40);
print "$seq_line\n";
}
1;
And the main script is
use strict;
use warnings;
use fasta;
print "What is your filename: ";
my $filename = <STDIN>;
chomp $filename;
my #lines = read_fasta ($filename);
my #seq = read_seq (\#lines);
print_seq_40 (\#seq);
exit;
This is the error I get
Undefined subroutine &main::read_fasta called at q2.pl line 13, <STDIN> line 1.
Can anyone please enlighten me on which part I did wrong?
It looks like you're getting nowhere with this.
I think your choice to use a module and subroutines is a little strange, given that you call each subroutine only once and the correspond to very little code indeed.
Both your program and your module need to start with use strict and use warnings, and you cannot use prototypes like that in Perl subroutines. Including a number of other bugs, this is a lot closer to the code that you need.
package Fasta;
use strict;
use warnings;
use 5.010;
use autodie;
use base 'Exporter';
our #EXPORT = qw/ read_fasta read_seq print_seq_40 /;
sub read_fasta {
my ($filename) = #_;
open my $fh_in, '<', $filename;
chomp(my #lines = <$fh_in>);
#lines;
}
sub read_seq {
my ($lines_ref) = $_[0];
grep { not /^>/ } #$lines_ref;
}
sub print_seq_40 {
my ($lines_ref) = #_;
print "$_\n" for unpack '(A40)*', join '', #$lines_ref;
}
1;
q2.pl
use strict;
use warnings;
use Fasta qw/ read_fasta read_seq print_seq_40 /;
print "What is your filename: ";
my $filename = <STDIN>;
chomp $filename;
my #lines = read_fasta($filename);
my #seq = read_seq(\#lines);
print_seq_40(\#seq);
You need to either:
add to your module:
use Exporter;
our #EXPORT = qw ( read_fasta
read_seq ); #etc.
call the code in the remote module explicitly:
fasta::read_fasta();
explicitly import the module sub:
use fasta qw ( read_fasta );
Also: General convention on modules is to uppercase the first letter of the module name.
In Perl, if you use fasta;, this does not automatically export all its methods into the namespace of your program. Call fasta::read_fasta instead.
Or: use Exporter to automatically export methods or enable something like use Fasta qw/read_fasta/.
For example:
package Fasta;
require Exporter;
our #ISA = qw(Exporter);
our #EXPORT_OK = qw/read_fasta read_seq read_seq40/;
To use:
use Fasta qw/read_fasta read_seq read_seq40/;
You can also make Fasta export all methods automatically or define keywords to group methods, though the latter has caused me some problems in the past, and I would recommend it only if you are certain it is worth possible trouble.
If you want to make all methods available:
package Fasta;
use Exporter;
our #ISA = qw(Exporter);
our #EXPORT = qw/read_fasta read_seq read_seq40/;
Note #EXPORT is not #EXPORT_OK. The latter allows importing them later (as I did), the former automatically exports all. The documentation I linked to makes this clear.
I just noticed something else. You are flattening #_ into $filename in read_fasta. I am not sure this works. Try this:
sub read_fasta {
my $filename = $_[0]; # or ($filename) = #_; #_ is an array. $filename not.
}
To explain the problem: $filename = #_; means: store #_ ( an ARRAY ) into $filename (a SCALAR). Perl does this in this way: ARRAY length is stored in $filename. That is not what you want. You want the first element of the array. That would be $_[0].
Added #ISA which is probably needed OR use comment by Borodir.

call test scripts from main driver script perl

I have a main setup script which sets up the test env and stores data in some variables:
package main;
use Test::Harness;
our $foo, $xyz, $pqr;
($foo, $xyz, $pqr) = &subroutinesetup();
# ^ here
#test_files = glob "t/*";
print "Executing test #test\n";
runtests(#test_files);
In the test folder I have a testsuite (t/testsuite1.t, testsuite2.t etc.).
How can I access the value of $foo inside the testsuite1.t?
package main;
use Test::More;
$actual = getActual();
is($foo, $actual, passfoor);
# ^ here
done_testing();
Use Storable to store data in first script and retrieve it from other.
main.pl
($foo, $xyz, $pqr) = &subroutinesetup();
store ($foo, "/home/chankey/testsuite.$$") or die "could not store";
system("perl", "testsuite.pl", $$) == 0 or die "error";
testsuite.pl
my $parentpid = shift;
my $ref = retrieve("/home/chankey/testsuite.$parentpid") or die "couldn't retrieve";
print Dumper $ref;
You've received the $foo in $ref. Now use it the way you want.
You can't share a variable directly, because a new Perl process is started for each test file.
As noted in the documentation of Test::Harness, you should switch to TAP::Harness. It's more flexible: for example, it provides the test_args mechanism to pass arguments to test scripts.
$ cat 1.pl
#!/usr/bin/perl
use warnings;
use strict;
use TAP::Harness;
my $harness = 'TAP::Harness'->new({
test_args => [ qw( propagate secret ) ]
});
$harness->runtests('1.t');
__END__
$ cat 1.t
#!/usr/bin/perl
use warnings;
use strict;
use Test::More;
my %args = #ARGV;
is($args{propagate}, 'secret', 'propagated');
done_testing();

Send file handle as argument in perl

Is it possible to send a file handle as an argument to a subroutine in PERL?
If yes, can you help with a sample code snippet showing how to receive it and use it in the subroutine?
You're using lexical variables (open(my $fh, ...)) as you should, right? If so, you don't have to do anything special.
sub f { my ($fh) = #_; print $fh "Hello, World!\n"; }
f($fh);
If you're using a glob (open(FH, ...)), just pass a reference to the glob.
f(\*STDOUT);
Though many places will also accept the glob itself.
f(*STDOUT);
Yes you can do it using .below is the sample code for the same.
#!/usr/bin/perl
use strict;
use warnings;
open (MYFILE, 'temp');
printit(\*MYFILE);
sub printit {
my $fh = shift;
while (<$fh>) {
print;
}
}
below is the test:
> cat temp
1
2
3
4
5
the perl script sample
> cat temp.pl
#!/usr/bin/perl
use strict;
use warnings;
open (MYFILE, 'temp');
printit(\*MYFILE);
sub printit {
my $fh = shift;
while (<$fh>) {
print;
}
}
execution
> temp.pl
1
2
3
4
5
>
Yes, like this:
some_func($fh, "hello");
where some_func is defined like this:
sub some_func {
my ($fh, $str) = #_;
print { $fh } "The message is: $str\n";
}

Read and Write in the same file with different process

I have written the two program. One program is write the content to the text file simultaneously. Another program is read that content simultaneously.
But both the program should run at the same time. For me the program is write the file is correctly. But another program is not read the file.
I know that once the write process is completed than only the data will be stored in the hard disk. Then another process can read the data.
But I want both read and write same time with different process in the single file. How can I do that?
Please help me.
The following code write the content in the file
sub generate_random_string
{
my $length_of_randomstring=shift;# the length of
# the random string to generate
my #chars=('a'..'z','A'..'Z','0'..'9','_');
my $random_string;
foreach (1..$length_of_randomstring)
{
# rand #chars will generate a random
# number between 0 and scalar #chars
$random_string.=$chars[rand #chars];
}
return $random_string;
}
#Generate the random string
open (FH,">>file.txt")or die "Can't Open";
while(1)
{
my $random_string=&generate_random_string(20);
sleep(1);
#print $random_string."\n";
print FH $random_string."\n";
}
The following code is read the content. This is another process
open (FH,"<file.txt") or die "Can't Open";
print "Open the file Successfully\n\n";
while(<FH>)
{
print "$_\n";
}
You might use an elaborate cooperation protocol such as in the following. Both ends, reader and writer, use common code in the TakeTurns module that handles fussy details such as locking and where the lock file lives. The clients need only specify what they want to do when they have exclusive access to the file.
reader
#! /usr/bin/perl
use warnings;
use strict;
use TakeTurns;
my $runs = 0;
reader "file.txt" =>
sub {
my($fh) = #_;
my #lines = <$fh>;
print map "got: $_", #lines;
++$runs <= 10;
};
writer
#! /usr/bin/perl
use warnings;
use strict;
use TakeTurns;
my $n = 10;
my #chars = ('a'..'z','A'..'Z','0'..'9','_');
writer "file.txt" =>
sub { my($fh) = #_;
print $fh join("" => map $chars[rand #chars], 1..$n), "\n"
or warn "$0: print: $!";
};
The TakeTurns module is execute-around at work:
package TakeTurns;
use warnings;
use strict;
use Exporter 'import';
use Fcntl qw/ :DEFAULT :flock /;
our #EXPORT = qw/ reader writer /;
my $LOCKFILE = "/tmp/taketurns.lock";
sub _loop ($&) {
my($path,$action) = #_;
while (1) {
sysopen my $lock, $LOCKFILE, O_RDWR|O_CREAT
or die "sysopen: $!";
flock $lock, LOCK_EX or die "flock: $!";
my $continue = $action->();
close $lock or die "close: $!";
return unless $continue;
sleep 0;
}
}
sub writer {
my($path,$w) = #_;
_loop $path =>
sub {
open my $fh, ">", $path or die "open $path: $!";
my $continue = $w->($fh);
close $fh or die "close $path: $!";
$continue;
};
}
sub reader {
my($path,$r) = #_;
_loop $path =>
sub {
open my $fh, "<", $path or die "open $path: $!";
my $continue = $r->($fh);
close $fh or die "close $path: $!";
$continue;
};
}
1;
Sample output:
got: 1Upem0iSfY
got: qAALqegWS5
got: 88RayL3XZw
got: NRB7POLdu6
got: IfqC8XeWN6
got: mgeA6sNEpY
got: 2TeiF5sDqy
got: S2ksYEkXsJ
got: zToPYkGPJ5
got: 6VXu6ut1Tq
got: ex0wYvp9Y8
Even though you went to so much trouble, there are still issues. The protocol is unreliable, so reader has no guarantee of seeing all messages that writer sends. With no writer active, reader is content to read the same message over and over.
You could add all this, but a more sensible approach would be using abstractions the operating system provides already.
For example, Unix named pipes seem to be a pretty close match to what you want, and note how simple the code is:
pread
#! /usr/bin/perl
use warnings;
use strict;
my $pipe = "/tmp/mypipe";
system "mknod $pipe p 2>/dev/null";
open my $fh, "<", $pipe or die "$0: open $pipe: $!";
while (<$fh>) {
print "got: $_";
sleep 0;
}
pwrite
#! /usr/bin/perl
use warnings;
use strict;
my $pipe = "/tmp/mypipe";
system "mknod $pipe p 2>/dev/null";
open my $fh, ">", $pipe or die "$0: open $pipe: $!";
my $n = 10;
my #chars = ('a'..'z','A'..'Z','0'..'9','_');
while (1) {
print $fh join("" => map $chars[rand #chars], 1..$n), "\n"
or warn "$0: print: $!";
}
Both ends attempt to create the pipe using mknod because they have no other method of synchronization. At least one will fail, but we don't care as long as the pipe exists.
As you can see, all the waiting machinery is handled by the system, so you do what you care about: reading and writing messages.
This works.
The writer:
use IO::File ();
sub generate_random_string {...}; # same as above
my $file_name = 'file.txt';
my $handle = IO::File->new($file_name, 'a');
die "Could not append to $file_name: $!" unless $handle;
$handle->autoflush(1);
while (1) {
$handle->say(generate_random_string(20));
}
The reader:
use IO::File qw();
my $file_name = 'file.txt';
my $handle = IO::File->new($file_name, 'r');
die "Could not read $file_name: $!" unless $handle;
STDOUT->autoflush(1);
while (defined (my $line = $handle->getline)) {
STDOUT->print($line);
}
are you on windows or *nix? you might be able to string something like this together on *nix by using tail to get the output as it is written to the file. On windows you can call CreateFile() with FILE_SHARE_READ and/or FILE_SHARE_WRITE in order to allow others to access the file while you have it opened for read/write. you may have to periodically check to see if the file size has changed in order to know when to read (i'm not 100% certain here.)
another option is a memory mapped file.