Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

The Monastery Gates

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

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

Quests
poll ideas quest 2022
Starts at: Jan 01, 2022 at 00:00
Ends at: Dec 31, 2022 at 23:59
Current Status: Active
6 replies by pollsters
    First, read How do I create a Poll?. Then suggest your poll here. Complete ideas are more likely to be used.

    Note that links may be used in choices but not in the title.

Perl News
Perl advent calendar 2022 is live
on Dec 01, 2022 at 12:01
0 replies by marto
German Perl/Raku Workshop 2023 Call for Presentations
on Nov 30, 2022 at 12:49
0 replies by Corion

    The German Perl/Raku Workshop takes place from February 27 to March 1st 2023 in Frankfurt/Main, Germany.

    We are looking for your contribution in the form a talk (20 minutes or 40 minutes), a lighting talk (5 minutes) or a workshop (2-4 hours). Please submit your proposals using this online form.

    The theme in 2023 is Perl Futures - of course the two developments of Perl, Raku and Perl as well as the reference to the financial metropolis Frankfurt am Main. Presentations with these emphases are especially sought after, but all contributions on Perl, Raku and software development in general are welcome.

    Read the complete Call for Papers

Supplications
Mechanism for ensuring only one instance of a Perl script can only run?
5 direct replies — Read more / Contribute
by redapplesonly
on Dec 02, 2022 at 11:03

    Hola Perl Monks,

    So I have a Perl (v5.30.0) script that is run every five minutes via a crontab on my Ubuntu server. When I first wrote the script, I thought five minutes would be plenty of runtime. But recently, I've discovered that the script may require *more* than five minutes to complete execution. This is a problem.

    Right now, say my script is executed at 12:00. It does reads and writes to disk and to the network. But when the clock strikes 12:05, the script is not finished. It keeps going. But then cron runs a second instance of the script. Now the 12:00 and 12:05 scripts are both reading and writing the same data to disc & network. They complicate each other's work, data is contaminated, and the mess is still getting worse when the 12:10 instance of the script arrives on the scene. Mass hysteria follows.

    So now I need a mechanism where my script basically makes sure there are no other instances of itself running. Pseudocode would be:

    Script starts. Am I the only instance of this code? -- If YES, continue -- If NO, terminate immediately

    This can't be that hard to do. That said, whenever I think about it, I come up with fairly clunky solutions. Below is code which technically works... but is a pretty stupid solution. Basically, the script creates an empty file (I'm calling it a "Marker File") at the start of execution, then deletes it at the end. If another instance of the script starts and sees that file, it realizes that its not alone and terminates.

    This will work... but I kinda superhate it. It takes 20 lines of code to do something that seems pretty basic. Can you recommend a more elegant solution? There's gotta be a way. Thank you.

    My code:

    #!/usr/bin/perl use warnings; use strict; my $MARKER_FILE="/home/me/MARKERFILE"; sub checkMarker { if(-e $MARKER_FILE){ # Marker file already exists, another instance of this + script is running! return undef; # FALSE } else { # Marker file doesn't exist! We should create one... my $cmd = "touch $MARKER_FILE"; `$cmd`; return 1; # TRUE } } package main; if (checkMarker()) { print "I can do stuff!\n"; # ...do stuff... my $endCmd = "rm $MARKER_FILE"; `$endCmd`; } else{ print "Another instance of this script is running, I can't run +...\n"; }
