Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine

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
Best way to handle interactive user input?
4 direct replies — Read more / Contribute
by Ppeoc
on Nov 26, 2015 at 02:02
    I have a huge XML file to parse. I was thinking that instead of parsing the whole file, I could ask the user to input a few options and then parse only that portion of the file. I was basically planning to do this
    Enter option to be parsed 1. Fiction 2. History 3. Religion 10. Non fiction

    So once the user enters the number 2, Book 2 will get selected and bunch of other options will be displayed as follows

    Selected Book 2. Options are as follow 1. World History 2. American History 3. Oriental History 10. Indian History

    Each option is nested differently with different levels. The plan is to use a switch statement on the returned $_ to display options for the next level. How do I navigate to a different part of the program and display options according to the genre selected. Thanks!

    use strict; use warnings; use Switch; my $level1; print "Select options: \n 1 Fiction \n 2 History \n 3 Religion \n"; my $no = getIP('Enter a digit : ', /^\d/); switch ($no) { case 1 { $level1 = ?? } case 2 { $level1 = ?? } case 3 { $level1 = ?? } else { $level1= ?? } } print $level1; sub getIP { print $_[0]; do { $_ = <STDIN>; chomp; } while ($_[1] && $_ !~ $_[1]); return $_; }
Check a string for consecutive digits
6 direct replies — Read more / Contribute
by Anonymous Monk
on Nov 25, 2015 at 17:38

    Greetings, keepers of knowledge.

    I'm putting together a password checking script for Asterisk voicemail; one of the things I want to disallow is the use of a password that's got too many consecutive digits. "1234" being the classic example, but also "298761" or "4562".

    PHP is my usual language, but it's not available, so I went with Perl, since I used it many years ago, and the two share a lot of common syntax. The code I have works, but I feel like there should be a better way, that doesn't take so many lines of code to go through every digit twice.

    my $password = $2; my $limit = 3; # want to reject 4568 but not 4578 my $counter = 0; my $i = 0; my @digits = split(//, $password); my $pwlength = @digits; for ($i = 0; $i < $pwlength - 1; $i++) { if ($digits[$i] + 1 == $digits[$i + 1]) { $counter += 1; } else { $counter = 0; } if ($counter >= $limit) { exit 1; } } $counter = 0; for ($i = 0; $i < $pwlength - 1; $i++) { if ($digits[$i] - 1 == $digits[$i + 1]) { $counter += 1; } else { $counter = 0; } if ($counter >= $limit) { exit 1; } }
[closed] map sentence as array slice indexes
2 direct replies — Read more / Contribute
by rsFalse
on Nov 25, 2015 at 06:43

    I tried to understand why the following (with map sentence) gives an error. Can't understand.
    use warnings; use strict; @_ = 'a' .. 'c'; print @_[ map $_ -1, grep { $_ > 0 and $_ <= 1 } map { $_ + 1 } -1 .. 1 ];
    Missing comma after first argument to map function at map_inside_splic line 12, near "]"
    And the following (with map block) don't give an error:
    use warnings; use strict; @_ = 'a' .. 'c'; print @_[ map {$_ -1} grep { $_ > 0 and $_ <= 1 } map { $_ + 1 } -1 .. 1 ];
    upd: thanks for answers below.
