Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked

The Monastery Gates

( #131=superdoc: print w/ replies, xml ) Need Help??

Donations gladly accepted

If you're new here please read PerlMonks FAQ
and Create a new user.

New Questions
How to hide the Contents in script
5 direct replies — Read more / Contribute
on Dec 23, 2014 at 03:37
    Hi monks, I wanted to know, is there any way to hide the Content in Script before giving it to Third party users. I dont want others to see the script, it will be better to provide only the executable(exe) like files. Is there any way to do that?
[Re]confirm box
1 direct reply — Read more / Contribute
by kbee
on Dec 23, 2014 at 03:02

    I am in an unique 'perl' situation in trying to embed a reconfirm box into an existing perl/cgi script, and let the perl script continue processing through its code based on the yes/no response of the user. To further describe my situation, the user currently launches an operational webpage and selects an app service and an actioneither activate, de-activate or check status and clicks submit. A confirm box shows up to accept the yes/no response from the user. A yes response results in the servicename and action passed onto the perl/cgi script which goes ahead in carrying out the selected action while displaying the results in a separate window with appropriate header and footer information. I needed to embed a confirm box again into the perl code if the action was 'de-activate' and have perl hold its further processing until the user responds back with a yes again. So far after googling through web postings and using perl/javascript snippet examples, the perl/cgi script does throw up the second confirm box if the action is de-activate, but it continues onward irrespective of a response from the box or not. I have attached sections of the code below and appreciate your expert advice from you perl monks. Though I am familiar with perl programming, integrating the second confirm box has been a challenge. Thanks for reading my post.

    #!/usr/bin/perl -w # use CGI; use CGI::Carp qw (fatalsToBrowser); use Cwd; use lib getcwd . '/lib'; use COI::INIFile; use COI::Logger; use File::Basename; use COI::Commands; use Sys::Hostname; use strict; ...... ...... my $q = CGI->new; print $q->header('text/html'); #print $q->Dump(%ENV); ### get values from html form my $username = $q->param("username"); my $action = $q->param("option_1") ; my $service = $q->param("option_2") ; print "</left><pre>\n"; &print_header; if ( $action eq 'Status') { my $wait_for_user_response = "yes"; if(defined($q->param("userresponse"))) { if($q->param("userresponse") eq "yes") { print "go ahead \n"; } else { print "don't go ahead \n"; } } print "<html>\n"; print "<head>\n"; print "<LANGUAGE=Javascript>\n"; print "<script>\n"; print "function CheckForm_onclick()\n"; print "{\n"; print "var myForm = document.form1;\n"; print "var message = \"\";\n"; print "message = \"Confirm if you need to disable $ser +vice. Choose OK to go ahead and Cancel to abort.\";\n"; print "var answer = confirm(message);\n"; print "if (answer == false ){ \n"; print "document.write(\'You chose to Cancel. Closed wi +ndow.\');\n"; print "}\n"; print "else {\n"; print "document.getElementById(\"userresponse\").value + = \"Yes\";\n"; print "document.form.submit();\n"; print "}\n"; print "}\n"; print "</SCRIPT>\n"; &reconfirm_form; } print "\n Going ahead made it\n"; &footer(); sub reconfirm_form { print "<title>$tool_desc</title>\n"; print "</head>\n"; print "<body onload=\"return (CheckForm_onclick())\">\n"; print "<FORM action=\"disable.cgi\" method=\"post\">\n"; print "<input type=\"hidden\" name=\"userresponse\" >\n"; print "</form>\n"; print "</body>\n"; print "</html>\n"; }
Have a multiple file in directory and want to manipulate in each files in incremental order. All the file have same value.
3 direct replies — Read more / Contribute
by hemantjsr
on Dec 23, 2014 at 02:34

    Please find below Working Code. It's giving error message "Use of uninitialized value $lines1 in substitution (s///) a"

    apart from that it's giving a result like in a file01.txt have now file01.txt, in file02.txt have file02.txt only and so on. Old values are deleted and only filename are comeing file.

    where as i needed output like

    file01.txt have 11 10,9:10/4947000219 :20140924105028 24

    file02.txt have 11 10,9:10/4947000220 :20140924105228 24

    file03.txt have 11 10,9:10/4947000221 :20140924105428 24

    file04.txt have 11 10,9:10/4947000222 :20140924105628 24

    #!/usr/bin/perl use strict; use 5.10.0; # For autodie and regex \K use autodie; use File::Find; use Time::Piece; use Time::Seconds qw/ ONE_MINUTE /; use constant DATE_FORMAT => '%Y%m%d%H%M%S'; my $n; my $directory="/home/e/Doc/AutoMation"; chdir $directory; opendir(DIR, ".") or die "couldn't open $directory: $!\n"; foreach my $file (readdir DIR) { next unless -f $file; open my $in_fh, '<',$file; my @lines = <$in_fh>; close $in_fh; ++$n; $lines[0] =~ s~/4947000219/\K(4947000210+)~$1+$n~e; $lines[1] =~ s{:20140924105028\K(20140924105028+)}{ my $tp = Time::Piece->strptime($1, DATE_FORMAT); ($tp + ONE_MINUTE * 2 * $n)->strftime(DATE_FORMAT); }e; open my $out_fh, '>', $file; print $out_fh @lines; close $out_fh; } closedir DIR;
Trying to understand hashes (in general)
6 direct replies — Read more / Contribute
by james28909
on Dec 23, 2014 at 00:06
    Hello Monks! I am trying my best to understand exactly how to add just a key without a value to a hash. I understand very little when it comes to hashes, and I am trying to get away from using arrays, because it is to my understanding that finding a certain key in a hash is much quicker than finding an element in an array if you have a huge amount of elements.

    So what i was planning on doing was migrating a few of my scripts to use hashes instead of arrays. Here is the code i have (which works) but i am uncertain as to how it works tbh.
    use warnings; use strict; my $path = shift; opendir( my $DIR, $path ); my %dirs; while ( my $file = readdir($DIR) ) { next if ( $file eq '.' || $file eq '..' ); $dirs{$file} = $file; } print "$_\n" for sort keys %dirs; #print "$_\n" for sort values %dirs; #same as keys... #print "$_\n" for sort %dirs;
    This will read a directory of course, and will print out that directories contents whether it be file or directory. Also, if you comment out the first print statement, and uncomment the last print statement, it will print duplicates and i am unsure as to why it is adding the filename to key and value of the hash.

    Any insight into this would be very much appreciated and thanks.

    EDIT: What I am going to eventually shoot for, is making a hash of hashes. and in each of these hash of hashes will be directories and filenames respectively, so any input on that would be appreciated as well. :)