Image modules not returning or accepting GD::Image
4 direct replies — Read more / Contribute
by Bod
on Dec 01, 2022 at 14:24

    At first I thought I had simply found an error in the documentation. But as I seem to have found two related errors in two different modules, I am questioning either my understanding or if I am overlooking something silly.

    I'm trying to put three images side by side into a PDF. As I don't know the dimensions of the images, I am using Image::Resize to set them all to the same height. This bit works fine. Then I am using GD::Tiler to stitch them together into a single image before using PDF::API2 to add the images to the PDF.

    The documentation for GD::Tiler says that it returns a GD::Image object. But it doesn't - it returns an image. PNG by default. I've confirmed this with $test = 1; in the code sample below. I've also looked at the source code which confirms that the documentation is wrong.

    So I've made a new GD::Image object from the PNG as PDF::API2 says that the image method takes a GD::Image object. I have confirmed that we have the right object type using $test = 2; in the code sample below.

    However, when I pass the GD::Image object to $pdf->image I get this error:
    Not a HASH reference at /home/shoples1/perl5/lib/perl5/PDF/API2.pm line 2359

    Here is some test code to demonstrate the problem.

    #!/usr/bin/perl use CGI::Carp qw(fatalsToBrowser); use strict; use warnings; use lib "$ENV{'DOCUMENT_ROOT'}/../lib"; use cPanelUserConfig; use PDF::API2; use GD::Tiler qw(tile); my $test = 0; my $pdf = PDF::API2->open("$ENV{'DOCUMENT_ROOT'}/../data/Consent.pdf" +); my $page = $pdf->open_page(1); my @image = ( "$ENV{'DOCUMENT_ROOT'}/images/admin/dogs/boomer.jpg", "$ENV{'DOCUMENT_ROOT'}/images/admin/dogs/1.jpg", "$ENV{'DOCUMENT_ROOT'}/images/admin/dogs/2.jpg", ); my $gd = tile( Images => \@image, Center => 1, ImagesPerRow => 3, ); # GD::Tiler is returning a PNG not a GD::Image object my $image = GD::Image->new($gd); if ($test == 1) { print "Content-type: image/png\n\n"; print $gd; exit; } if ($test == 2) { use Scalar::Util qw(blessed reftype); print "Content-type: text/plain\n\n"; print blessed($image); # GD::Imaage exit; } my $dogs = $pdf->image($image); # FAILS HERE $page->object($dogs, 1000 - $gd->width / 2, 100, 100); $pdf->save("$ENV{'DOCUMENT_ROOT'}/test.pdf"); print "Location: /test.pdf\n\n"; exit;

    I've tried looking at the source for PDF::API2 but that part is beyond me. The image method works with a filepath but not with a GD::Image. I've not tried using a filehandle.

    Have I found two separate modules with documentation errors around GD::Image or have I missed something obvious here?

Perl AI Modules and Project to Date (Dec 2022)
2 direct replies — Read more / Contribute
by ait
on Dec 01, 2022 at 06:33

    The idea of this question is to gather info about any and all Perl related AI CPAN modules and well known projects to date (even if they seem defunct), and list them all in a placeholder node I've created in Cool Uses for Perl.

    Just answer and discuss on this node and I will summarize on the placeholder.

    TIA!
    --
    Alex

Access and decrypt Chrome cookies on Windows
2 direct replies — Read more / Contribute
by Discipulus
on Nov 30, 2022 at 03:45
    Hello folks,

    Christmas approaches and raises my will to open cookies jars.. :)

    If I just modify the path and the table name in this program to access Chrome 107 cookies ('C:/Users/'.$ENV{UserName}.'/AppData/Local/Google/Chrome/User Data/Default/Network/Cookies'; the path and cookies the table) I get a nice screenful of... encrypted cookies.

    To offer encrypted cookies is against the Halloween trick or treat policy: is both trick and treat in the same time!

    I read here:

    > Since Chrome version 80 and higher, cookies are encrypted using AES-256 in GCM mode. The applied key is encrypted using DPAPI. (...) The encrypted key starts with the ASCII encoding of DPAPI (i.e. 0x4450415049) and is Base64 encoded, i.e. the key must first be Base64 decoded and the first 5 bytes must be removed. Afterwards a decryption with win32crypt.CryptUnprotectData is possible. The decryption returns a tuple whose second value contains the decrypted key:

    From what I understand there is key and this key is used to enrypt the encrypted_value inside the cookies DB. Too much for me..

    So again on metacpan for HTTP::Cookies::Chrome that installs fine under windows. The load_cookies.t sounds promising but fails, because guess_password method is unimplemented for Windows. Meh!

    This perl gist (probably by PerlRob)

    seems to be the solution, calling the native Windows CryptUnprotectData API but fails with Win32::API::Call: parameter 7 had a buffer overflow

    Porting to Perl the code presented here or here and then patching the HTTP::Cookies::Chrome module?

    Why this? I'm not so gluttonous, but I suppose that accessing a real cookie is key point in web automation: if I'm able to present the right session cookie my program is me.

    Thanks for reading!

    L*

    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
