Trying to input variable into url and having encoding issues - perl

I am new to Perl and trying to make a script that takes input from the user and then get XML data from a website based on that input together with a url and then relay it back to the user.
But I have had some issues now with make a usable link based on the input from the user.
This is my code in full:
use strict;
use warnings;
my $row = 0;
use XML::LibXML;
print "\n\n\nOn what place do you need a weather report for? -> ";
chomp( my $ort = <> );
my $url = join('', "http://www.yr.no/place/Sweden/Västra_Götaland/",$ort,"/forecast_hour_by_hour.xml");
my $dom = XML::LibXML->load_xml(location => $url);
print "\n\nSee below the weather for ", $ort, ":\n\n";
foreach my $weatherdata ($dom->findnodes('//time')) {
if($row != 10){
my $temp = $weatherdata->findvalue('./temperature/#value');
my $value = $weatherdata->findvalue('./#from');
my $valuesub = substr $value, 11, 5;
print "At ", $valuesub, " the temperature will be: ", $temp, "C\n";
$row++;
}
}
print "\n\n";
If I write a place I want the weather info on. For example:
Mellerud
Then it takes that and I get a response from the link with propper data.
However. If I Write
Åmål
Its not making any sense to the script. I now get:
Could not create file parser context for file
"http://www.yr.no/place/Sweden/V├ñstra_G├Âtaland/Åmål/forecast_hour_by_hour.xml":
No error at test4.pl line 14
If I replace ",$ort," and just add Åmål I get the propper result.
I have been searching for different types of encoding for this, but I have not found a solution that works.
Once again I would like to point out that I am really new to this. I might miss something really simple. My apologies for that.
::EDIT 1::
After suggestion from #zdim I added use open ':std', ':encoding(UTF-8)';
This added some different results, but does only generate more error as following here:
Also I am running this in Windows CMD under administrator privileges.
According to #zdim its running fine in linux with xterm for input, v5.16.
Is there a way to make it work in Windows?

