I'm working on a message system that uses unix terminal, so to make message output more user friendly, I wanted to hide <STDIN> input after pressing enter button to use it in another message output.
my $user = "Someone";
my $message = <STDIN>; #must show what does user type but should hide the message after pressing enter
chomp $message;
print messagefile "<$user> $message\n";
I've read in forums that some method is using Term::ReadKey but unfortunately I'm not able to do that since that module does not present in the system.
Borrowed from answer. It reads one character at time, and when enter is pressed, it wipes current line with \r <spaces> \r
use strict;
use warnings;
sub get_pass {
local $| = 1;
my $ret = "";
while (1) {
my $got = getone();
last if $got eq "\n";
print $got;
$ret .= $got;
}
print "\r", " " x length($ret), "\r";
return $ret;
}
my $user = "Someone";
my $message = get_pass();
chomp $message;
print "<$user> $message\n";
BEGIN {
use POSIX qw(:termios_h);
my ($term, $oterm, $echo, $noecho, $fd_stdin);
$fd_stdin = fileno(STDIN);
$term = POSIX::Termios->new();
$term->getattr($fd_stdin);
$oterm = $term->getlflag();
$echo = ECHO | ECHOK | ICANON;
$noecho = $oterm & ~$echo;
sub cbreak {
$term->setlflag($noecho);
$term->setcc(VTIME, 1);
$term->setattr($fd_stdin, TCSANOW);
}
sub cooked {
$term->setlflag($oterm);
$term->setcc(VTIME, 0);
$term->setattr($fd_stdin, TCSANOW);
}
sub getone {
my $key = '';
cbreak();
sysread(STDIN, $key, 1);
cooked();
return $key;
}
}
END { cooked() }
From http://www.perlmonks.org/?node_id=33353
use autodie qw(:all);
print "login: ";
my $login = <>;
print "Password: ";
system('stty', '-echo'); # Disable echoing
my $password = <>;
system('stty', 'echo'); # Turn it back on
Related
i want to count words in a file and want result the number of same word
my script
#!/usr/bin/perl
#use strict;
#use warnings;
use POSIX qw(strftime);
$datestring = strftime "%Y-%m-%d", localtime;
print $datestring;
my #files = <'/mnt/SESSIONS$datestring*'>;
my $latest;
foreach my $file (#files) {
$latest = $file if $file gt $latest;
}
#temp_arr=split('/',$latest);
open(FILE,"<$latest");
print "file loaded \n";
my #lines=<FILE>;
close(FILE);
#my #temp_line;
foreach my $line(#lines) {
#line=split(' ',$line);
#push(#temp_arr);
$line =~ s/\bNT AUTHORITY\\SYSTEM\b/NT__AUTHORITY\\SYSTEM/ig;
print $line;
#print "$line[0] $line[1] $line[2] $line[3] $line[4] $line[5] \n";
}
My log file
SID USER TERMINAL PROGRAM
---------- ------------------------- --------------- -------------------------
1 SYSTEM titi toto (fifi)
2 SYSTEM titi toto (fofo)
4 SYSTEM titi toto (bobo)
5 NT_AUTHORITY\SYSTEM titi roro
6 NT_AUTHORITY\SYSTEM titi gaga
7 SYSTEM titi gogo (fifi)
5 rows selected.
I want result :
User = 3 SYSTEM with program toto
, User = 1 SYSTEM with program gogo
Thanks for any information
I see yours as a two-step problem -- you want to parse the log files, but then you also want to store elements of that data into a data structure that you can use to count.
This is a guess, based on your sample data, but if your data is fixed-width, one way you can parse that into the fields is to use unpack. I think substr might more efficient, so consider how many files you need to parse and how long each is.
I would store the data into a hash and then dereference it after the files have all been read.
my %counts;
open my $IN, '<', 'logfile.txt' or die;
while (<$IN>) {
next if length ($_) < 51;
my ($sid, $user, $terminal, $program) = unpack 'A9 #11 A25 #37 A15 #53 A25', $_;
next if $sid eq '---------'; # you need some way to filter out bogus or header rows
$program =~ s/\(.+//; # based on your example, turn toto (fifi) into toto
$counts{$user}{$program}++;
}
close $IN;
while (my ($user, $ref) = each %counts) {
while (my ($program, $count) = each %$ref) {
print "User = $count $user with program $program\n";
}
}
Output from program:
User = 3 SYSTEM with program toto
User = 1 SYSTEM with program gogo
User = 1 NT_AUTHORITY\SYSTEM with program roro
User = 1 NT_AUTHORITY\SYSTEM with program gaga
This code detect automatically the size of input fields (your snippet seems an output from Oracle query) and print the results:
#!/usr/bin/perl
use strict;
use warnings;
use v5.10;
open my $file, '<', 'input.log' or die "$?";
my $data = {};
my #cols_size = ();
while (<$file>) {
my $line = $_;
if ( $line =~ /--/) {
foreach (split(/\s/, $line)) {
push(#cols_size, length($_) +1);
}
next;
}
next unless (#cols_size);
next if ($line =~ /rows selected/);
my ($sid, $user, $terminal, $program) = unpack('A' . join('A', #cols_size), $line);
next unless ($sid);
$program =~ s/\(\w+\)//;
$data->{$user}->{$program}++;
}
close $file;
foreach my $user (keys %{$data}) {
foreach my $program (keys %{$data->{$user}}) {
say sprintf("User = %s %s with program %s", $data->{$user}->{$program}, $user, $program);
}
}
i don't understand $counts{$user}{$program}++;
I wrote a Perl program where the user should type in a user name. If they enter admin, they should see the message
Welcome, admin!
Otherwise the console output should be
The username is incorrect
Here is my code
use utf8;
print "Username: ";
$username = <STDIN>;
if ( $username eq "admin" ) {
print "Welcome, admin!";
}
else {
print "The username is incorrect.";
}
But whatever the user inputs the program goes on to the else branch.
Why does this happen?
Whenever you are not sure why a comparison fails, make sure you know what's in your variable:
use Data::Dumper;
local $Data::Dumper::Useqq = 1;
print Dumper $variable;
# print Dumper \#array;
# print Dumper \%hash;
like #ikegami suggested, you need to use chomp:
chomp $username;
perldoc -f chomp
The empty <> operator is usually the best choice for input. It will read data from any files named on the command line, or from the keyboard if there were none
Your $username = <STDIN> will read from the keyboard, and if you enter admin and the enter key it will contain "admin\n". So you need to chomp the LF character from the end of the input
You should also use strict and use warnings 'all' at the start of every Perl program
Like this
use strict;
use warnings 'all';
print "Username: ";
my $user_name = <>;
chomp $user_name;
if ( $user_name eq 'admin' ) {
print "Welcome, admin!\n";
}
else {
print "The username is incorrect\n";
}
The comparison never succeed because you don't remove the line feed created by pressing Enter. Use chomp!
As everyone else already mentioned, you have a line feed and chomp will sort that out. In the rare event however where a user perhaps types a space before admin, it will still fail. You can therefore use left and right trim
use strict;
use warnings 'all';
print "Username: ";
my $user_name = <>;
$user_name =~ s/^\s+|\s+$//g;
if ( $user_name eq 'admin' ) {
print "Welcome, admin!\n";
}
else {
print "The username is incorrect\n";
}
which will match admin followed by newline, space or tab before and space or tab after admin.
You are missing to use chomp. When user has entered admin, it translated to admin\n, so we need to remove that \n. chomp is used to remove the $/ variable (line feed character) which is set to mostly \n (new line). $/ is the input record separator, newline by default.
use utf8;
print "Username: ";
$username = <STDIN>;
chomp $username;
if ( $username eq "admin" ) {
print "Welcome, admin!";
}
else {
print "The username is incorrect.";
}
I'm trying to make a program that works like a very simple server in Perl.
The program itself is meant to work as a library catalogue, giving the user options of searching for books by title or author, and borrowing or returning books. The list of books is provided in a separate file.
Basically, it's supposed to take requests (files) from "Requests" folder, process them, and then give answers (also files) in "Answers" folder. After the process is over, it deletes the old requests and repeats the process (answers are deleted by the client after they are accepted).
It's meant to run as a daemon, but for some reason only the loop responsible for deleting the request files works in the background - the requests are not processed into answers, but are just deleted. Whenever a new request appears, it's almost immediately deleted.
I'm learning to use daemons and tried to emulate what is in this thread.
#!/usr/bin/perl
use warnings;
use strict;
use Proc::Daemon;
#FUNCTIONS DEFINTIONS
sub FindAuthor
{
#try to find book by this author in the catalogue
}
sub FindTitle
{
#try to find book with this title in the catalogue
}
sub CheckIfCanBeReturned
{
#check if the book is borrowed and by whom
}
#attempt at daemonization
Proc::Daemon::Init;
my $continueWork = 1;
$SIG{TERM} = sub { $continueWork = 0 };
while ( $continueWork )
{
sleep(2);
my #RequestFilesArray = `ls /home/Ex5/Requests`;
#list all requests currently in the Request folder
for ( my $b = 0; $b < #RequestFilesArray; $b++)
{
my $cut = `printf "$RequestFilesArray[$b]" | wc -m`;
$cut = $cut - 1;
$RequestFilesArray[$b] = substr $RequestFilesArray[$b], 0, $cut;
}
#the requests are formatted in such way,
#that the first 2 letters indicate what the client wants to be done
#and the rest is taken parameters used in the processing
for (my $i = 0; $i < #RequestFilesArray; $i++)
{
my $UserRequest = `tail -1 Requests/$RequestFilesArray[$i]`;
my $fix = `printf "$UserRequest" | wc -m`;
$fix = $fix - 1;
$UserRequest = substr $UserRequest, 0, $fix;
my $RequestType = substr $UserRequest, 0, 2;
my $RequestedValue = substr $UserRequest, 3;
my $RequestNumber = $i;
if ($RequestType eq "fa")
{
#FIND BY AUTHOR
my #results = FindAuthor ($RequestedValue);
my $filename = "/home/Ex5/Answers/" . $RequestFilesArray[$RequestNumber];
open (my $answerFile, '>', $filename) or die "$!";
for (my $a = 0; $a < #results; $a++)
{
print $answerFile $results[$a],"\n";
}
close $answerFile;
}
elsif ($RequestType eq "ft")
{
#FIND BY TITLE
my #results = FindTitle ($RequestedValue);
my $filename = "/home/Ex5/Answers/" . $RequestFilesArray[$RequestNumber];
open ( my $answerFile, '>', $filename) or die "$!";
for (my $a = 0; $a < #results; $a++)
{
print $answerFile $results[$a],"\n";
}
close $answerFile;
}
elsif ($RequestType eq "br")
{
#BOOK RETURN
my $result = CheckIfCanBeReturned ($RequestedValue, $RequestFilesArray[$RequestNumber]);
my $filename = "/home/Ex5/Answers/" . $RequestFilesArray[$RequestNumber];
open ( my $answerFile, '>', $filename) or die "$!";
print $answerFile $result;
close $answerFile;
}
elsif ($RequestType eq "bb")
{
#BOOK BORROW
my $result = CheckIfCanBeBorrowed ($RequestedValue, $RequestFilesArray[$RequestNumber]);
my $filename = "/home/Ex5/Answers/" . $RequestFilesArray[$RequestNumber];
open ( my $answerFile, '>', $filename) or die "$!";
print $answerFile $result;
close $answerFile;
}
else
{
print "something went wrong with this request";
}
}
#deleting processed requests
for ( my $e = 0; $e < #RequestFilesArray; $e++)
{
my $removeReq = "/home/Ex5/Requests/" . $RequestFilesArray[$e];
unlink $removeReq;
}
#$continueWork =0;
}
You have written way too much code before attempting to test it. You have also started shell processes at every opportunity rather than learning the correct way to achieve things in Perl
The first mistake is to use ls to discover what jobs are waiting. ls prints multiple files per line, and you treat the whole of each line as a file name, using the bizarre printf "$RequestFilesArray[$b]" | wc -m instead of length $RequestFilesArray[$b]
Things only get worse after that
I suggest the following
Start again from scratch
Write your program in Perl. Perl isn't a shell language
Advance in very small increments, making sure that your code compiles and does what it is supposed to every three or four lines. It does wonders for the confidence to know that you're enhancing working code rather than creating a magical sequence of random characters
Learn how to debug. You appear to be staring at your code hoping for inspiration to strike in the manner of someone staring at their car engine in the hope of seeing why it won't start
Delete request files as part of processing the request, and only once the request has been processed and the answer file successfully written. It shouldn't be done in a separate loop
Taking what you provided, here's some pseudocode I've devised for you that you can use as somewhat of a template. This is by NO MEANS exhaustive. I think the advice #Borodin gave is sound and prudent.
This is all untested and much of the new stuff is pseudocode. However, hopefully, there are some breadcrumbs from which to learn. Also, as I stated above, your use of Proc::Daemon::Init is suspect. At the very least, it is so minimally used that it is gobbling up whatever error(s) is/are occurring and you've no idea what's wrong with the script.
#!/usr/bin/perl -wl
use strict;
use File::Basename;
use File::Spec;
use Proc::Daemon;
use Data::Dumper;
# turn off buffering
$|++;
#FUNCTIONS DEFINTIONS
sub FindAuthor
{
#try to find book by this author in the catalogue
}
sub FindTitle
{
#try to find book with this title in the catalogue
}
sub CheckIfCanBeReturned
{
#check if the book is borrowed and by whom
}
sub tail
{
my $file = shift;
# do work
}
sub find_by
{
my $file = shift;
my $val = shift;
my $by = shift;
my #results;
my $xt = 0;
# sanity check args
# do work
if ( $by eq 'author' )
{
my #results = FindByAuthor(blah);
}
elsif ( $by eq 'blah' )
{
#results = blah();
}
#...etc
# really should use File::Spec IE
my $filename = File::Spec->catfile('home', 'Ex5', 'Answers', $file);
# might be a good idea to either append or validate you're not clobbering
# an existent file here because this is currently clobbering.
open (my $answerFile, '>', $filename) or die "$!";
for ( #results )
{
print $answerFile $_,"\n";
}
close $answerFile;
# have some error checking in place and set $xt to 1 if an error occurs
return $xt;
}
#attempt at daemonization
# whatever this is is completely broken methinks.
#Proc::Daemon::Init;
my $continueWork++;
my $r_dir = '/home/user/Requests';
$SIG{TERM} = sub { $continueWork = 0 };
# going with pseudocode
while ( $continueWork )
{
#list all requests currently in the Request folder
my #RequestFilesArray = grep(/[^\.]/, <$r_dir/*>);
#the requests are formatted in such way,
#that the first 2 letters indicate what the client wants to be done
#and the rest is taken parameters used in the processing
for my $request_file ( #RequestFilesArray )
{
my $result = 0;
$request_file = basename($request_file);
my $cut = length($request_file) - 1;
my $work_on = substr $request_file, 0, $cut;
my $UserRequest = tail($request_file);
my $fix = length($UserRequest) - 1;
$UserRequest = substr $UserRequest, 0, $fix;
my $RequestType = substr $UserRequest, 0, 2;
my $RequestedValue = substr $UserRequest, 3;
if ($RequestType eq "fa")
{
#FIND BY AUTHOR
$result = find_by($request_file, $RequestedValue, 'author');
}
elsif ($RequestType eq "ft")
{
#FIND BY TITLE
$result = find_by($request_file, $RequestedValue, 'title');
}
elsif ($RequestType eq "br")
{
#BOOK RETURN
$result = CheckIfCanBeReturned ($RequestedValue, $request_file) or handle();
}
elsif ($RequestType eq "bb")
{
#BOOK BORROW
$result = CheckIfCanBeBorrowed ($RequestedValue, $request_file) or handle();
}
else
{
print STDERR "something went wrong with this request";
}
}
#deleting processed requests
if ( $result == 1 )
{
unlink $work_on;
}
sleep(2);
}
Take special note to my "mild" attempt and DRYing up your code by using the find_by subroutine. You had a LOT of duplicate code in your original script, which I moved into a single sub routine. DRY eq 'Don't Repeat Yourself'.
I am attempting to write a code that will encrypt letters with a basic cyclic shift cipher while leaving any character that is not a letter alone. I am trying to do this through the use of a sub that finds the new value for each of the letters. When I run the code now,it formats the result so there is a single space between every encrypted letter instead of keeping the original formatting. I also cannot get the result to be only in lowercase letters.
sub encrypter {
my $letter = shift #_;
if ($letter =~ m/^[a-zA-Z]/) {
$letter =~ y/N-ZA-Mn-za-m/A-Za-z/;
return $letter;
}
else {
return lc($letter);
}
}
print "Input string to be encrypted: ";
my $input = <STDIN>;
chomp $input;
print "$input # USER INPUT\n";
my #inputArray = split (//, $input);
my $i = 0;
my #encryptedArray;
for ($i = 0; $i <= $#inputArray; $i++) {
$encryptedArray[$i] = encrypter($inputArray[$i]);
}
print "#encryptedArray # OUTPUT\n";
The problem is how you are printing the array.
Change this line:
print "#encryptedArray # OUTPUT\n";
to:
print join("", #encryptedArray) . " # OUTPUT\n";
Here is an example that illustrates the problem.
#!/usr/bin/perl
my #array = ("a","b","c","d");
print "#array # OUTPUT\n";
print join("", #array) . " # OUTPUT\n";
Output:
$ perl test.pl
a b c d # OUTPUT
abcd # OUTPUT
According to the Perl documentation on print:
The current value of $, (if any) is printed between each LIST item.
The current value of $\ (if any) is printed after the entire LIST has
been printed.
So two others ways to do it would be:
#!/usr/bin/perl
my #array = ("a","b","c","d");
$,="";
print #array, " #OUTPUT\n";
or
#!/usr/bin/perl
my #array = ("a","b","c","d");
$"="";
print #array, " #OUTPUT\n";
Here is a related answer and here is documentation explaining $" and $,.
Those spaces in your output from $" (list separator) because you use print "#encryptedArray" to print that array, which equals print join($", #encryptedArray), therefore you could disable them by
local $" = '';
or you could join that #encryptedArray by yourself before you print it, just as suggested by #Matt.
Note that there is no need for such complexity. tr/// - also known as y/// - wil convert the whole string for you. Like this
use strict;
use warnings;
print "Input string to be encrypted: ";
chomp(my $input = <STDIN>);
print "$input # USER INPUT\n";
(my $encrypted = $input) =~ tr/N-ZA-Mn-za-m/A-Za-z/;
print "$encrypted # OUTPUT\n";
Below is my code. It still produces same string with no "<init>"
input string :
1: invokespecial #1 // Method java/lang/Object."<init>":()V
my $file = "Hello.javap";
open my $fh, '<', $file or die "Could not open '$file' $!";
while (my $line = <$fh>) {
if (index(uc($line), uc("Code:")) != -1) {
$code_block_started=1;
}
if(index($line,":")==-1)
{
if (my ($method) = $line =~ /.* \/\/ Method (.*);/) {
print "Method: $method\n";
}
print $line;
$code_block_started=0;
}
if($code_block_started){
if ($line =~/[0-9]/) {
my #num_strip = split(':',$line);
my #get_command = split(' ',$num_strip[1]);
# print "\n $get_command[0]";
$count{$get_command[0]}++;
}
}
Are you simply asking how to escape the " in perl? If so, write \"<init>\" just like in most languages.
Are you asking for a regular expression? If so, $str ~= /.* \/\/ Method (.*);/ will put java/lang/Object."<init>":()V into $1.
while (my $str = <>) {
if (my ($method) = $str =~ m{// Method (.*)}) {
print "$method\n";
}
}
when Perl sees the double-quote just before the word "name" it thinks that was the end of the string and then it complains about the word name being a bareword.
You might have already guessed, we need to escape the embedded " character:
use strict;
use warnings;
my $name = 'foo';
print "The \"name\" is \"$name\"\n";
http://perlmaven.com/quoted-interpolated-and-escaped-strings-in-perl