Malformed UTF-8 character
3 direct replies — Read more / Contribute
by BillKSmith
on Nov 29, 2022 at 15:53
    I know that this question is slightly off-topic, but still seems relevant. I am unable to download and run 1nickt's solution Re: Regex: matching any Number then a hyphen to a recent question because of a single non-ascii character. While displaying the node in the browser 'Chrome' on Windows 7, I click on the 'download' button. The file displays correctly. I right-click and select 'save as' then save as I.pl. When I run the file, I get the following error:
    C:\Users\Bill\forums\monks>perl I.pl 1..3 Malformed UTF-8 character: \x96 (unexpected continuation byte 0x96, wi +th no prec eding start byte) at I.pl line 9. Malformed UTF-8 character (fatal) at I.pl line 9.
    Using Internet explorer is slightly different, but no better. I have also tried cut-and-paste into the editor 'gvim'. It does not even display correctly. No luck saving it to a file. What is the recommended way to download and edit files containing UTF-8 characters from perlmonks into windows?

    Sorry if I have overlooked the tutorial that I need.

    Bill
DBI DBD::SQLite unable to open Firefox cookies.sqlite database
3 direct replies — Read more / Contribute
by Discipulus
on Nov 29, 2022 at 06:39
    Hello,

    inspired by Using LWP (or some other module) to Dowload HTML with Cookie Session ID I tried to unlock the cookies case of Firefox using perl. I have installed DBD::SQLite but the following code fails to open the DB even if Firefox is closed or if try the readonly flag.

    I also tried to make a copy of the DB cookiesTEST.sqlite in the case some lock was there.. but nothing but failures.

    use strict; use warnings; use Data::Dumper; use DBI; use DBD::SQLite; my $db = $ENV{AppData}.'\Mozilla\Firefox\Profiles\nwk2oixj.default-rel +ease\cookiesTEST.sqlite'; die "DB file not found!" unless -e $db; print "sqlite DBD version: $DBD::SQLite::sqlite_version\n"; my $dbh = DBI->connect(qq(dbi:SQLite:dbname=$db,'','',{ sqlite_open_flags => SQLITE_OPEN_READONLY, PrintError => 1, RaiseError => 1, })) or die $DBI::errstr; my $sth = $dbh->prepare(q(SELECT * FROM moz_cookies )); print Dumper $sth->fetchall_arrayref({}); __END__ sqlite DBD version: 3.39.4 DBI connect('dbname=C:\Users\ME\AppData\Roaming\Mozilla\Firefox\Profil +es\nwk2oixj.default-release\cookiesTEST.sqlite,'','',{ sqlite_open_flags => SQLITE_OPEN_REA +DONLY, PrintError => 1, RaiseError => 1, }','',...) failed: unable to open dat +abase file at firefox-cookies.pl line 11. unable to open database file at firefox-cookies.pl line 11.

    With FF open both DBeaver and sqlite3 command line utility can access the DB without problem. DBeaver uses jdbc:sqlite driver and sqlite> .version shows SQLite 3.40.0 2022-11-16 12:10:08 so not the 3.39.4 shown by DBD.

    I have no sqlite in the path.

    Searching I found HTTP::Cookies::Mozilla and I installed it: it comes with a stringy documentation ( yes! adopt it ;) but, lurking in /examples I have found /examples/convert-to-mojo.pl that slightly modified to work on windows (around line 19 my @cookies_files = glob(     $ENV{AppData}.'\Mozilla\Firefox\Profiles\*\cookies.sqlite'); ) accesses the db without any issue.

    The module documentation ( scan method not even mentioned ;) says explicitly:

    > .. so you will need to have either DBI/DBD::SQLite, or the sqlite3 executable somewhere in the path.

    Since I have not sqlite in the path, it should use the very same driver used by my failing script, ie: DBD::SQLite

    So why the above code fails?

    L*

    PS ..and now crack the Chrome cookies jar

    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
