I'm trying to make a perl subroutine similar to this php function.
private function writeOutput($msg, $type) {
echo date("H\:i\:s") . " - [$type] . > $msg\n";
}
I need a little help defining $msg and $type.
sub WriteOutput {
$sec = sprintf ("%02d", $sum%60);
$mins = sprintf("%02d", ($sum%3600)/60);
$hrs = int($sum/3600);
print "[$hrs:$mins:$sec]:[$type]>: $msg";
}
As I understand, your question is about passing arguments to Perl subroutine.
Perl stores arguments passed to subroutine in special variable #_. Add following line at the beginning of your subroutine.
my ($msg, $type) = #_;
And call this subroutine with
writeOutput("test", "type1");
Bdw, I hope you're not trying to use global variables here, since my is missing.
Apart from that it's not clear what is $sum
Let's take a look at your PHP subroutine:
private function writeOutput($msg, $type) {
echo date("H\:i\:s") . " - [$type] . > $msg\n";
}
First, Perl doesn't have a builtin date formatter. Instead, you have to use a module to handle dates.
Also, you're taking two parameters in your function called $msg and $type. Perl doesn't use function parameters in the function call. Instead, you use shift:
use Time::Piece; # A nice way to handle datetime. Included since Perl 5.10
use feature qw(say); # Better than `print`. Included since Perl 5.10
sub write_output {
my $msg = shift;
my $type = shift;
my $time = Time::Piece->new(localtime);
say $time->hms . " - [$type] . > $msg";
}
The shift command is the standard way of taking your function's input parameters. Time::Piece is the standard Perl module for handling time since Perl 5.10. This is an object oriented module. The -> is similar to the dot in most other languages. The my $time = Time::Piece->new(localtime); creates a new Time::Piece object based upon the current time. The $time->hms uses the hms method to print out the time in HH:MM:SS format.
Note the use of my which declares and localizes variables (something that PHP doesn't really have). You should always have use strict; and use warnings; on all of your Perl programs. Then, you have to declare all of your variables with my.
Note in Perl, the standard way for variables is to use all lowercase and use underscores as separators. This is taken from Perl Best Practices by Damian Conway. You may or may not agree with all of Conway's coding standards, but one of the nice things about standard is that everyone uses them which makes working with other's people code so much nicer -- whether you like them or not.
For this function in PHP:
private function writeOutput($msg, $type) {
echo date("H\:i\:s") . " - [$type] . > $msg\n";
}
Perl offers the possibility to do the same thing:
use POSIX qw(strftime);
sub WriteOutput {
my($msg, $type) = #_;
my $date = strftime("[%H:%M:%S]", localtime);
print "$date:[$type]>: $msg";
}
WriteOutput "Ok", "Not OK?";
Gives:
[19:12:01][Not Ok?]>: Ok
Related
I need to control the print method using a variable
My code is below
#!/usr/bin/perl
# test_assign_func.pl
use strict;
use warnings;
sub echo {
my ($string) = #_;
print "from echo: $string\n\n";
}
my $myprint = \&echo;
$myprint->("hello");
$myprint = \&print;
$myprint->("world");
when I ran, I got the following error for the assignment of print function
$ test_assign_func.pl
from echo: hello
Undefined subroutine &main::print called at test_assign_func.pl line 17.
Looks like I need to prefix a namespace to print function but I cannot find the name space. Thank you for any advice!
print is an operator, not a sub.
perlfunc:
The functions in this section can serve as terms in an expression. They fall into two major categories: list operators and named unary operators.
Perl provides a sub for named operators that can be duplicated by a sub with a prototype. A reference to these can be obtained using \&CORE::name.
my $f = \&CORE::length;
say $f->("abc"); # 3
But print isn't such an operator (because of the way it accepts a file handle). For these, you'll need to create a sub with a more limited calling convention.
my $f = sub { print #_ };
$f->("abc\n");
Related:
What are Perl built-in operators/functions?
As mentioned in CORE, some functions can't be called as subroutines, only as barewords. print is one of them.
Just like a #define (preprocessor directive) in C, is there any way to define a block of code in perl.
use constant PI=>3.14;
Like this I can define only variable.
Can I do the same with a block of code?
The following code part does not work. How can I achieve the same?
use constant FUN=>{
$i=3;
while($i)
{
print "$i\n";--$i;}
}
Perl doesn't have macros. (A sufficiently demented programmer could fake them using source filters but that sort of black magic is best avoided.) use constant doesn't trigger an inline replacement the way the C preprocessor does. Instead, it creates a subroutine that always returns the same value. When you write
use constant PI => 3.14;
what Perl does is (essentially)
sub PI() { 3.14 }
The constant pragma can only be used to define values, not code. To reuse code define a subroutine instead.
Most people would write that (give or take the positioning of braces) as:
sub FUN
{
my $i = 3;
while ($i)
{
print "$i\n";
--$i;
}
}
You could do:
my $FUN = sub { print "$_\n" foreach (qw(3 2 1)); };
&$FUN();
Use sub keyword to define a function.
Unlike C langage preprocessing is almost useless in scripting language such as perl.
This is a bit of a hack but you can use string eval to achieve runtime evaluation of code:
use strict;
use warnings;
my $code = "
my \$value = 17;
print \"\$value\n\";
" ;
eval $code ;
result:
[pt#localhost bin]$ perl testit2
17
[pt#localhost bin]$
You'll need mad escaping skills if you write anything complicated.
Update: if you use q() instead of " then much less escaping will be needed.
Try/catch in perl can be implemented this way:
eval {
# do something
die "Exception1\n" if $something_not_right;
};
if ($#) {
for ($#) {
/Exception1/ && do { handle_excp1(); last; };
/Exception2/ && do { handle_excp2(); last; };
die "Don't know how to handle $#\n";
};
};
Of course you don't have to use a string literal to throw an exception. Any object reference would do.
I have a small program:
#!/user/bin/perl
use strict;
system ("clear");
my($option, $path);
do
{
print "\tEnter the number of your chosen option:\n";
print "\n";
print "\tOption\t\tCommand\n";
print "\t======\t\t=======\n";
print "\t1\t\tDate\n";
print "\t2\t\tDirectory Listing\n";
print "\t3\t\tCalendar\n";
print "\t4\t\tVi Editor\n";
print "\t5\t\tCalculator\n";
print "\t6\t\tExit\n\n";
chomp($option=<STDIN>);
SWITCH:
{
($option =="1") and do
{
system(date);
last;
};
($option =="2") and do
{
print "Enter the path:"; ############################
chomp($path=<STDIN>); #This is giving me an error#
system(ls $path); ############################
last;
};
($option =="3") and do
{
system(cal);
last;
};
($option =="4") and do
{
system(vi);
last;
};
($option =="5") and do
{
system(bc);
last;
};
}
}while ($option!=6);
print "Goodbye!\n";
sleep 2;
First question: Can anyone help me how to write the proper command to create a directory listing in case 2.
Second Question: Why do I get a loop if I use
$date = `date`;
print "$date";
instead of
system(date);
You should be able to solve a lot of your problems by remembering to put quotes around literal arguments to system():
system("date");
system("ls $path");
and the same for most other places you call system() (your first call to system("clear") is correct).
It is a quirk of Perl that calling something like system(cal) works at all, because the unquoted cal is treated as a "bareword" by Perl, which happens to be roughly equivalent to a string when passed to a function such as system(). Relying on this behaviour would be terribly bad practice, and so you should always quote literal strings.
You could read the path like:
chomp($path=<STDIN>);
system("ls $path");
Not sure why you'd get the loop for $date =date;print "$date";. But I don't think there's a date function unless you're using a package for it. You can show a time like:
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
$year += 1900;
$mon += 1;
printf "%04d-%02d-%02d %02d:%02d:%02d",
$year, $mday, $mon,
$hour, $min, $sec;
On most unix systems perl resides in /usr/bin, without the e in user, so you might consider double-checking the first line of your script.
Your immediate problems were caused by quoting issues and the lack of use warnings in your script.
It's also worth noting that menu-driven scripts like yours are ideal candidates for dispatch tables. A dispatch table is a technique for defining actions as data. The actions are Perl subroutines. The data is usually a set of key-value pairs that end up getting stored in a hash.
The keys to the hash are the choices made by the user (menu items 1-6 in your case).
The values in the hash are called code references. There are two ways to set up these code references: (1) Directly in the dispatch table, using anonymous subroutines; or (2) using the &\foo syntax, which would create a reference to a subroutine named foo.
The handy thing about this approach is that your menu() method can be reused -- simply with a different dispatch table and a different usage message.
This example is so small that the benefit of reuse might not seem compelling, but the general technique of having data -- in the form of a dispatch table -- control program behavior is powerful in many contexts.
# Always use both of these.
use strict;
use warnings;
sub dispatch_table {
return
1 => sub { system 'date' },
2 => \&ls_path,
3 => sub { system 'cal' },
4 => sub { system 'vi' },
5 => sub { system 'bc' },
6 => sub { print "Goodbye!\n"; sleep 2 },
;
}
sub ls_path {
print "\nEnter the path: ";
chomp(my $path=<STDIN>);
# Note quoting. To be super robust, you would
# need to escape apostrophes in the path.
system "ls '$path'";
}
sub usage_message {
return "Choose wisely:
Option Command
====== =======
1 Date
2 Directory Listing
3 Calendar
4 Vi Editor
5 Calculator
6 Exit
";
}
sub menu {
system 'clear';
my %dt = dispatch_table();
my $option;
print usage_message();
while (1){
print "> ";
chomp($option = <STDIN>);
last if exists $dt{$option};
}
$dt{$option}->();
}
menu();
I can not reproduce your loop with:
$date =date;print "$date";
I doubt that is exactly how you coded it since I get a compile error
with use strict;. If you can show a reduced code example which still illustrates the problem, we could help debug it further.
If you are trying to capture the output of an external command into a variable, you could use backticks or qx:
my $date = qx(date);
print "$date";
On a side note, whenever I see a series of print statements, I think here-doc:
print <<"EOF";
Enter the number of your chosen option:
Option Command
====== =======
1 Date
2 Directory Listing
etc...
EOF
A little easier to read and maintain, no?
Finally, it is also a good idea to use warnings;.
The first couple of suggests I have are, first like others have already suggested, use warnings is strongly encouraged. Older Perl interpreters may require you use the older form #!/usr/bin/perl -w as the first line of your Perl script. Second, there is a Switch module available, to make the switch statement look less ugly. I've also shown usage of subroutines to clean up the appearance of the program.
I've attached a alternative version of your script with some potential suggestions. Note it uses a slightly different alternative for switch. If available, I'd recommend using the Switch module. It includes a different way of printing the time, and of course fixes your problem with the system calls.
I hope that helps.
#!/usr/bin/perl
use strict;
use warnings; # otherwise /usr/bin/perl -w in first line
sub menu() {
print <<EOM;
Enter the number of your chosen option:
Option Command
====== =======
1 Date
2 Directory Listing
3 Calendar
4 Vi Editor
5 Calculator
6 Exit
EOM
}
sub showtime() {
my $time = localtime;
print $time,"\n";
}
sub listdir() {
my $path;
print "Enter the path: ";
chomp($path = <STDIN>);
system("ls $path");
print "\n";
}
system("clear");
my $option;
do {
menu();
chomp($option = <STDIN>);
# SWITCH:
for ($option) {
/1/ and do {
showtime();
};
/2/ and do {
listdir();
};
/3/ and do {
system("cal");
};
/4/ and do {
system("vi");
};
/5/ and do {
system("bc");
};
last;
}
} while ($option != 6);
print "Goodbye!\n";
sleep 2;
I have a Perl program that reads in a bunch of data, munges it, and then outputs several different file formats. I'd like to make Perl be one of those formats (in the form of a .pm package) and allow people to use the munged data within their own Perl scripts.
Printing out the data is easy using Data::Dump::pp.
I'd also like to print some helper functions to the resulting package.
What's an easy way to print a multi-line string without variable substitution?
I'd like to be able to do:
print <<EOL;
sub xyz {
my $var = shift;
}
EOL
But then I'd have to escape all of the $'s.
Is there a simple way to do this? Perhaps I can create an actual sub and have some magic pretty-printer print the contents? The printed code doesn't have to match the input or even be legible.
Enclose the name of the delimiter in single quotes and interpolation will not occur.
print <<'EOL';
sub xyz {
my $var = shift;
}
EOL
You could use a templating package like Template::Toolkit or Text::Template.
Or, you could roll your own primitive templating system that looks something like this:
my %vars = qw( foo 1 bar 2 );
Write_Code(\$vars);
sub Write_Code {
my $vars = shift;
my $code = <<'END';
sub baz {
my $foo = <%foo%>;
my $bar = <%bar%>;
return $foo + $bar;
}
END
while ( my ($key, $value) = each %$vars ) {
$code =~ s/<%$key%>/$value/g;
}
return $code;
}
This looks nice and simple, but there are various traps and tricks waiting for you if you DIY. Did you notice that I failed to use quotemeta on my key names in the substituion?
I recommend that you use a time-tested templating library, like the ones I mentioned above.
You can actually continue a string literal on the next line, like this:
my $mail = "Hello!
Blah blah.";
Personally, I find that more readable than heredocs (the <<<EOL thing mentioned elsewhere).
Double quote " interpolates variables, but you can use '. Note you'll need to escape any ' in your string for this to work.
Perl is actually quite rich in convenient things to make things more readable, e.g. other quote-operations. qq and q correspond to " and ' and you can use whatever delimiter makes sense:
my $greeting = qq/Hello there $name!
Nice to meet you/; # Interpolation
my $url = q|http://perlmonks.org/|; # No need to escape /
(note how the syntax coloring here didn't quite keep up)
Read perldoc perlop (find in page: "Quote and Quote-like Operators") for more information.
Use a data section to store the Perl code:
#!/usr/bin/perl
use strict;
use warnings;
print <DATA>;
#print munged data
__DATA__
package MungedData;
use strict;
use warnings;
sub foo {
print "foo\n";
}
Try writing your code as an actual perl subroutine, then using B::Deparse to get the source code at runtime.
You sometimes hear it said about Perl that there might be 6 different ways to approach the same problem. Good Perl developers usually have well-reasoned insights for making choices between the various possible methods of implementation.
So an example Perl problem:
A simple script which recursively iterates through a directory structure, looking for files which were modified recently (after a certain date, which would be variable). Save the results to a file.
The question, for Perl developers: What is your best way to accomplish this?
This sounds like a job for File::Find::Rule:
#!/usr/bin/perl
use strict;
use warnings;
use autodie; # Causes built-ins like open to succeed or die.
# You can 'use Fatal qw(open)' if autodie is not installed.
use File::Find::Rule;
use Getopt::Std;
use constant SECONDS_IN_DAY => 24 * 60 * 60;
our %option = (
m => 1, # -m switch: days ago modified, defaults to 1
o => undef, # -o switch: output file, defaults to STDOUT
);
getopts('m:o:', \%option);
# If we haven't been given directories to search, default to the
# current working directory.
if (not #ARGV) {
#ARGV = ( '.' );
}
print STDERR "Finding files changed in the last $option{m} day(s)\n";
# Convert our time in days into a timestamp in seconds from the epoch.
my $last_modified_timestamp = time() - SECONDS_IN_DAY * $option{m};
# Now find all the regular files, which have been modified in the last
# $option{m} days, looking in all the locations specified in
# #ARGV (our remaining command line arguments).
my #files = File::Find::Rule->file()
->mtime(">= $last_modified_timestamp")
->in(#ARGV);
# $out_fh will store the filehandle where we send the file list.
# It defaults to STDOUT.
my $out_fh = \*STDOUT;
if ($option{o}) {
open($out_fh, '>', $option{o});
}
# Print our results.
print {$out_fh} join("\n", #files), "\n";
Where the problem is solved mainly by standard libraries use them.
File::Find in this case works nicely.
There may be many ways to do things in perl, but where a very standard library exists to do something, it should be utilised unless it has problems of it's own.
#!/usr/bin/perl
use strict;
use File::Find();
File::Find::find( {wanted => \&wanted}, ".");
sub wanted {
my (#stat);
my ($time) = time();
my ($days) = 5 * 60 * 60 * 24;
#stat = stat($_);
if (($time - $stat[9]) >= $days) {
print "$_ \n";
}
}
There aren't six ways to do this, there's the old way, and the new way. The old way is with File::Find, and you already have a couple of examples of that. File::Find has a pretty awful callback interface, it was cool 20 years ago, but we've moved on since then.
Here's a real life (lightly amended) program I use to clear out the cruft on one of my production servers. It uses File::Find::Rule, rather than File::Find. File::Find::Rule has a nice declarative interface that reads easily.
Randal Schwartz also wrote File::Finder, as a wrapper over File::Find. It's quite nice but it hasn't really taken off.
#! /usr/bin/perl -w
# delete temp files on agr1
use strict;
use File::Find::Rule;
use File::Path 'rmtree';
for my $file (
File::Find::Rule->new
->mtime( '<' . days_ago(2) )
->name( qr/^CGItemp\d+$/ )
->file()
->in('/tmp'),
File::Find::Rule->new
->mtime( '<' . days_ago(20) )
->name( qr/^listener-\d{4}-\d{2}-\d{2}-\d{4}.log$/ )
->file()
->maxdepth(1)
->in('/usr/oracle/ora81/network/log'),
File::Find::Rule->new
->mtime( '<' . days_ago(10) )
->name( qr/^batch[_-]\d{8}-\d{4}\.run\.txt$/ )
->file()
->maxdepth(1)
->in('/var/log/req'),
File::Find::Rule->new
->mtime( '<' . days_ago(20) )
->or(
File::Find::Rule->name( qr/^remove-\d{8}-\d{6}\.txt$/ ),
File::Find::Rule->name( qr/^insert-tp-\d{8}-\d{4}\.log$/ ),
)
->file()
->maxdepth(1)
->in('/home/agdata/import/logs'),
File::Find::Rule->new
->mtime( '<' . days_ago(90) )
->or(
File::Find::Rule->name( qr/^\d{8}-\d{6}\.txt$/ ),
File::Find::Rule->name( qr/^\d{8}-\d{4}\.report\.txt$/ ),
)
->file()
->maxdepth(1)
->in('/home/agdata/redo/log'),
) {
if (unlink $file) {
print "ok $file\n";
}
else {
print "fail $file: $!\n";
}
}
{
my $now;
sub days_ago {
# days as number of seconds
$now ||= time;
return $now - (86400 * shift);
}
}
File::Find is the right way to solve this problem. There is no use in reimplementing stuff that already exists in other modules, but reimplementing something that is in a standard module should really be discouraged.
Others have mentioned File::Find, which is the way I'd go, but you asked for an iterator, which File::Find isn't (nor is File::Find::Rule). You might want to look at File::Next or File::Find::Object, which do have an iterative interfaces. Mark Jason Dominus goes over building your own in chapter 4.2.2 of Higher Order Perl.
My preferred method is to use the File::Find module as so:
use File::Find;
find (\&checkFile, $directory_to_check_recursively);
sub checkFile()
{
#examine each file in here. Filename is in $_ and you are chdired into it's directory
#directory is also available in $File::Find::dir
}
There's my File::Finder, as already mentioned, but there's also my iterator-as-a-tied-hash solution from Finding Files Incrementally (Linux Magazine).
I wrote File::Find::Closures as a set of closures that you can use with File::Find so you don't have to write your own. There's a couple of mtime functions that should handle
use File::Find;
use File::Find::Closures qw(:all);
my( $wanted, $list_reporter ) = find_by_modified_after( time - 86400 );
#my( $wanted, $list_reporter ) = find_by_modified_before( time - 86400 );
File::Find::find( $wanted, #directories );
my #modified = $list_reporter->();
You don't really need to use the module because I mostly designed it as a way that you could look at the code and steal the parts that you wanted. In this case it's a little trickier because all the subroutines that deal with stat depend on a second subroutine. You'll quickly get the idea from the code though.
Good luck,
Using standard modules is indeed a good idea but out of interest here is my back to basic approach using no external modules. I know code syntax here might not be everyone's cup of tea.
It could be improved to use less memory via providing an iterator access (input list could temporarily be on hold once it reaches a certain size) and conditional check can be expanded via callback ref.
sub mfind {
my %done;
sub find {
my $last_mod = shift;
my $path = shift;
#determine physical link if symlink
$path = readlink($path) || $path;
#return if already processed
return if $done{$path} > 1;
#mark path as processed
$done{$path}++;
#DFS recursion
return grep{$_} #_
? ( find($last_mod, $path), find($last_mod, #_) )
: -d $path
? find($last_mod, glob("$path/*") )
: -f $path && (stat($path))[9] >= $last_mod
? $path : undef;
}
return find(#_);
}
print join "\n", mfind(time - 1 * 86400, "some path");
I write a subroutine that reads a directory with readdir, throws out the "." and ".." directories, recurses if it finds a new directory, and examines the files for what I'm looking for (in your case, you'll want to use utime or stat). By time the recursion is done, every file should have been examined.
I think all the functions you'd need for this script are described briefly here:
http://www.cs.cf.ac.uk/Dave/PERL/node70.html
The semantics of input and output are a fairly trivial exercise which I'll leave to you.
I'm riskying to get downvoted, but IMHO 'ls' (with appropriate params) command does it in a best known performant way. In this case it might be quite good solution to pipe 'ls' from perl code through shell, returning results to an array or hash.
Edit: It could also be 'find' used, as proposed in comments.