using Linux getdents syscall
5 direct replies — Read more / Contribute
by glasswalk3r
on Nov 23, 2015 at 18:37

    Hello monks,

    I'm looking for a fast way to list the contents of a directory (with thousands of files) on Linux by using Perl.

    I did some research on that and found a sample C code that uses the getdents system call for that. By using it, one can avoid calling stat on each file inside the directory (basically what ls command does).

    I did some tests with readdir, but performance speed compared to the already mentioned C code as good. That said, I'm inclined to try to use Perl syscall to do the same. Below is the C code (for those inclined to read it):

    This is how the C struct should look like:

    struct linux_dirent { unsigned long d_ino; /* Inode number 32*/ unsigned long d_off; /* Offset to next linux_dirent 32*/ unsigned short d_reclen; /* Length of this linux_dirent 16*/ char d_name[]; /* Filename (null-terminated) */ /* length is actually (d_reclen - 2 - offsetof(struct linux_dirent, d_name)) */ }

    Since I'm not a C programmer, I struggling to achieve that. I found that I need to use unpack to retrieve the information from the related C struct, but I'm lost about:

    • Finding out the lenght I need to setup the Perl equivalent to the buffer (a scalar set with NUL characters, as my $buffer = "\0" x 64;), specially because the related C structure has a char array with dynamic length
    • The buffer will retain a N number of dentries inside of it. How can I find the exactly number of bytes each dentrie has and how can I jump from one entry to the other with Perl?

    Is it even possible to do that without having to use XS (or any of it's alternatives)? I found Convert::Binary::C to give a hand, but probably I'm not using it correctly due the 2 issues above. If I use Data::Dumper on the buffer, I can see the file names, but got only garbage from Convert::Binary::C.

    Here is my (not working) Perl code implementation:


    Alceu Rodrigues de Freitas Junior
    "You have enemies? Good. That means you've stood up for something, sometime in your life." - Sir Winston Churchill
Initialize multiple variables in one statement
5 direct replies — Read more / Contribute
by Anonymous Monk
on Nov 23, 2015 at 13:56
    Hi there Monks!

    Is here a better way to initialize multiple variables in one statement other than this?
    ... my ($name1, $name2, $name3, $name4, $name5, $name6); $name1 = $name2 = $name3 = $name4 = $name5 = $name6 = ''; print "\n $name1, $name2, $name3, $name4, $name5, $name6\n\n"; ...

copy line with character
1 direct reply — Read more / Contribute
by jalopez453
on Nov 23, 2015 at 13:32

    Hello everyone, I am looking for a little help on my code here. I want to copy the lines that have the letter M in the first column but not sure what I am doing wrong or what is missing. I am very new to perl, so I apologize for this very basic request. Thank you in advance for the help

    use strict; my $find = 'M'; open (NEW, ">", "output.txt" ) or die "could not open:$!"; open (FILE, "<", "Report.txt") or die "could not open:$!"; while (<FILE>) { print NEW if (/$find/); } close (FILE); close (NEW);
Problem in creating process
5 direct replies — Read more / Contribute
by ravi45722
on Nov 23, 2015 at 00:42

    I write a code normally and its taking 186 wall clocks to read the total files. To reduce the time I created process and split my load for two process. After creating process its taking 261 wall clock seconds. What's the mistake I am doing?? I think by creating process and running it parallel may reduce the execution time. But its increased. How???

    sub SMSBcastCDR { #doing operation on files } sub SMSCDR { #doing operation on files } LINKS: foreach my $linkarray (1 .. 2) { $pm->start and next LINKS; # do the fork if ($first == 1) { my @cdr_list1 = `ls $cdr_directory/SMSBcastCDR_*_$bcat_cdrdate +\_*.log`; print "cdrs_file1 = @cdr_list1\n"; SMSBcastCDR(@cdr_list1); $first++; } if ($first == 2) { my @smsc_cdr_list=`ls $smscdr_directory/SMSCDR_P*_$cdr +date*.log`; SMSCDR(@smsc_cdr_list); } $pm->finish; # do the exit in the child process } $pm->wait_all_children;
Example of brainfog (Was: inconsistent regex matching)
5 direct replies — Read more / Contribute
by ww
on Nov 21, 2015 at 10:33

    SOLVED. See reply to self below

    There perhaps should be a question mark in the title.

    Caveat: Fri nite & Sat am brainlock? Maybe. But...

    I'm trying to extract from the output of a linkchecker all chunks which report errors. My problem? This minimal test:

    #! /usr/bin/perl -w use strict; use 5.018; # test errmsg match # sample (and partial; see the chunking in the next code) errmsgs from + file: # Result</td><td bgcolor="#db4930">Error: 404....</td> ( or 301 etc.) # Result</td><td bgcolor="#db4930">Error: SSLError: [Errno 1] _ssl.c:5 +04:....</td> my $errmsg = qr[Result</td><td bgcolor=".{7}">Error:.*?(?=</td>)]; my @data_sample = ( '<tr><td bgcolor="#db4930">Result</td><td bgcolor="#db4930">Error: + 404 Not Found</td></tr>', '<tr><td bgcolor="#db4930">Result</td><td bgcolor="#db4930">Error: + SSLError: [Errno 1] _ssl.c:504: error:14090086:SSL routines:SSL3_GET +_SERVER_CERTIFICATE:certificate verify failed</td></tr>', '<tr><td foo bar baz> abcde </td></tr>' ); my $data_line; for $data_line(@data_sample) { if ( $data_line =~ /$errmsg/ ) { say "\t FOUND IT: $data_line \n"; } else { say "\t NO MATCH ON $data_line \n"; } }
        produces the expected results:
    C:\> FOUND IT: <tr><td bgcolor="#db4930">Result</td><td bgcolor="# +db4930">Error: 404 Not Found</td></tr> FOUND IT: <tr><td bgcolor="#db4930">Result</td><td bgcolor="# +db4930">Error: SSLError: [Errno 1] _ssl.c:504: error:14090086:SSL rou +tines:SSL3_GET_SERVER_CERTIFICATE:certificate verify failed</td></tr> NO MATCH ON <tr><td foo bar baz> abcde </td></tr> C:\>

    whereas, the selfsame ( $errmsg ) regex here:

    #!/usr/bin/perl -w use strict; use 5.018; # find linkchecker error reports in html report, linkchecker-out201511 +20.html $/ = '<table align="left" border="0" cellspacing="0" cellpadding="1"'; my ($fh, $item, @erritems); my $trterminator = qr[</tr>\n</table></td></tr></table>]; # errmsg from file: # Result</td><td bgcolor="#db4930">Error: 404....</td> ( or 301 etc.) # Result</td><td bgcolor="#db4930">Error: SSLError: [Errno 1] _ssl.c:5 +04:....</td> my $errmsg = qr[Result</td><td bgcolor=".{7}">Error:.*?(?=</td>)]; my $eot = qr[</small></body></html>]; open ($fh, "<", 'linkchecker-out20151120.html') or die "Can't open, $! +"; while (<$fh> ) { if ( $_ =~ /$eot/ ) { last; } else { $_ = <$fh>; $item = $_; $item =~ s/\n//gs; $item .= "\n\n"; } if ( $item =~ /$errmsg/ ) { push @erritems, $item; } } say "Errors id'ed in LinkChecker output, 'linkchecker-out20151120.html +'\n"; for $_(@erritems) { print $/; say $_; }

        catches the SSL issues BUT FAILS TO OUTPUT THE '404' ERRORS (of which there is exactly one in the linkchecker log!

    Many "print ($var);" debugging items have been removed here, but all point to consistency between the actual file contents and the minimal test above. Thus, contrary to the usual wise advice to include data, I'm omitting it for now, since even individual chucks run to about 0.5KB and even three samples (out of approximately 1000 chunks) would extend this verbose query to "TL,DR" status.

    I'm hoping fresh eyes or greater wisdom will spot what I'm missing.

Net:::SMTP and Attaching a xlsx
2 direct replies — Read more / Contribute
by deg01004
on Nov 20, 2015 at 20:54

    I am trying to send a .xlsx via SMTP. There is content in the email that is sent but i think there is something wrong with the encoding. Whenever i try to open the .xlsx from the email i get the message the file format or file extension is not valid and to verify that it has not bee corrupted.

    I realized that something like mimelite might be easier but i would like to figure out the SMTP route as well.

    Any help would be appreciated

    my $to_email = "xxx\"; our $smtp = Net::SMTP->new("",Debug=>1); $smtp->mail("xxx\"); $smtp->recipient("$to_email"); $smtp->data(); $smtp->datasend("To: $to_email\n"); $smtp->datasend("Cc: xxx\\n"); $smtp->datasend("From: xxx\\n"); $smtp->datasend("Subject: Annual Access Reviews\n"); $smtp->datasend("MIME-Version: 1.0\n"); $smtp->datasend("Content-Type: multipart/mixed; boundary= \"*B +CKTR*\"\n\n"); # Send the body. $smtp->datasend("--*BCKTR*\n"); $smtp->datasend("Content-Type: text/html\n\n"); $smtp->datasend("@$distinct_manager[3], \n\n"); $smtp->datasend("<div><b>As a manager your task at hand</b> is + the following:</div>"); $smtp->datasend("<p>These user access reviews must be complete +d and returned by 12/18/2015 XX.XX.2015(6).</p>"); $smtp->datasend("<p><b>Please email the completed spreadsheets + to emailaddress\</b></p>"); $smtp->datasend("<p><b>Please go to http://some_internal_websi +te on how to upload your completed spreadsheet(s).</b></p>"); $smtp->datasend("<div>Thank You,</div>"); $smtp->datasend("<div>Manager, ISSA Identity and Access Manage +ment</div>"); $smtp->datasend("\n"); $smtp->datasend("--*BCKTR*\n"); $smtp->datasend("Content-Type: application/vnd.openxmlformats- +officedocument.spreadsheetml.sheet; name=\"$attachfile\" \n"); $smtp->datasend("Content-Transfer-Encoding: base64"); $smtp->datasend("Content-Disposition: attachment; filename =\" +$attachfile\"\n\n"); $smtp->datasend("\n"); open(DAT, $attachfile) || die("Could not open text file!"); binmode(DAT); my $data = do { local $/; <DAT> }; close DAT; $smtp->datasend($data); $smtp->datasend("\n"); $smtp->datasend("\n"); $smtp->dataend(); $smtp->quit;
New Meditations
Something that bugs me about the Numeric class hierarchy in Perl 6
1 direct reply — Read more / Contribute
by grondilu
on Nov 24, 2015 at 03:16

    Hello Monks,

    This is something that has bugged some times to times : I have the feeling that the class hierarchy for numeric types in Perl 6 is upside down.

    Let me give you an example. The other day I wrote on rosetta code the following function to compute binomial coefficients:

    sub infix:<choose> { [*] ($^n ... 0) Z/ 1 .. $^p } say 5 choose 3;

    I was quite happy about it, until I realized that the output was of type Rat, not Int. So I had to make an explicit conversion:

    sub infix:<choose> { ([*] ($^n ... 0) Z/ 1 .. $^p).Int }

    That was a bit annoying. Frankly, I expect something like 10/5 to be an integer, not a rational. I mean, I know it is a rational, but it also is an integer. Because normally in math, all integers are rationals. Their denominator is just 1.

    Things don't work like this in Perl 6. Numeric types are more about implementation than mathematics. Yet there is a feature in Perl 6 that could be used to make things work more like in math:

    subset Int of Rat where [%%] *.nude;

    If Int was defined as such, integers would be particular cases of rationals. In the same way, real numbers would be special cases of complex numbers:

    subset Real of Complex where { $_ == .conj };

    An other possibility would be:

    role Int does Rational { method nude { self, 1 }; ... }

    Or something like that, I don't know. Neither do I know if it would be possible or desirable to rewrite the whole Numeric hierarchy. Maybe it would not be worth the effort. But I do find it annoying that an Integer is not a Rat, or a Real not a Complex.

"Indirect" object syntax?
3 direct replies — Read more / Contribute
by muba
on Nov 22, 2015 at 21:30

    Disclaimer: IANAL. I am not a lawyer linguist.

    The syntax of (for example) $cgi = new CGI; is called indirect object syntax, which is also said to be in the dative case. Are these actually the correct designations?

New Cool Uses for Perl
Restarting File::Find
1 direct reply — Read more / Contribute
by Preceptor
on Nov 24, 2015 at 06:44

    One of the problems I've had in the past, is a need to walk a filesystem and 'batch up' files. There's a variety of reasons why - things like archiving, virus scanning, etc. Now, you _could_ do it the heavyweight way - collect a full tree directory structure, batch up that way. This didn't suit my needs - I've a billion ish files to inspect, and they change rather frequently.

    So as a workaround - make use of File::Find and it's ability to prune

    #!/usr/bin/env perl use strict; use warnings; use File::Find; my $start_from = "/path/to/search/some_dir/beneath"; my $count = 10_000; #how many files to grab in this 'batch'; my @file_list; sub finder { if ( defined $start_from and not $found ) { #partial match, walk directory. if ( $start_from =~ m/\QFile::Find::name/ ) { $File::Find::prune = 0; if ( $File::Find::name =~ m/\Q$start_from/ ) { $found = 1; } } else { $File::Find::prune = 1; #don't traverse into this dir } } if ( @file_list > $limit ) { $found = 0; $File::Find::prune = 1; return; } return unless -f $File::Find::name; push ( @file_list, $File::Find::name ); #backtracks a bit to the start of the current directory $start_from = $File::Find::dir; } find ( \&finder, '/path/to/search' ); print "Next start point: $start_from\n";

    Note - as it stands, this has a limiting factor in that it'll misbehaving if the directory structure changes (e.g. $start_from no longer exists. The workaround is chopping path elements off the end until you get to a dir that _does_ exist.

    Probably something like:

    while ( not -d $start_from and $start_from =~ m,/, ) { $start_from =~ s,/[^/]+$,,; }

    (There's probably a better solution using File::Spec or similar)

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 about the Monastery: (9)
As of 2015-11-27 18:30 GMT
Find Nodes?
    Voting Booth?

    What would be the most significant thing to happen if a rope (or wire) tied the Earth and the Moon together?

    Results (731 votes), past polls