Meditations
Rosetta Code: Long List is Long
6 direct replies — Read more / Contribute
by eyepopslikeamosquito
on Nov 30, 2022 at 17:27

    I've long found it fun to implement the same algorithm in different languages, especially Perl and C++ ... and then sit back and reflect on the lessons learned ... so when Long list is long appeared recently, I felt it was short and interesting enough to make an excellent Rosetta code node.

    Solutions to this problem must read a number of input LLiL-format files (given as command line arguments) and write a single merged LLiL-format file to stdout. The LLiL-format is described in the comments at the top of llil.pl below.

    In the interests of keeping the code as short and fast as possible, you may assume the input LLiL files are well-formed. For example, you don't need to check for and remove leading and trailing whitespace on each line. The sample solutions given below in Perl and C++ should clarify program requirements.

    Please feel free to respond away with solutions to this problem in your favourite programming language and to offer suggested improvements to my sample Perl and C++ solutions below.

    Perl Solution

    Here's my Perl solution, heavily influenced by responses to Long list is long, especially kcott's concise and clear solution:

    # llil.pl # Example run: perl llil.pl tt1.txt tt2.txt >oo1.tmp use strict; use warnings; # -------------------------------------------------------------------- +-- # LLiL specification # ------------------ # A LLiL-format file is a text file. # Each line consists of a lowercase name a TAB character and a non-neg +ative integer count. # That is, each line must match : ^[a-z]+\t\d+$ # For example, reading the LLiL-format files, tt1.txt containing: # camel\t42 # pearl\t94 # dromedary\t69 # and tt2.txt containing: # camel\t8 # hello\t12345 # dromedary\t1 # returns this hashref: # $hash_ret{"camel"} = 50 # $hash_ret{"dromedary"} = 70 # $hash_ret{"hello"} = 12345 # $hash_ret{"pearl"} = 94 # That is, values are added for items with the same key. # # To get the required LLiL text, you must sort the returned hashref # descending by value and insert a TAB separator: # hello\t12345 # pearl\t94 # dromedary\t70 # camel\t50 # To make testing via diff easier, we further sort ascending by name # for lines with the same value. # -------------------------------------------------------------------- +-- # Function get_properties # Read a list of LLiL-format files # Return a reference to a hash of properties sub get_properties { my $files = shift; # in: reference to a list of LLiL-format fil +es my %hash_ret; # out: reference to a hash of properties for my $fname ( @{$files} ) { open( my $fh, '<', $fname ) or die "error: open '$fname': $!"; while (<$fh>) { chomp; my ($word, $count) = split /\t/; $hash_ret{$word} += $count; } close($fh) or die "error: close '$fname': $!"; } return \%hash_ret; } # ----------------- mainline ----------------------------------------- +-- @ARGV or die "usage: $0 file...\n"; my @llil_files = @ARGV; warn "llil start\n"; my $tstart1 = time; my $href = get_properties( \@llil_files ); my $tend1 = time; my $taken1 = $tend1 - $tstart1; warn "get_properties : $taken1 secs\n"; my $tstart2 = time; for my $key ( sort { $href->{$b} <=> $href->{$a} || $a cmp $b } keys % +{$href} ) { print "$key\t$href->{$key}\n"; } my $tend2 = time; my $taken2 = $tend2 - $tstart2; my $taken = $tend2 - $tstart1; warn "sort + output : $taken2 secs\n"; warn "total : $taken secs\n";

    What makes this problem interesting to me is the requirement to sort the hash in descending order by value:

    sort { $href->{$b} <=> $href->{$a} || $a cmp $b } keys %{$href}
    because the performance of such a sort may suffer when dealing with huge files (after all, performance was the reason for the OP's question in the first place).

    I'm hoping solving this problem in multiple languages will be fun and instructive -- and perhaps give us insight into how performance changes as the number of items increases.

PerlMonks Discussions
Recently Active Threads: limited maximum node depth
2 direct replies — Read more / Contribute
by kcott
on Nov 27, 2022 at 17:24

    G'day All,

    This morning, I saw in "Best Nodes" a link to "Re^12: Perl XS binding to a struct with an array of chars*". I looked in RAT to get an idea of the activity in this thread: there were a number at "Re^9" but nothing deeper. I went to the Page Settings (bottom of the RAT page) to change the maximum depth but the selection only provides 0-10.

    Scrolling through (the very long) "Perl XS binding to a struct with an array of chars*", I found a couple at "Re^10" as well as the "Re^12" (from Best Nodes). So, I haven't lost access to any content; however, it would've been preferable to get a high-level view via RAT.

    Can that "maximum depth" selection be extended? I don't know if there are other factors involved, so I don't know what to suggest beyond arbitrary ranges such as 0-20 or 0-99. Alternatively, could there be a "no depth limit" checkbox? I imagine a text entry box would be another option, but I suspect that might require a fair bit of validation and other work which pmdev's may not want to undertake (although, I'm very much guessing about that).

    — Ken

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (3)
As of 2022-12-03 02:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?