Best way to store/sum multiple-field records?
3 direct replies — Read more / Contribute
by bobdabuilda
on Dec 22, 2014 at 18:49

    Hi guys, quite rusty on my Perl as I've been stuck doing other stuff for quite some time. Am currently trying to help a colleague sort out an issue he has with a small Perl script he's inherited.

    Basically, the script reads in some data in the form of:

    USERID1|2215|Jones,Tom| USERID1|1000|Jones, Tom| USERID3|1495|Dole, Bob| USERID2|2500|Francis, Pope| USERID2|1500|Francis, Pope|

    The goal is to process each of these records, keep a running total of the values in the second field, then output the ID, the sum of the second field for that ID, and the name.

    I managed to fix a couple of minor things that were wrong in it (no trailing pipe on the end of the record causing additional blank lines in the output, small things like that), but am not sure on the best way to handle this with the additional field. The (broken) code he currently has is:

    #!/usr/bin/perl use strict; use warnings; my ($key,$value,$reason); my %sum=(); while(<>) { unless(/.*\|(\d+)/){print STDERR "dropped line: \"$_\""; next;} ($key,$value,$reason) = split(/\|/); $sum{$key}+=$value; } foreach $key (keys %sum){print "$key|$sum{$key}|$reason\n";}

    Running the above gives the following result:

    USERID3|1495|Francis, Pope USERID1|3215|Francis, Pope USERID2|4000|Francis, Pope

    The obvious issue here is $reason - it's not being stored anywhere during the loop, so just repeating the $reason from the last record in the data... but I'm not sure of the best way to do this? It's easy enough when just dealing with the first two fields, as you can use a simple hash, as is being done already.

    I'm just not sure of the best way to add the extra info into this? Is a hash of hashes required to get the additional element in? I've not played with complex hashes before, so suggestions/examples would be much appreciated.