The problem is that CMD.exe is limited to 8-bit codepages. The "Å" and "å" characters are mapped (in Swedish Windows) to positions in the upper 8-bit range of codepage 850 that are illegal code points in Unicode.
If you need to output non-7-bit-ASCII characters, consider running PowerShell ISE. If you set it up correctly, it can cope with any character (in output) that the font you're using supports. The big downside is that PowerShell ISE is not a console, and therefore doesn't allow input from console/keyboard using STDIN. You can work around this by supplying your input as arguments, from a pipe, in a setting file, or thru graphical UI query elements.
To set up Windows PowerShell ISE to work with UTF8:
Set PowerShell to allow running local unsigned user scripts by running (in administrator elevated PowerShell):
Set-ExecutionPolicy RemoteSigned
Create or edit the file "<Documents>\WindowsPowerShell\Microsoft.PowerShellISE_profile.ps1" and add something like:
perl -w -e 'print qq!Initializing with Perl...\n!;'
[System.Console]::OutputEncoding = [System.Text.Encoding]::UTF8;
(You need the Perl bit (or something equivalent) there to allow for the
modification of the encoding.)
In PowerShell ISE's options, set the font to Consolas.
In your perl scripts, always do:
binmode(STDOUT, ':encoding(UTF-8)');
binmode(STDERR, ':encoding(UTF-8)');
My solution to the OP's problem:
use strict;
use warnings;
my $row = 0;
use XML::LibXML;
binmode(STDOUT, ':encoding(UTF-8)');
binmode(STDERR, ':encoding(UTF-8)');
#ARGV or die "No arguments!\n";
my $ort = shift #ARGV;
print "\n\n\nGetting weather report for \"$ort\"\n";
my $url = join('', "http://www.yr.no/place/Sweden/Västra_Götaland/",$ort,"/forecast_hour_by_hour.xml");
my $dom = XML::LibXML->load_xml(location => $url);
print "\n\nSee below the weather for ", $ort, ":\n\n";
foreach my $weatherdata ($dom->findnodes('//time')) {
if($row != 10){
my $temp = $weatherdata->findvalue('./temperature/#value');
my $value = $weatherdata->findvalue('./#from');
my $valuesub = substr $value, 11, 5;
print "At ", $valuesub, " the temperature will be: ", $temp, "C\n";
$row++;
}
}
print "\n\n";
Output:
(run at around 2018-06-09T14:05 UTC; 16:05 CEST (which is Sweden's time zone)):
PS (censored)> perl -w $env:perl5lib\Tests\Amal-Test.pl "Åmål"
Getting weather report for "Åmål"
See below the weather for Åmål:
At 17:00 the temperature will be: 27C
At 18:00 the temperature will be: 26C
At 19:00 the temperature will be: 25C
At 20:00 the temperature will be: 23C
At 21:00 the temperature will be: 22C
At 22:00 the temperature will be: 21C
At 23:00 the temperature will be: 20C
At 00:00 the temperature will be: 19C
At 01:00 the temperature will be: 18C
At 02:00 the temperature will be: 17C
Another note:
Relying on data to always be in an exact position in a string might not be the best idea.
Instead of:
my $valuesub = substr $value, 11, 5;
maybe consider matching it with a regular expression instead:
if ($value =~ /T((?:[01]\d|2[0-3]):[0-5]\d):/) {
my $valuesub = $1;
print "At ", $valuesub, " the temperature will be: ", $temp, "C\n"; }
else {
warn "Malformed value: $value\n";
}

Related

how to convert column into row in perl

I am reading values from my sql database for a column. Now I want to convert columns values in row in comma(ex:-"abc","xyz")
Source Data:-
amol
aakash
shami
krishna
Output expected: ( "amol","aakash","shami","krishna")
Code which I am trying:-
#!/usr/bin/env perl
$t = `date`;
#print $t;
$GCMS_SERVER = $ENV{DSQUERY};
$GCMS_USERNAME = $ENV{GCMS_USERNAME};
$GCMS_PASSWORD = $ENV{GCMS_PASSWORD};
$GCMS_DATABASE = $ENV{GCMS_DATABASE};
#print "test\n";
my $query = "SELECT Label FROM FeedGenSource WHERE BaseFileName ='aldgctna'";
#print "SQL =$query\n";
my $sqlcmd = (qq/
set nocount on
go
use $GCMS_DATABASE
go
$query
/);
open(::DBCMD, "sqsh -S$GCMS_SERVER -U$GCMS_USERNAME -h -w100 -P- <<EOF
$GCMS_PASSWORD
$sqlcmd
go
EOF
|") || die("Could not communicate with DB ");
while(<::DBCMD>){
print "$_";
}
#print "done\n";
close ::DBCMD;
exit
This is the perl script. I want to use output in query as in statement.
Your output comes from this section of your code:
while(<::DBCMD>){
print "$_";
}
The filehandle ::DBCMD is connected to the output from your sqsh command. Your code reads each record from that filehandle and prints it to STDOUT.
If you want to do something cleverer with the output, then you're going to have to store the data in some kind of data structure (probably an array in this case) and manipulate that.
I expect you want something like this:
my #data;
while (<::DBCMD>) {
chomp; # remove the newline
push #data, $_;
}
# And then:
print join(',', #data), "\n";
To print the exact output that you ask for, you would need this:
print '(', join(',', map { qq["$_"] } #data), ")\n";
But I have to ask... why are you making your life so difficult by manipulating data that comes back from sqsh? You should really look at Perl's database interface library, DBI. That will make your life far simpler.
A few other tips:
Always have use strict and use warnings in your code. And fix the issues they will reveal.
Use Perl's built-in date and time tools instead of shelling out to date.
Using :: on your bareword filehandle achieves nothing. Just DBCMD works the same way and is less confusing.

Perl CGI produces unexpected output

I have a Perl CGI script for online concordance application that searches for an instance of word in a text and prints the sorted output.
#!/usr/bin/perl -wT
# middle.pl - a simple concordance
# require
use strict;
use diagnostics;
use CGI;
# ensure all fatals go to browser during debugging and set-up
# comment this BEGIN block out on production code for security
BEGIN {
$|=1;
print "Content-type: text/html\n\n";
use CGI::Carp('fatalsToBrowser');
}
# sanity check
my $q = new CGI;
my $target = $q->param("keyword");
my $radius = $q->param("span");
my $ordinal = $q->param("ord");
my $width = 2*$radius;
my $file = 'concordanceText.txt';
if ( ! $file or ! $target ) {
print "Usage: $0 <file> <target>\n";
exit;
}
# initialize
my $count = 0;
my #lines = ();
$/ = ""; # Paragraph read mode
# open the file, and process each line in it
open(FILE, " < $file") or die("Can not open $file ($!).\n");
while(<FILE>){
# re-initialize
my $extract = '';
# normalize the data
chomp;
s/\n/ /g; # Replace new lines with spaces
s/\b--\b/ -- /g; # Add spaces around dashes
# process each item if the target is found
while ( $_ =~ /\b$target\b/gi ){
# find start position
my $match = $1;
my $pos = pos;
my $start = $pos - $radius - length($match);
# extract the snippets
if ($start < 0){
$extract = substr($_, 0, $width+$start+length($match));
$extract = (" " x -$start) . $extract;
}else{
$extract = substr($_, $start, $width+length($match));
my $deficit = $width+length($match) - length($extract);
if ($deficit > 0) {
$extract .= (" " x $deficit);
}
}
# add the extracted text to the list of lines, and increment
$lines[$count] = $extract;
++$count;
}
}
sub removePunctuation {
my $string = $_[0];
$string = lc($string); # Convert to lowercase
$string =~ s/[^-a-z ]//g; # Remove non-aplhabetic characters
$string =~ s/--+/ /g; #Remove 2+ hyphens with a space
$string =~s/-//g; # Remove hyphens
$string =~ s/\s=/ /g;
return($string);
}
sub onLeft {
#USAGE: $word = onLeft($string, $radius, $ordinal);
my $left = substr($_[0], 0, $_[1]);
$left = removePunctuation($left);
my #word = split(/\s+/, $left);
return($word[-$_[2]]);
}
sub byLeftWords {
my $left_a = onLeft($a, $radius, $ordinal);
my $left_b = onLeft($b, $radius, $ordinal);
lc($left_a) cmp lc($left_b);
}
# process each line in the list of lines
print "Content-type: text/plain\n\n";
my $line_number = 0;
foreach my $x (sort byLeftWords #lines){
++$line_number;
printf "%5d",$line_number;
print " $x\n\n";
}
# done
exit;
The perl script produces expected result in terminal (command line). But the CGI script for online application produces unexpected output. I cannot figure out what mistake I am making in the CGI script. The CGI script should ideally produce the same output as the command line script. Any suggestion would be very helpful.
Command Line Output
CGI Output
The BEGIN block executes before anything else and thus before
my $q = new CGI;
The output goes to the server process' stdout and not to the HTTP stream, so the default is text/plain as you can see in the CGI output.
After you solve that problem you'll find that the output still looks like a big ugly block because you need to format and send a valid HTML page, not just a big block of text. You cannot just dump a bunch of text to the browser and expect it to do anything intelligent with it. You must create a complete HTML page with tags to layout your content, probably with CSS as well.
In other words, the output required will be completely different from the output when writing only to the terminal. How to structure it is up to you, and explaining how to do that is out of scope for StackOverflow.
As the other answers state, the BEGIN block is executed at the very start of your program.
BEGIN {
$|=1;
print "Content-type: text/html\n\n";
use CGI::Carp('fatalsToBrowser');
}
There, you output an HTTP header Content-type: text/html\n\n. The browser sees that first, and treats all your output as HTML. But you only have text. Whitespace in an HTML page is collapsed into single spaces, so all your \n line breaks disappear.
Later, you print another header, the browser cannot see that as a header any more, because you already had one and finished it off with two newlines \n\n. It's now too late to switch back to text/plain.
It is perfectly fine to have a CGI program return text/plain and just have text without markup be displayed in a browser when all you want is text, and no colors or links or tables. For certain use cases this makes a lot of sense, even if it doesn't have the hyper in Hypertext any more. But you're not really doing that.
Your BEGIN block serves a purpose, but you are overdoing it. You're trying to make sure that when an error occurs, it gets nicely printed in the browser, so you don't need to deal with the server log while developing.
The CGI::Carp module and it's functionality fatalsToBrowser bring their own mechanism for that. You don't have to do it yourself.
You can safely remove the BEGIN block and just put your use CGI::CARP at the top of the script with all the other use statements. They all get run first anyway, because use gets run at compile time, while the rest of your code gets run at run time.
If you want, you can keep the $|++, which turns off the buffering for your STDOUT handle. It gets flushed immediately and every time you print something, that output goes directly to the browser instead of collecting until it's enough or there is a newline. If your process runs for a long time, this makes it easier for the user to see that stuff is happening, which is also useful in production.
The top of your program should look like this now.
#!/usr/bin/perl -T
# middle.pl - a simple concordance
use strict;
use warnigns;
use diagnostics;
use CGI;
use CGI::Carp('fatalsToBrowser');
$|=1;
my $q = CGI->new;
Finally, a a few quick words on the other parts I deleted from there.
Your comment requires over the use statements is misleading. Those are use, not require. As I said above, use gets run at compile time. require on the other hand gets run at run time and can be done conditionally. Misleading comments will make it harder for others (or you) to maintain your code later on.
I removed the -w flag from the shebang (#!/usr/bin/perl) and put the use warnings pragma in. That's a more modern way to turn on warnings, because sometimes the shebang can be ignored.
The use diagnostics pragma gives you extra long explanations when things go wrong. That's useful, but also extra slow. You can use it during development, but please remove it for production.
The comment sanity check should be moved down under the CGI instantiation.
Please use the invocation form of new to instantiate CGI, and any other classes. The -> syntax will take care of inheritance properly, while the old new CGI cannot do that.
I ran your cgi. The BEGIN block is run regardless and you print a content-type header here - you have explicitly asked for HTML here. Then later you attemp to print another header for PLAIN. This is why you can see the header text (that hasn't taken effect) at the beginning of the text in the browser window.

Cannot call pdflatex from perl script (due to encoding?)

When I call pdflatex manually from the windows command line, it generates the desired pdf.
When I call pdflatex from a perl script instead, it does not:
system("pdflatex $fileName");
.. results in
Sorry, but pdflatex did not succeed.
You may want to visit the MiKTeX project page, if you need help.
utf8 "\x80" does not map to Unicode at C:/strawberry-perl/perl/site/lib/Encode.pm line 200.
The script was running on unix before and working fine. Now, after having it migrated to a windows system it doesn't.
The content of the tex-input-file is generated by the script as well. the "file"-command on my Mac tells me that this file is encoded as "us-ascii".
So I tried to make perl encode it as "utf-8", but it did not work:
open(FH, "> :encoding(utf-8)", $fileName);
or
binmode(FH, ":utf8");
Files are still being generated with us-ascii encoding. How can I change that?
So far, the encoding is my only clue.
What else could be the problem?
If this works fine when manually typed into the command line the this could be due to the way perl interpolates the quotation marks before passing the command to the system. Have you tried printing the call you making to test whether it provides the exact same imput as when to enter it manually? Otherwise, for passing arguments to a program via the system command in perl I always separate them out as follows to avoid any interpolation errors:
#...
my $prog = "Z.*";
my $arg1 = "X";
my $arg2 = "Y";
#...
my $file = "W.*";
system("$prog", ("$arg1", "$arg2", ..., "$file"));
#...
If this doesn't work, another, albeit rather clunky solution, might be to import the file contents into a variable and try the following to 'manually' encode it in perl as follows:
use Encode;
use utf8;
use charnames qw( :full :short );
my $encodedfile = encode("utf8", $filecontents);
If you happen to have any active caracters in the file which could influence the way pdflatex handles the final output (for example in perl \\ gives \ to pdflatex, which ends up finally being ) you can append the following to the encoding:
my $str = $encodedfile;
my $find = "\\N{U+005C}";
my $replace = "\\textbackslash ";
$str =~ s/$find/$replace/g;
my %special_characters;
$special_characters{"\\N{U+0025}"} = "\\pourcent ";
$special_characters{"\\\$"} = "\\\$";
$special_characters{"\\N{U+007B}"} = "\\{";
$special_characters{"\N{U+007D}"} = "\\}";
$special_characters{"\N{U+0026}"} = "\\&";
$special_characters{"\\N{U+005F}"} = "\\textunderscore ";
$special_characters{"\\N{U+002F}"} = "\/";
$special_characters{"\\N{U+005B}"} = "\[";
$special_characters{"\\N{U+005D}"} = "\]";
$special_characters{"\\N{U+005E}"} = "\\textasciicircum ";
$special_characters{"\\N{U+0023}"} = "\\#";
$special_characters{"\\\N{U+007E}"} = "\\textasciitilde ";
$special_characters{"\\\N{U+0021}"} = " \\newline ";
my $string = $str;
foreach my $char (keys %special_characters) {
$string =~ s/$char/$special_characters{$char}/g;
}
Hope this helps.

Optimize perl script to filter rows based on date in the file

I am a beginner with programming not just perl !
Please let me know what needs to change or how else this can be done.
Need to optimize the perl code to run faster.
For a test run, with around a 500MB file with 3 million rows in it, runtime is 28 minutes.
I know a tool which processes the 39 million rows in 15 mins, but i want to acheive this running on the command prompt without resorting to the tool.
Earlier I used Date::Manip and Date::Parse and moved on to DateTime, thinking it should be faster.
My approach was If the dates are ISO-8601 (ie, YYYY-MM-DD) and we do not need to validate them,
we can compare lexicographically (ie, the lt and gt operators.)
Input File Date Format is 07/18/2013 13:45:49
Input File Size 42GB.
Number of Rows 39 Million.
Column Delimiter : |~|
Platform : GNU/Linux
I have tried ">" and "gt" and did not find any difference in runtime.
Code snippet:
use DateTime::Format::Strptime;
my $idate = "07/17/2013 00:00:00";
my $Strp = DateTime::Format::Strptime->new(
pattern => '%m/%d/%Y %H:%M:%S',
);
my $inputdt = $Strp->parse_datetime($idate);
open (FILE,"myinputfile.dat") or die "could not input File\n";
while (defined(my $line = <FILE>)) {
my #chunks = split '[|]~[|]', $line;
my $fdate = $Strp->parse_datetime($chunks[6]);
if ( $fdate > $inputdt) {
open(FILEOUT, ">>myoutputfile.dat") or die "Could not write\n";
print FILEOUT "$line";
}
}
close(FILE);
close (FILEOUT);
There are two and a half big performance problems here:
You open the output file in every iteration. Just open it once, before the loop.
The parse_datetime returns a DateTime object. Object orientation with Perl implies a significant overhead. Because your pattern is well defined, we can do the parsing ourself, and remove all object orientation.
Reading a file in the GB range just takes some time. To speed this up, upgrade your hardware (e.g. to a SSD).
To parse the date string into a sortable representation, we just reorder the various parts to a string:
# %m/%d/%Y %H:%M:%S → %Y/%m/%d %H:%M:%S
$fdate =~ s{^ ([0-9]{2} / [0-9]{2}) / ([0-9]{4}) }{$2/$1}x;
if ($fdate gt $inputdate) { ... }
This would lead to the code
use strict; use warnings;
use constant DATE_FIELD => shift #ARGV;
my $inputdate = shift #ARGV;
$inputdate =~ s{^ ([0-9]{2} / [0-9]{2}) / ([0-9]{4}) }{$2/$1}x;
<>; # remove the header line
while (<>) {
my $filedate = (split /\|~\|/, $_, DATE_FIELD + 2)[DATE_FIELD];
$filedate =~ s{^ ([0-9]{2} / [0-9]{2}) / ([0-9]{4}) }{$2/$1}x;
print if $filedate gt $inputdate;
}
The in- and output, as well as the start date, are specified on the command line, e.g.
./script 6 '07/17/2013 00:00:00' myinputfile.dat >>myoutputfile.dat

Simple Perl Script: Two questions

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;