How can I do inplace editing (-i) with perl on windows? - windows

In the unix/linux version, I'd simply change the first line:
#!perl -i.bak
Using Activestate perl on windows, where I've created the association with .pl, I can run a perl script directly from the command line.
myScript.pl
How can I do inplace editing of files if I still want to use the default association?

Sounds like a trick question, and I wonder if I am understanding you right.
perl -pi.bak myScript.pl myfiletochange
Just call perl, supply the switches and the script name, and off you go.
Now, it may be that you do not want to supply these extra arguments. If so, you can simply set the variable $^I, which will activate the inplace edit. E.g.:
$^I = ".bak"; # will set backup extension

Since you are going to be using a script you might want to do something like this:
sub edit_in_place
{
my $file = shift;
my $code = shift;
{
local #ARGV = ($file);
local $^I = '';
while (<>) {
&$code;
}
}
}
edit_in_place $file, sub {
s/search/replace/;
print;
};
if you want to create a backup then change local $^I = ''; to local $^I = '.bak';

Related

How can Perl see where a Windows shortcut points to?

In Windows, how can I check where a shortcut file points to? In the following simple code, readlink doesn't show anything:
$dir = 's:\\aaaaa\\bbb';
.....
#img = readdir F;
#lnk = grep{/lnk$/} #img;
......
......
foreach (#lnk){
$where = readlink $dir.$_;
$a=$a;
}
According to perlport, readlink is not implemented on Windows. Instead you can use Win32::Shortcut to read shortcut .lnk files:
use strict;
use warnings;
use feature qw(say);
use Win32::Shortcut;
my $link = Win32::Shortcut->new();
$link->Load("test.lnk");
say "Shortcut to: $link->{'Path'} $link->{'Arguments'}";
$link->Close();

How to remove small contigs from fasta files?

## removesmalls.pl
#!/usr/bin/perl
use strict;
use warnings;
my $minlen = shift or die "Error: `minlen` parameter not provided\n";
{
local $/=">";
while(<>) {
chomp;
next unless /\w/;
s/>$//gs;
my #chunk = split /\n/;
my $header = shift #chunk;
my $seqlen = length join "", #chunk;
print ">$_" if($seqlen >= $minlen);
}
local $/="\n";
}
Exexecuting the script as follows:
perl removesmalls.pl 1000 contigs.fasta > contigs-1000.fasta
The above script works for me but there is a problem,
i have 109 different fasta files with different file names.
i can run the script for individual file but i want to run the script at once for all files and the result file should be individually different for each.
file names are like SRR8224532.fasta, SRR8224533.fasta, SRR8224534.fasta, and so on
i want the result files after removing the contigs (i.e., for me less than 1000) something like SRR8224532-out.fasta,
SRR8224533-out.fasta, and so on.
Any help or suggestion would be helpfull.

Perl module File:Slurp with STDIN piped

I have just tried using the following Perl script to do some text substitution using the File::Slurp module. It works fine on a single file given as an argument at the command line (BASH).
#!/opt/local/bin/perl -w
use File::Slurp qw( edit_file_lines );
foreach my $argnum (0 .. $#ARGV) {
edit_file_lines {
s/foo/bar/g;
print $_
}
$ARGV[$argnum];
}
I would like to alter it to cope also with pipes (i.e. STDIN), so that it can be in the middle of a series of piped operations:
for example:
command blah|....|my-perl-script|sort|uniq|wc....
What is the best way to change the Perl script to allow this, whilst retaining the existing ability to work with single files on the command line?
To have your script work in a pipeline, you could check if STDIN is connected to a tty:
use strict;
use warnings;
use File::Slurp qw( edit_file_lines );
sub my_edit_func { s/foo/bar/g; print $_ }
if ( !(-t STDIN) ) {
while(<>) { my_edit_func }
}
else {
foreach my $argnum (0 .. $#ARGV) {
edit_file_lines { my_edit_func } $ARGV[$argnum];
}
}
See perldoc -X for more information on the -t file test operator.
All you need is the following:
local $^I = '';
while (<>) {
s/foo/bar/g;
print;
}
This is basically the same as perl -i -pe's/foo/bar/', except it doesn't warn when STDIN is used.