Redefined import method and EXPORT not working
1 direct reply — Read more / Contribute
by Anonymous Monk
on Dec 22, 2014 at 01:13

    I redefined the import method of a module

    package M1; use parent qw(Exporter); our @EXPORT; sub func{print "Hello"} sub import{print "Imported";@EXPORT=qw(func)} 1;

    And EXPORT is not working

    perl -I. -le 'use M1;func()' Imported Undefined subroutine &main::func called at -e line 1.

    But when I don't redefine import function, EXPORT works fine

    package M1; use parent qw(Exporter); our @EXPORT; sub func{print "Hello"} #sub import{print "Imported";@EXPORT=qw(func)} 1;
    perl -I. -le 'use M1;func()' Hello
    How can I get both redefining import and EXPORT to work?
comma(or fat comma) in 'use' directive
3 direct replies — Read more / Contribute
by Anonymous Monk
on Dec 21, 2014 at 23:20

    Like this sentence:

    use Test::Simple tests => 1;

    Sometimes I see there is a fat comma on use directive Of course I would think they are functions if it looked like:

    use Foo::Bar qw(func1 func2);

    But in the first case, '1' cannot be a function name. So what is that '1'? Is it a parameter to the function 'tests' or a parameter to the module Test::Simple or what???

Seeking regexp @ARGV arrays Wisdom
4 direct replies — Read more / Contribute
by Anonymous Monk
on Dec 21, 2014 at 10:24

    Thank you in advance. I am writing a short program, a game, that tests your knowledge of GNU/Linux commands and programs (with a whatis entry). I want it to put like flash cards: present the name of the command, wait for the user, then print the description, wait for the user, ad infinitum. The code below shows the first attempt (SLATHERED WITH COMMENTS):

    #!/usr/bin/perl #bashflash #tests your memory of bash/gnu-linux commands and cli programs #USAGE: #cd to the directory containing the binarys of the programs #you want to test your knowledge of (DO NOT NEED TO BE ROOT) #pass perl bashflash -`whatis --wildcard *` # use strict; use warnings; #The following loop utilizes a shift-and-push loop #to shift the zeroth element of @ARGV out of the array, into a scalar, #then push the scalar back into the array as the final element. #effectively, this process lets one cycle through the output of #`whatis --wildcard *` indefinitely, *while separating the #command names from their descriptions, like flashcards.* #*In it's current implementation, @ARGV stores the output of `whatis` #word by word: such that elements are delineated by spaces. my $currentcard; #this variable holds onto strings shifted off of @ARG +V #, prints them, then pushes it's contents #back onto the end of ARGV while (1) { #infinite loop START $currentcard = shift; #shift first element #of @ARGV into $currentcard print $currentcard; push (@ARGV, $currentcard); #push $currentcard #(previously element 0) back onto #@ARGV as the last element <STDIN>; #Wait for user } #infinite loop END exit; #the script never gets here, #but I always explicitly exit on the end of my Perl. #and then an empty comment line #

    This program puts this to STDOUT:

    Note, each line after "-bash" had to be summoned by the return key, meaning that (as explained in the comments) @ARGV has stored the command line argument into new elements by word. (This is my current understanding, please correct me.)

    #1, the negative testing while

    #2, the while controlled by internal positive testing if

    Above: an attempt, two of many, to get the "flash card" output I desire. My plan is to instead push the shifted elements of @ARGV onto an Array in a regexp-conditional loop, to attempt to match the "- " in the last element of Array, if it does match "- ", then the code should exit the loop and print everything it collected up to and including the "- ", then pushing it's content back onto the end of @ARGV, and waiting for the return key press. Or the logical equivalent, test positive for iteration with the lack of "- ", and keep adding to Array until shift adds a "- ". As above.

    I have tried dozens of variations with positive and negative regular expressions, I even tried /.*/, but every time I try to group the output such that iterations of print are delimited by "- ", just I get blank lines.

    Am I using push and shift incorrectly?

    Prithee, great archons of perl, behelpeth me.