Passing bash variable into inline perl script

Reference the 2nd to last line in my script. For some reason Perl is not able to access the variable $perlPort how can I fix this? Note: $perlPort is a bash variable location before my perl script
perl -e '
{
package MyWebServer;
use HTTP::Server::Simple::CGI;
use base qw(HTTP::Server::Simple::CGI);
my %dispatch = (
"/" => \&resp_hello,
);
sub handle_request {
my $self = shift;
my $cgi = shift;
my $path = $cgi->path_info();
my $handler = $dispatch{$path};
if (ref($handler) eq "CODE") {
print "HTTP/1.0 200 OK\r\n";
$handler->($cgi);
} else {
print "HTTP/1.0 404 Not found\r\n";
print $cgi->header,
$cgi->start_html("Not found"),
$cgi->h1("Not found"),
$cgi->end_html;
}
}
sub resp_hello {
my $cgi = shift; # CGI.pm object
return if !ref $cgi;
my $who = $cgi->param("name");
print $cgi->header,
$cgi->start_html("Hello"),
$cgi->h1("Hello Perl"),
$cgi->end_html;
}
}
my $pid = MyWebServer->new($perlPort)->background();
print "Use 'kill $pid' to stop server.\n";'
export perlPort
perl -e '
...
my $pid = MyWebServer->new($ENV{perlPort})->background();
'
You can use -s switch to pass variables. See http://perldoc.perl.org/perlrun.html
perl -se '
...
my $pid = MyWebBrowser->new($perlPort)->background();
...' -- -perlPort="$perlPort"
You can still pass command line arguments to your script. Replace $perlPort with $ARGV[0], then call you script as
perl -e $' ...
my $pid = MyWebServer->new($ARGV[0])->background();
print "Use \'kill $pid\' to stop server.\n";' "$perlPort"
Note the other problem: You can't include single quotes inside a single-quoted string in bash. You can work around this by using a $'...'-quoted string as the argument to Perl, which can contain escaped single quotes. If your script doesn't need to read from standard input, it would be a better idea to have perl read from a here-document instead.
perl <<'EOF' "$perlPort"
{
package MyWebServer;
use HTTP::Server::Simple::CGI;
...
my $pid = MyWebServer->new($ARGV[0])->background();
print "Use 'kill $pid' to stop server.\n";
EOF
The best idea is to simply use a script file instead of trying to construct the script on the command line.
perl -e '
...
my $pid = MyWebServer->new('$perlPort')->background();
...

How to find out if a command exists in a POSIX compliant manner?

See the discussion at Is `command -v` option required in a POSIX shell? Is posh compliant with POSIX?. It describes that type as well as command -v option is optional in POSIX.1-2004.
The answer marked correct at Check if a program exists from a Bash script doesn't help either. Just like type, hash is also marked as XSI in POSIX.1-2004. See http://pubs.opengroup.org/onlinepubs/009695399/utilities/hash.html.
Then what would be a POSIX compliant way to write a shell script to find if a command exists on the system or not?
How do you want to go about it? You can look for the command on directories in the current value of $PATH; you could look in the directories specified by default for the system PATH (getconf PATH as long as getconf
exists on PATH).
Which implementation language are you going to use? (For example: I have a Perl implementation that does a decent job finding executables on $PATH — but Perl is not part of POSIX; is it remotely relevant to you?)
Why not simply try running it? If you're going to deal with Busybox-based systems, lots of the executables can't be found by searching — they're built into the shell. The major caveat is if a command does something dangerous when run with no arguments — but very few POSIX commands, if any, do that. You might also need to determine what command exit statuses indicate that the command is not found versus the command objecting to not being called with appropriate arguments. And there's little guarantee that all systems will be consistent on that. It's a fraught process, in case you hadn't gathered.
Perl implementation pathfile
#!/usr/bin/env perl
#
# #(#)$Id: pathfile.pl,v 3.4 2015/10/16 19:39:23 jleffler Exp $
#
# Which command is executed
# Loosely based on 'which' from Kernighan & Pike "The UNIX Programming Environment"
#use v5.10.0; # Uses // defined-or operator; not in Perl 5.8.x
use strict;
use warnings;
use Getopt::Std;
use Cwd 'realpath';
use File::Basename;
my $arg0 = basename($0, '.pl');
my $usestr = "Usage: $arg0 [-AafhqrsVwx] [-p path] command ...\n";
my $hlpstr = <<EOS;
-A Absolute pathname (determined by realpath)
-a Print all possible matches
-f Print names of files (as opposed to symlinks, directories, etc)
-h Print this help message and exit
-q Quiet mode (don't print messages about files not found)
-r Print names of files that are readable
-s Print names of files that are not empty
-V Print version information and exit
-w Print names of files that are writable
-x Print names of files that are executable
-p path Use PATH
EOS
sub usage
{
print STDERR $usestr;
exit 1;
}
sub help
{
print $usestr;
print $hlpstr;
exit 0;
}
sub version
{
my $version = 'PATHFILE Version $Revision: 3.4 $ ($Date: 2015/10/16 19:39:23 $)';
# Beware of RCS hacking at RCS keywords!
# Convert date field to ISO 8601 (ISO 9075) notation
$version =~ s%\$(Date:) (\d\d\d\d)/(\d\d)/(\d\d) (\d\d:\d\d:\d\d) \$%\$$1 $2-$3-$4 $5 \$%go;
# Remove keywords
$version =~ s/\$([A-Z][a-z]+|RCSfile): ([^\$]+) \$/$2/go;
print "$version\n";
exit 0;
}
my %opts;
usage unless getopts('AafhqrsVwxp:', \%opts);
version if ($opts{V});
help if ($opts{h});
usage unless scalar(#ARGV);
# Establish test and generate test subroutine.
my $chk = 0;
my $test = "-x";
my $optlist = "";
foreach my $opt ('f', 'r', 's', 'w', 'x')
{
if ($opts{$opt})
{
$chk++;
$test = "-$opt";
$optlist .= " -$opt";
}
}
if ($chk > 1)
{
$optlist =~ s/^ //;
$optlist =~ s/ /, /g;
print STDERR "$arg0: mutually exclusive arguments ($optlist) given\n";
usage;
}
my $chk_ref = eval "sub { my(\$cmd) = \#_; return -f \$cmd && $test \$cmd; }";
my #PATHDIRS;
my %pathdirs;
my $path = defined($opts{p}) ? $opts{p} : $ENV{PATH};
#foreach my $element (split /:/, $opts{p} // $ENV{PATH})
foreach my $element (split /:/, $path)
{
$element = "." if $element eq "";
push #PATHDIRS, $element if $pathdirs{$element}++ == 0;
}
my $estat = 0;
CMD:
foreach my $cmd (#ARGV)
{
if ($cmd =~ m%/%)
{
if (&$chk_ref($cmd))
{
print "$cmd\n" unless $opts{q};
next CMD;
}
print STDERR "$arg0: $cmd: not found\n" unless $opts{q};
$estat = 1;
}
else
{
my $found = 0;
foreach my $directory (#PATHDIRS)
{
my $file = "$directory/$cmd";
if (&$chk_ref($file))
{
$file = realpath($file) if $opts{A};
print "$file\n" unless $opts{q};
next CMD unless defined($opts{a});
$found = 1;
}
}
print STDERR "$arg0: $cmd: not found\n" unless $found || $opts{q};
$estat = 1;
}
}
exit $estat;

Resources