New Meditations
Authentication with U2F Two-factor keys
No replies — Read more | Post response
by cavac
on Dec 19, 2014 at 07:43

    I just uploaded the first Alpha version of Crypt::U2F, which allows you to handle the server side cryptography of the FIDO alliance's Universal 2nd factor authentication method. See also here.

    This is the same one used by Google services and fully supported in Google Chrome.

    Internally, Crypt::U2F requires Yubico's libu2f-server library installed on your system. I implemented this in two Perl modules: Crypt::U2F is the low level module (sand subject to change), that let's you play around with the underlying library. Crypt::U2F::Simple is the one you should use in most cases.

    Let's have a look into the two examples provided with the tarball. For this to work, you need to install libu2f-server and also install libu2f-host, because we need the u2f-host binary to talk to the actual USB dongle. (I'm currently in the process of making a Perl module for libu2f-host as well, but this will only finish after the hollidays.)

    The whole thing is a two part process: First you have register a new key once, then you can authenticate as often as you like. Each part (registering, authentication) itself is a two-part process as well, first you generate a challenge and send it to the client, then you have to validate the response.

    Ok, let's start with registering a key. For this example, we pass around files to and from u2f-host and also save the registered keyHandle and public key into files as well. In a real world scenario, you will probably use HTTP and Javascript to communicate with the key and save keyHandle and the public key into a database. Here's the code:

    The reason we use Base64 is simple, yet annoying: Everything except the public key is either some sort of text or even ASCII JSON. The public key on the other hand is a binary blob. It's just a matter of convenience to turn it into Base64, because that we it works in textfiles and text columns in databases as well. It don't convert directly in the library, because that might make it problematic to cooperate with other implementations of U2F authentications that also use the original C library (which delivers a binary blob), including the u2f-server example binary that comes with it.

    All of the calls to Crypt::U2F::Simple may fail for one reason or another (including new() and DESTROY()), so make sure you check all the return values!

    Let's tackle the authentication part. We'll use the keyHandle.dat and publicKey.dat generated in the previous step:

    As you can see, the process is quite similar: We load the keyHandle.dat and publicKey.dat (the second one we decode_base64()) and initialize Crypt::U2F::Simple with it. Then we generate a challenge and verify it.

    If you want to make sure the verification step actually works, you can comment out the call can try to fuss the result of u2fhost in authReply.dat. Or just comment out the call to u2fhost after you you did one successfull authentication, this one should give you a u2fs_authentication_verify (-6): Challenge error.

    Limitations and Bugs: Currently (Version 0.10), each Challenge/Verify combo has to run in the same instance of the module. I'm still working on finding out how to fix that. Also, sometimes the USB keyfob seems to be in a strange state after plugging in, returning wrongly calculated authentication replies (at least mine does). Unplugging and replugging solves that problem.

    "For me, programming in Perl is like my cooking. The result may not always taste nice, but it's quick, painless and it get's food on the table."
Log In?

What's my password?
Create A New User
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (6)
As of 2014-12-26 03:51 GMT
Find Nodes?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?

    Results (165 votes), past polls