Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Meditations

( [id://480]=superdoc: print w/replies, xml ) Need Help??

If you've discovered something amazing about Perl that you just need to share with everyone, this is the right place.

This section is also used for non-question discussions about Perl, and for any discussions that are not specifically programming related. For example, if you want to share or discuss opinions on hacker culture, the job market, or Perl 6 development, this is the place. (Note, however, that discussions about the PerlMonks web site belong in PerlMonks Discussion.)

Meditations is sometimes used as a sounding-board — a place to post initial drafts of perl tutorials, code modules, book reviews, articles, quizzes, etc. — so that the author can benefit from the collective insight of the monks before publishing the finished item to its proper place (be it Tutorials, Cool Uses for Perl, Reviews, or whatever). If you do this, it is generally considered appropriate to prefix your node title with "RFC:" (for "request for comments").

User Meditations
Another "code of conduct" idea, from Stonekettle Station
1 direct reply — Read more / Contribute
by jdporter
on Feb 04, 2025 at 12:19
    From Stonekettle Station, i.e. Jim Wright:
    First thing: before you comment, read the rules. They're pinned at the top of the forum. If you need help finding them, ask, someone will point you to the right place. Read the rules. All of them. I made them funny, but I mean every word. This isn't Twitter. This isn't 4-chan. Don't act like it is.

    Wheaton Rules: Don't be a dick.

    You are adults, I will treat you that way, meaning you are responsible for adhering to the rules, behaving yourself, and being respectful, considerate, and decent to each other. You get one chance. You violate the rules, out you go and you're blocked from all of my feeds. If you want to be here, act like it.

    I know how this sounds, I do. But I'm riding herd on 60,000 opinionated people and I'm neither patient nor pathologically capable of suffering fools, gladly or otherwise.

    Read the rules. Welcome aboard. I'm glad you're here.

    Of course, such a CoC could not be adopted here, because his "forum" is a one-man show.

    Note: by "Wheaton Rules", he means Wheaton's Law.


    In case you're curious, here are his actual group guidelines, i.e. forum rules:

    1. You don't have to agree, with me or each other.
      1. However, it should be noted that I am pathologically incapable of suffering fools, gladly or otherwise.
      2. Proceed at your own risk.
        1. If you're disagreeing because you are pathologically incapable of agreeing even with posts that you actually agree with, you're likely to get on my nerves in short order.
        2. If you're disagreeing because you think you've been appointed this group's moral conscience, you're likely to get on my nerves in short order.
        3. If your comment contains the phrase "be better" or the word "gross", you have already gotten on my nerves.
        4. See Rule 1.1.
    2. When you disagree, with me or each other, do it in a civilized manner.
      1. Regard rational disagreement as a challenge. Points will be awarded for style, accuracy, politeness, and measured delivery.
      2. Should disagreement become heated to the point of {insults, the hurling of curses and hexes, fisticuffs, dueling, murder, and so on}, disengage immediately.
      3. Never insult a man's mustache or his hat. (And never ever compliment a woman's mustache, no matter how spectacular).
    3. Try to err on the side of not being a jerk.
      1. Everybody acts like a jerk once in a while, me included. When that happens and it's pointed out that you're doing it, stop doing it.
      2. When you've acted like a jerk, me included, apologies go a long way.
      3. If you don't know how to apologize, post a cat picture.
    4. Don’ts: No racism. No sexism. No homophobia. No transphobia. No stalking. No harassing. No proselytizing (this includes Mac users and Vegans). No anti-Semitism. No Islamaphobia. No passive aggression. No spam. No tattling. No smoking. No ellipsis used as a period (use a period, dammit). No chewing with your mouth open. And most important: left lane fast, right lane slow.
      1. Strongly suggested: Please don’t use "tard". Try to avoid logical fallacies. Don’t use "begs the question" incorrectly, because then I have to educate you, and your feelings will be hurt, and then we’ll have to practice #3 and I don’t want to have to apologize. Try to avoid wild ass unsupported by fact and/or science conspiracy theories. If you’re a {flat earther, anti-vaxxer, young earth creationist, moon landing denier, somebody who thinks tofu is food, etc.}, please keep that shit to yourself.
    5. If I didn’t post about {whatever crazy thing is happening}, don’t try to change the current topic to {whatever crazy thing is happening}. I’ll get to it. Maybe.
    6. I tend to profanity.
      1. I’m genetically predisposed to profanity (my dad was a Sailor too).
      2. I’ve had professional training in profanity.
      3. I’m saying I tend in the direction of profanity. If that’s going to be a problem for you, exit the ride now.
    7. No. I’m not accepting group admins or moderators at this time.
      1. Really.
    8. If you're doing something and I ask you to stop doing it, stop doing it.
      1. If I'm feeling generous, you might get one warning. Then it's the airlock.
      2. I rarely feel generous.
      3. If you're going to get yourself airlocked, try not to do it over something stupid and trivial. Make it count and don't forget we'll be mocking you for days afterward. Please try to provide the group with sufficient material.
    9. I can be bribed with good whiskey, good coffee, chocolate of any kind, and money.
      1. Mostly money.
      2. Please don't offer sex. I'm full up.
    10. If there’s a problem, message me.
      1. Preferably before it’s a problem.
      2. Don’t message me just because you need attention. If you need validation, get a dog.
    11. Wash your fucking hands.
    Some of these are reasonable and broadly applicable.
Overloading tr/// operands
2 direct replies — Read more / Contribute
by jo37
on Jan 27, 2025 at 07:35

    Dear Nuns and Monks,

    while playing with tr/// inside a string eval, I came across a strange feature in overload: It is possible to overload the arguments of a tr/// operator.

    This feature can be used to have variable operands in tr/// without eval'ing them.

    Here is a module (kind of) that overloads the arguments of tr///. If any of these starts with a $, it is taken as
    a symbolic reference to an (unqualified) package variable
    an identifier of a lexical scoped variable
    that will act as the operand instead. A string eval is still required to compile the expression at runtime but in this case on a constant string that is not prone to code injection. It is even possible to have tr's delimiter inside the the referenced values.

    What is your opinion on this? Is it secure? Is it useful?

    Update: Incorporated ikegami's advice.

    #!/usr/bin/perl -T package Syntax::Tr::Ref; use v5.26; use warnings; use overload; use Carp; use PadWalker qw(peek_my peek_our); use experimental 'signatures'; sub ovl_tr ($,$str,$context) { # pass everything unmodified that is not an operand of tr/// return $str unless $context eq 'tr'; # <original> ## get symbol table entry name #my ($name) = $str =~ /^\$(.*)/; ## pass regular operands #return $str unless defined $name; ## dereference the name #my $caller = caller(1); #no strict 'refs'; #my $ret = ${"${caller}::$name"}; # </original> # <update> # pass regular operands return $str unless $str =~ /^\$/; # search for a variable named $str defined as "my" or "our" in the # caller my $my = peek_my(1); my $our = peek_our(1); my $ret = exists $my->{$str} ? $my->{$str}->$* : exists $our->{$str} ? $our->{$str}->$* : undef; # </update> # illegal argument croak qq(symbolic reference "\$${caller}::$name" not found) unless defined $ret; $ret; } sub import { overload::constant q => \&ovl_tr; } sub unimport { overload::remove_constant q => \&ovl_tr; } 1; package Foo; use v5.26; use warnings; use Carp::Always; # emulate "use Syntax::Tr::Ref;" BEGIN { Syntax::Tr::Ref->import; } # create a tainted empty string my $tainted = substr $ENV{PATH}, 0, 0; # a "bad" searchlist: tainted and contains the tr///-delimiter # <original> ## must be an alias to a package variable #local our $abc = '%/cde' . $tainted; # </original> # <update> my $abc = '%/cde' . $tainted; # </update> # the tr/// subject my $s = '%abcde/'; # eval on fixed string at runtime # almost equivalent to tr{%/cde}{@|fgh} eval 'tr/$abc/@|fgh/; 1' or warn $@ for $s; say $s; __DATA__ @abfgh|

    Greetings,
    🐻

    $gryYup$d0ylprbpriprrYpkJl2xyl~rzg??P~5lp2hyl0p$
Module of the day: Music::AirGuitar
No replies — Read more | Post response
by karlgoethebier
on Jan 20, 2025 at 12:09
$sum += $_ ** 3 for 1..9
2 direct replies — Read more / Contribute
by LanX
on Dec 31, 2024 at 08:14

    say "Happy new year $sum!!! :)"

    Best obfuscated wishes! ;)
    - Rolf
    (addicted to the Perl Programming Language :)
    see Wikisyntax for the Monastery

Using the writeup and gdb to find mistakes
1 direct reply — Read more / Contribute
by Aldebaran
on Dec 17, 2024 at 20:09
    using perl to pull values and files out of virtual spaces

    Hello Monks,

    I've been using the testing harness of perl to run a download and watermark script, and I've had quite a bit of success with it in testing. As I enter the monastery, I'm getting some false results that I want to explore using perl.

    I got back to the literature and used Module::Starter, and now have something that could count as a distro. It's passed 12 rounds of testing, but I've made a big mistake because I backed off of stat'ing the file as an ultimate test of a success. Let me just start with perl as I present Frobnitz.pm:

    package Acme::Frobnitz; use strict; use warnings; use IPC::System::Simple qw(capturex); use Cwd qw(abs_path); use File::Spec; use File::stat; use File::Basename; use FindBin; use POSIX qw(strftime); our $VERSION = '0.03';

    That stack of modules just makes me happy to look at, like an xmas tree. And already version 3! IPC::System::Simple is a good choice for a grown-up's version of system() according to haukex's canonical treatment.

    The methods wrap calls to bash:

    sub new { my ($class) = @_; return bless {}, $class; } sub _get_script_path { my ($class, $script_name) = @_; # Resolve base directory dynamical +ly my $base_dir = abs_path("$FindBin::Bin/.."); # One level up from b +in my $script_path = File::Spec->catfile($base_dir, 'bin', $script_na +me); unless (-x $script_path) { die "Script $script_path does not exist or is not executable.\ +n"; } return $script_path; } sub download { my ($class, $hyperlink) = @_; die "No hyperlink provided.\n" unless $hyperlink; my $script_path = $class->_get_script_path("call_download.sh"); my $output; eval { $output = capturex("bash", $script_path, $hyperlink); }; if ($@) { die "Error executing $script_path with hyperlink $hyperlink: $ +@\n"; } return $output; }

    I've been jammed up with version control, because I've been unable to reconstitute my gitlab circumstances (totally my fault). I take snapshots with

    tar -czvf Acme-Frobnitz-Snapshot.tar.gz Acme-Frobnitz-Snapshot

    They mostly look the same, but I port them back and forth from my mini-mac to a linux machine, with an obligatory-named usb as download target. That happens in the bash part. There's also the docker part and a python part. Much of this source deals with calling one from the other and returning values as well as files. I've wanted perl to "pull the cart" for the whole process, so that I could subject it to testing. LanX rightly laments the dearth of this in contemporaneous culture.

    I haven't revealed my screw-up yet...this isn't easy...

    I thought I passed the 12th round of testing but later came to realize I was firing blanks as to whether files ended up on the usb drive, and it brings me to a weird moment in testing, where I can use perl to figure out why...

    Here's the new perl caller...this is what is "pulling the cart," whatever that means...

    use strict; use warnings; use Acme::Frobnitz; my $frobnitz = Acme::Frobnitz->new(); # URL of the video to download my $video_url = "https://www.instagram.com/p/DDa_FxsNtTe/"; # Step 1: Download the video my $downloaded_file = $frobnitz->download($video_url); print "Downloaded video to: $downloaded_file\n"; # Step 2: Verify the downloaded file print "Verifying downloaded file...\n"; if ($frobnitz->verify_file($downloaded_file)) { print "File verification successful.\n"; } else { die "File verification failed. Aborting further processing.\n"; } # Step 3: Add watermark to the downloaded video my $final_file = $frobnitz->add_watermark($downloaded_file); print "Final watermarked video is at: $final_file\n";

    I want to make a pure perl test here and use perl to figure out my privileges, and I'm using this. You should note that this is untested software from chatgpt today:

    sub verify_file { my ($class, $file_path) = @_; die "File path not provided.\n" unless $file_path; my $abs_path = abs_path($file_path) // $file_path; if (-e $abs_path) { print "File exists: $abs_path\n"; # File size my $size = -s $abs_path; print "File size: $size bytes\n"; # File permissions my $permissions = sprintf "%04o", (stat($abs_path)->mode & 077 +77); print "File permissions: $permissions\n"; # Last modified time my $mtime = stat($abs_path)->mtime; print "Last modified: ", strftime("%Y-%m-%d %H:%M:%S", localti +me($mtime)), "\n"; # Owner and group my $uid = stat($abs_path)->uid; my $gid = stat($abs_path)->gid; print "Owner UID: $uid, Group GID: $gid\n"; return 1; # Verification success } else { print "File does not exist: $abs_path\n"; my $dir = dirname($abs_path); # Report directory details print "Inspecting directory: $dir\n"; opendir my $dh, $dir or die "Cannot open directory $dir: $!\n" +; my @files = readdir $dh; closedir $dh; print "Directory contents:\n"; foreach my $file (@files) { next if $file =~ /^\.\.?\$/; # Skip . and .. my $file_abs = File::Spec->catfile($dir, $file); my $type = -d $file_abs ? 'DIR ' : 'FILE'; my $size = -s $file_abs // 'N/A'; print "$type - $file (Size: $size bytes)\n"; } return 0; # Verification failed } }
    Adding a new method:

    Ok, let's use the toolchain.

    (base) fritz@laptop:~/Desktop/Acme-Frobnitz-Snapshot$ ls Acme-Frobnitz-Snapshot.tar.gz Dockerfile Makefile MYMETA.yml + xt bin ignore.txt Makefile.PL README Changes lib MANIFEST requirements.t +xt conf logs MYMETA.json t (base) fritz@laptop:~/Desktop/Acme-Frobnitz-Snapshot$ perl Makefile.PL WARNING: Setting ABSTRACT via file 'lib/Acme/Frobnitz.pm' failed at /usr/share/perl/5.30/ExtUtils/MakeMaker.pm line 754. ...Q1) Why do I get this warning? Generating a Unix-style Makefile Writing Makefile for Acme::Frobnitz Writing MYMETA.yml and MYMETA.json (base) fritz@laptop:~/Desktop/Acme-Frobnitz-Snapshot$ make cp lib/Acme/._Frobnitz.pm.bak blib/lib/Acme/._Frobnitz.pm.bak cp lib/python_utils/watermarker2.py blib/lib/python_utils/watermarker2 +.py cp lib/python_utils/__pycache__/watermarker2.cpython-39.pyc blib/lib/p +ython_utils/__pycache__/watermarker2.cpython-39.pyc cp lib/python_utils/__pycache__/watermarker2.cpython-313.pyc blib/lib/ +python_utils/__pycache__/watermarker2.cpython-313.pyc ...^^^I see all these little barnacle files now... ...in 3 lines we cross into python logging... t/00-load.t ....... 1/? # Testing Acme::Frobnitz 0.03, Perl 5.030000, +/usr/bin/perl t/00-load.t ....... ok t/13.download.t ... 1/? 2024-12-17 06:28:26,320 - __main__ - INFO - At +tempting to create directory: E4B0-3FC22024-12-17/ 2024-12-17 06:28:26,320 - __main__ - INFO - Directory created or alrea +dy exists: E4B0-3FC22024-12-17/ 2024-12-17 06:28:26,321 - __main__ - INFO - Entering function: mask_me +tadata 2024-12-17 06:28:26,321 - downloader5 - INFO - Masking metadata 2024-12-17 06:28:26,321 - downloader5 - INFO - Received parameters for + metadata extraction: 2024-12-17 06:28:26,322 - downloader5 - INFO - download_path: E4B0-3FC +22024-12-17/ ...oh damn, that's the problem right there........................^^^^ +^^^^^^
    The python part

    Good heck. The progress I make with this is a function of effective logging. Continuing on STDOUT:

    2024-12-17 06:28:36,493 - __main__ - INFO - Entering function: create_ +original_filename 2024-12-17 06:28:36,494 - downloader5 - INFO - Generated original file +name: E4B0-3FC22024-12-17/Rick_Astley_20091025.webm 2024-12-17 06:28:36,494 - __main__ - INFO - Entering function: downloa +d_video 2024-12-17 06:28:36,494 - downloader5 - INFO - Received parameters: do +wnload_video: 2024-12-17 06:28:36,494 - downloader5 - INFO - download_path: E4B0-3FC +22024-12-17/ ... again oop +s^^^ ..... 2024-12-17 06:28:36,496 - downloader5 - INFO - video_title: Rick_Astle +y_-_Never_Gonna_Give_You_Up_(Official_Music_Video) 2024-12-17 06:28:36,496 - downloader5 - INFO - video_date: 20091025 ...but here's the false positive: 2024-12-17 06:29:22,739 - downloader5 - INFO - Video download complete +d. 2024-12-17 06:29:22,742 - downloader5 - INFO - Download completed in 4 +6.24 seconds ...this part is one of my favorites: 2024-12-17 06:29:22,742 - __main__ - INFO - Entering function: store_p +arams_as_json 2024-12-17 06:29:22,743 - utilities1 - INFO - Params saved to JSON fil +e: E4B0-3FC22024-12-17/Rick_Astley_20091025.json 2024-12-17 06:29:22,743 - __main__ - INFO - Returning original filenam +e: E4B0-3FC22024-12-17/Rick_Astley_20091025.webm t/13.download.t ... ok ...should have failed... Result: PASS (base) fritz@laptop:~/Desktop/Acme-Frobnitz-Snapshot$ sudo make instal +l [sudo] password for fritz: Installing /usr/local/share/perl/5.30.0/Acme/Frobnitz.pm ...
    The Debugger

    Let's fire up the debugger, woohoo! This is why I can never leave perl:

    (base) fritz@laptop:~/Desktop/Acme-Frobnitz-Snapshot$ perl -d bin/3.d +river.pl Loading DB routines from perl5db.pl version 1.55 Editor support available. Enter h or 'h h' for help, or 'man perldebug' for more help. main::(bin/3.driver.pl:5): my $frobnitz = Acme::Frobnitz->new(); DB<1>

    Scout it out once with c, then set a break:

    DB<1> R + Warning: some settings and command-line options may be lost! Loading DB routines from perl5db.pl version 1.55 Editor support available. Enter h or 'h h' for help, or 'man perldebug' for more help. main::(bin/3.driver.pl:5): my $frobnitz = Acme::Frobnitz->new(); DB<0> b 16 + DB<1>

    Get in there...

    2024-12-17 07:10:09,829 - downloader5 - INFO - Video download complete +d. 2024-12-17 07:10:09,832 - downloader5 - INFO - Download completed in 9 +.76 seconds 2024-12-17 07:10:09,832 - __main__ - INFO - Entering function: store_p +arams_as_json ... Verifying downloaded file... main::(bin/3.driver.pl:16): if ($frobnitz->verify_file($downloaded_ +file)) { DB<1> s + Acme::Frobnitz::verify_file(/usr/local/share/perl/5.30.0/Acme/Frobnitz +.pm:65): 65: my ($class, $file_path) = @_; DB<1> v + 62 } 63 64 sub verify_file { 65==> my ($class, $file_path) = @_; 66: die "File path not provided.\n" unless $file_path; 67 68: my $abs_path = abs_path($file_path) // $file_path; 69 70: if (-e $abs_path) { 71: print "File exists: $abs_path\n"; DB<1> s + Acme::Frobnitz::verify_file(/usr/local/share/perl/5.30.0/Acme/Frobnitz +.pm:66): 66: die "File path not provided.\n" unless $file_path; DB<1> s + Acme::Frobnitz::verify_file(/usr/local/share/perl/5.30.0/Acme/Frobnitz +.pm:68): 68: my $abs_path = abs_path($file_path) // $file_path; DB<1> s + Acme::Frobnitz::verify_file(/usr/local/share/perl/5.30.0/Acme/Frobnitz +.pm:70): 70: if (-e $abs_path) { DB<1> s + Unsuccessful stat on filename containing newline at /usr/local/share/p +erl/5.30.0/Acme/Frobnitz.pm line 70. at /usr/local/share/perl/5.30.0/Acme/Frobnitz.pm line 70. Acme::Frobnitz::verify_file(Acme::Frobnitz=HASH(0x5653a1900ad8), " +2024-12-17 00:09:54 - Detected OS: Linux\x{a}2024-12-17 00:09:54 "... +) called at bin/3.driver.pl line 16 Acme::Frobnitz::verify_file(/usr/local/share/perl/5.30.0/Acme/Frobnitz +.pm:92): 92: print "File does not exist: $abs_path\n"; DB<1> p $abs_path + 2024-12-17 00:09:54 - Detected OS: Linux 2024-12-17 00:09:54 - Ensuring Docker is running... 2024-12-17 00:09:54 - Docker is already running. 2024-12-17 00:09:54 - Loading configuration from /home/fritz/Desktop/A +cme-Frobnitz-Snapshot/bin/../conf/app_config.json... 2024-12-17 00:09:54 - Target USB mount name from config: E4B0-3FC2 2024-12-17 00:09:54 - Detected USB mount point: /media/fritz/E4B0-3FC2 2024-12-17 00:09:54 - Attempting to create directory: /media/fritz/E4B +0-3FC2/2024-12-17/ 2024-12-17 00:09:54 - Directory created or already exists: /media/frit +z/E4B0-3FC2/2024-12-17/ 2024-12-17 00:09:54 - Docker image 'my_dl:latest' found. 2024-12-17 00:09:54 - Running Docker with the specified volume and con +fig path... 2024-12-17 00:10:13 - File validation successful: [Instagram] Extracti +ng URL: https://www.instagram.com/p/DDa_FxsNtTe/ Adding lib_path to sys.path: /app/bin/../lib/python_utils [Instagram] DDa_FxsNtTe: Setting up session [Instagram] DDa_FxsNtTe: Downloading JSON metadata [Instagram] Extracting URL: https://www.instagram.com/p/DDa_FxsNtTe/ [Instagram] DDa_FxsNtTe: Setting up session [Instagram] DDa_FxsNtTe: Downloading JSON metadata [info] DDa_FxsNtTe: Downloading 1 format(s): dash-560108753314303v+das +h-1118756702933936ad [download] Destination: E4B0-3FC2/2024-12-17/Tim_Ballard_20241211.fdas +h-560108753314303v.mp4 [download] 100% of 37.69MiB in 00:00:07 at 5.24MiB/s:00 [download] Destination: E4B0-3FC2/2024-12-17/Tim_Ballard_20241211.fdas +h-1118756702933936ad.m4a [download] 100% of 1.14MiB in 00:00:00 at 2.32MiB/s:00 [Merger] Merging formats into "E4B0-3FC2/2024-12-17/Tim_Ballard_202412 +11.mp4" Deleting original file E4B0-3FC2/2024-12-17/Tim_Ballard_20241211.fdash +-1118756702933936ad.m4a (pass -k to keep) Deleting original file E4B0-3FC2/2024-12-17/Tim_Ballard_20241211.fdash +-560108753314303v.mp4 (pass -k to keep) E4B0-3FC2/2024-12-17/Tim_Ballard_20241211.mp4 DB<2>

    Q3) What the damn heck is that?

    Alright, well I found enough things wrong in there to need to go back and fix. It's funny how you find stuff during the writeup. Without a githost I don't have a means to provide an SSCCE without violating the first S.

    For creating the virtual environment with some diagnostics, I've been using this Dockerfile, which has a nice amount of tread on it:

    # Start with a base image FROM python:3.10-slim # Set PYTHONPATH to include the python_utils directory ENV PYTHONPATH="/app/lib/python_utils:/app/lib" # Update apt repository and install necessary dependencies, including +ffmpeg RUN apt-get update && \ apt-get install -y --no-install-recommends \ ffmpeg \ python3 \ python3-pip && \ apt-get clean && \ rm -rf /var/lib/apt/lists/* # Set the working directory WORKDIR /app # Copy all files into the Docker image COPY bin /app/bin COPY lib /app/lib COPY conf /app/conf COPY requirements.txt /app/requirements.txt COPY Dockerfile /app/Dockerfile # Install Python dependencies RUN pip3 install --upgrade pip && pip3 install -r requirements.txt --r +oot-user-action=ignore # Debug: List all files in /app and verify the content of lib/python_u +tils RUN ls -la /app && ls -la /app/lib && ls -la /app/lib/python_utils # Debug: Verify requirements.txt is in the container RUN cat /app/requirements.txt # Debug: Verify Python environment and MoviePy installation RUN python3 -c "import sys; print(sys.version)" RUN python3 -c "import site; print(site.getsitepackages())" RUN python3 -c "import moviepy; print('MoviePy is correctly installed' +)"

    The image is minimal. Execution is done from within bash:

    original_filename=$(docker run --rm \ -e PYTHONPATH="/app/lib/python_utils:/app/lib" \ -v "$Config_Path":/app/conf/app_config.json \ -v "$usb_mount_point":"$usb_mount_point" \ my_dl python3 /app/bin/call_download.py "$1")

    Docker isn't the easiest thing to get values out of, and this worked. Glad for any critical comments about the code. I gotta figure out how I threw a monkey wrench into what used to work, and I don't find that wrench without gdb. I'm not aware of a python equivalent.

    May your solstice be filled with perl

23 years, and an old dog learning new tricks
1 direct reply — Read more / Contribute
by talexb
on Dec 12, 2024 at 19:42

    It's that day again, my Monk Day. I'm up to 23 years on this site. Cool!

    I had an idea recently that I wanted to scan the log files on the server I run to catch information about the life-cycle of customer tickets. I've written various scripts that run under crontab to create and to update a Freshdesk ticket.

    As each of the scripts run, it uses the very handy Log::Log4perl module to log stuff, and they end up in log files which get rotated (so foo.log becomes foo.log.1) automatically. How big the files are, and how many backups you have are all configurable, of course. The logs contain lines like

    2024/12/06 06:11:03 INFO : Create FD ticket 427993 for order 663363 .. + OK
    for ticket creation, and
    Update ticket 413229 to add invoice 802924 tag .. OK
    (The OK at the end is just the result from the API call.) So I could set up a regexp that would do the usual capture, then add a list of terms that I should expect, then copy each capture to the variable named in the list .. but something was telling me there was a cool feature in Perl that I could use. All of those presentations from YAPC::NA and TPRC were prodding my long-term memory.

    Of course! Named captures! (I wrote about this in Perl's hidden depths). I happily got the code working, and proudly pasted my clever solution here. And I got some feedback about how I could simplify my code. And then simplify it some more .. wow.

    Clearly, I am *still* learning Perl, after 25+ years. That's how deep the language is, and that's how generous the Perl community is with sharing its knowledge.

    "Nobody uses Perl anymore!!" Yeah, well, they should. it's an awesome language.

    Alex / talexb / Toronto

    For a long time, I had a link in my .sig going to Groklaw. I heard that as of December 2024, this link is dead. Still, thanks to PJ for all your work, we owe you so much. RIP Groklaw -- 2003 to 2013.

A cpanfile polyglot - for setting up Perl on Termux
2 direct replies — Read more / Contribute
by Corion
on Dec 05, 2024 at 13:59

    Recently I got myself a new phone. And, as one does, I installed Termux on it, to have a unix-ish environment for when I need it.

    Then, of course, I went to configure Perl and install some modules I'd like there. As this was not my first time doing so, I thought about listing all the modules I want in a cpanfile and then using App::cpanminus to install these, making the process far more reproducible.

    But that required some non-Perl prerequisites, like the C compiler, make and perl itself. And of course, also bootstrapping App::cpanminus.

    Then I thought a bit on how to combine this setup into a single file. This is what I came up with. It's a cpanfile that doubles as shell script.

    #!/bin/bash # This will install cpanminus and then the Perl modules # as listed at the end of this script. To run use # the following commands: # # chmod ugo+x ./cpanfile && ./cpanfile # eval ' pkg install git perl make clang if ! cpanm --help 2>&1 >/dev/null ; then curl -L https://cpanmin.us | perl - App::cpanminus fi DIR=$(dirname "$0") cpanm --installdeps --notest --cpanfile "$DIR" exit ' if 0; requires 'Mojolicious'; requires 'DBIx::Spreadsheet'; #requires 'App::sqldisplay'; # to be released on CPAN requires 'DBIx::RunSQL';

    Why not the other way around? Because I could not find a way to make cpanm take a file with a different name than cpanfile :)

    The cpanfile is also available on Github, if you want to copy it.

Temp directories and the surprise creation thereof
1 direct reply — Read more / Contribute
by Intrepid
on Dec 04, 2024 at 23:09

    Greetings from chilly, snowy Buffalo (NY, USA). I spent about 6 years doing no programming at all and now I'm using perl again. I am still hooked on it. So this week I started exploring CPAN modules that give info about and, in some cases, modify, the filesystem. I know of 3 modules that are used for that: the core module File::Spec, the module Path::Class (used it and liked it, a while back), and the module Path::Tiny. This meditation focuses on Path::Tiny, which seems to be stalking me. I see a lot of module authors using it in their code (that is, it has become a common dependency).

    Path::Tiny is probably a bit of a misnomer. It has many methods. Many many. What I was most interested in this week was the method tempdir. Something about how tempdir works took me by surprise (yes, I am finally getting around to the point of this meditation :). The method returns a {normalized, right-slashed, absolute} pathname, but it also creates the temporary directory. Maybe I am odd, but I expected to be given a string and then create the directory with that pathname myself!

    Below, some code (playful deliberately) that uses tempdir and will demonstrate that when tempdir is called, a directory is created.

    #!/usr/bin/env perl # Last modified: Wed Dec 04 2024 10:48:30 PM -05:00 [EST] use strict; use v5.18; use utf8; use warnings; =head1 NAME pathology.pl =cut use Term::ReadKey qw/ReadMode ReadKey/; use File::Spec; use Path::Tiny; my $user; sub versions { say $File::Spec::VERSION, q[ ] , $Path::Tiny::VERSION ; } sub who { no warnings 'deprecated', 'experimental'; use Config; given (lc( $Config{osname} )) { when ('linux') { $user = $ENV{USER} } when ('cygwin') { $user = $ENV{USER} } when ('mswin32') { $user = $ENV{USERNAME} } default { say "osname is something we don't know, " +, "we'll guess it's something Unixy, so +" , "let's say that user name is " , getlogin || "null"; $user = getlogin; } } return $user; } # ------------------------------------------------------------- # # For all its wealth of methods, I found no direct equivalent of # "tmpdir" in Path::Tiny, so I use File::Spec's. say "We use " , File::Spec->tmpdir , " for temporary files."; # ------------------------------------------------------------- # say "We are currently in directory " , Path::Tiny->cwd; say "Our filesystem is rooted at " , Path::Tiny->rootdir; say "Aha, " , who() , ", we may have a temp dir for you!"; my $tadah = Path::Tiny->tempdir(TEMPLATE => "${user}-XXXXXXXX"); say "Maybe we have made a temp directory at " , $tadah , ", let's see: +"; if ( -e $tadah and -d $tadah ) { say "'$tadah' already exists and is a directory."; say "Type 'y' if you wish to remove this directory:"; ReadMode 'cbreak'; my $reply = ReadKey(0); ReadMode 'normal'; if (lc $reply eq "y") { print "Ok, we are going to attempt to remove it now ..." ; rmdir($tadah) and say "Success." or say "BAH! Could not remove it, reason: $!"; } else { say "Ok, leaving $tadah alone."; } } else { mkdir($tadah => 0777) and say "created temp dir." or die "We couldn't make a directory \"$tad +ah\"", $!; sleep 6; rmdir($tadah) and say "$tadah removed." }
    Dec 05, 2024 at 04:07 UTC
    Examine what is said, not who speaks.
    Love the truth but pardon error.
    Silence betokens consent.
    In the absence of evidence, opinion is indistinguishable from prejudice.
benchmarks, PurePerl vs Perl XS, Only!!! 3x slower, PerlXS C vs Real C, 4x slower
1 direct reply — Read more / Contribute
by bulk88
on Dec 03, 2024 at 13:31
    So I converted a small string/grammar parser, from pure perl, to XS. And benchmarked it. I was surprised, the old pure perl optree implementation, is only 30% of the speed of XS C code (3/11=%30). A string parser written in C with memcmp() vs PurePerl's eq, 3x slower. Not bad.

    More interesting is, I decided as a crazy C/XS guts hack, to have a Perl XSUB, calling another Perl XSUB, C function to C function. And it was FOUR TIMES FASTER. 4x!!!!

    Just by getting rid of the PP for() loop and the internal Perl_call_sv() and Perl_pp_entersub() overhead, and totally removing the the Perl 5 engine/API/interpretor, between 2 Perl 5 XSUBs (C functions), it made things FOUR TIMES FASTER.

    So &$xs('__stdcall') for(0..1000);

    vs

    for(i=0;i<1000;i++) {/*removd*/XS_Local__C_calltype_to_num_xs(aTHX_ cv);/*removd*/}

    these 2 for() loops, one in Perl 5, the other in C99, had a 4x faster difference in speed.

    C compiler was -O2 MSVC 2022 x64 on a Intel Core I5-2520M 2.5ghz.

    Rate pp xs pp 3159521/s -- -73% xs 11612872/s 268% -- Rate pp xs xs2 pp 333/s -- -72% -93% xs 1192/s 258% -- -74% xs2 4516/s 1255% 279% --


    BEGIN { sub APICONTROL_CC_STD () { 0 } sub APICONTROL_CC_C () { 1 } } sub calltype_to_num { my $type = shift; if (!$type || $type eq "__stdcall" || $type eq "WINAPI" || $type e +q "NTAPI" || $type eq "CALLBACK" ) { return APICONTROL_CC_STD; } elsif ($type eq "_cdecl" || $type eq "__cdecl" || $type eq "WINAPI +V") { return APICONTROL_CC_C; } else { warn "unknown calling convention: '$type'"; return APICONTROL_CC_STD; } }


    I32 calltype_to_num_xs(type) SV* type PREINIT: const char * p; I32 l; CODE: SvGETMAGIC(type); if(!SvPOK(type)) { if(!SvOK(type) || (SvIOK(type) && !SvIVX(type)) || !sv_true(ty +pe)) { RETVAL = APICONTROL_CC_STD; } else { unk: warn("unknown calling convention: '" SVf "'", type); RETVAL = APICONTROL_CC_STD; } } else { p = SvPVX(type); l = (U32)SvCUR(type); switch(l) { case STRLENs(""): if(memEQs(p,l,"")){RETVAL = APICONTROL_CC_STD;break;} else goto unk; case STRLENs("CDECL"): if(memEQs(p,l,"CDECL")){RETVAL = APICONTROL_CC_C;break +;} else if(memEQs(p,l,"NTAPI")){RETVAL = APICONTROL_CC_ST +D;break;} else if(memEQs(p,l,"cdecl")){RETVAL = APICONTROL_CC_C; +break;} else goto unk; case STRLENs("PASCAL"): if(memEQs(p,l,"PASCAL")){RETVAL = APICONTROL_CC_STD;br +eak;} else if(memEQs(p,l,"WINAPI")){RETVAL = APICONTROL_CC_S +TD;break;} else if(memEQs(p,l,"WMIAPI")){RETVAL = APICONTROL_CC_S +TD;break;} else if(memEQs(p,l,"pascal")){RETVAL = APICONTROL_CC_S +TD;break;} else if(memEQs(p,l,"_cdecl")){RETVAL = APICONTROL_CC_C +;break;} else goto unk; case STRLENs("WINAPIV"): if(memEQs(p,l,"WINAPIV")){RETVAL = APICONTROL_CC_C;bre +ak;} else if(memEQs(p,l,"__cdecl")){RETVAL = APICONTROL_CC_ +C;break;} else goto unk; case STRLENs("APIENTRY"): if(memEQs(p,l,"APIENTRY")){RETVAL = APICONTROL_CC_STD; +break;} else if(memEQs(p,l,"CALLBACK")){RETVAL = APICONTROL_CC +_STD;break;} else if(memEQs(p,l,"IMAGEAPI")){RETVAL = APICONTROL_CC +_STD;break;} else goto unk; case STRLENs("__CRTDECL"): if(memEQs(p,l,"__CRTDECL")){RETVAL = APICONTROL_CC_C;b +reak;} else if(memEQs(p,l,"__stdcall")){RETVAL = APICONTROL_C +C_STD;break;} else goto unk; case STRLENs("__fastcall"): if(memEQs(p,l,"__fastcall")){goto unk;RETVAL = APICONT +ROL_CC_FC;break;} else if(memEQs(p,l,"__thiscall")){goto unk;RETVAL = AP +ICONTROL_CC_TC;break;} else if(memEQs(p,l,"APIPRIVATE")){RETVAL = APICONTROL_ +CC_STD;break;} else goto unk; case STRLENs("__vectorcall"): if(memEQs(p,l,"__vectorcall")){goto unk;RETVAL = APICO +NTROL_CC_VC;break;} else goto unk; case STRLENs("STDAPICALLTYPE"): if(memEQs(p,l,"STDAPICALLTYPE")){RETVAL = APICONTROL_C +C_STD;break;} else goto unk; case STRLENs("STDAPIVCALLTYPE"): if(memEQs(p,l,"STDAPIVCALLTYPE")){RETVAL = APICONTROL_ +CC_C;break;} else goto unk; case STRLENs("STDMETHODCALLTYPE"): if(memEQs(p,l,"STDMETHODCALLTYPE")){RETVAL = APICONTRO +L_CC_STD;break;} else goto unk; case STRLENs("STDMETHODVCALLTYPE"): if(memEQs(p,l,"STDMETHODVCALLTYPE")){RETVAL = APICONTR +OL_CC_C;break;} else goto unk; default: goto unk; } } OUTPUT: RETVAL void calltype_to_num_xs2(intype) INPUT: SV* intype PREINIT: SV* sv = sv_2mortal(newSVpvs("__stdcall")); int i; PPCODE: SP = &(ST(-1)); for(i=0;i<1000;i++) { PUSHMARK(SP); PUSHs(sv); PUTBACK; XS_Local__C_calltype_to_num_xs(aTHX_ cv); SPAGAIN; SP = &(ST(-1)); } PUTBACK;


    use Local::C; use Benchmark qw(cmpthese :hireswallclock); { my ($pp, $xs, $xs2, $cctype) = (\&Local::C::calltype_to_num, \&Loc +al::C::calltype_to_num_xs, \&Local::C::calltype_to_num_xs2); cmpthese( -1, { pp => sub{&$pp('__stdcall');}, xs => sub{&$xs('__stdcall');} }); cmpthese( -1, { pp => sub{&$pp('__stdcall') for(0..10000);}, xs => sub{&$xs('__stdcall') for(0..10000);}, xs2 => sub{&$xs2('__stdcall') for(0..10);} }); exit; }
Perl's hidden depths
1 direct reply — Read more / Contribute
by talexb
on Nov 28, 2024 at 11:56

    I'm semi-retired, which means I take care of a client's system of Perl scripts that mostly run without my intervention. I log everything with the excellent Log::Log4perl module, and sometimes I tail those files to keep on eye on the various scripts that run. One group of scripts creates tickets for new orders, and other scripts update these tickets based on what Sage (the accounting system) says.

    Eventually, I started to think about understanding the life-cycle of these tickets -- they get created (that's logged in one file), they get updated (logged in a couple of other files), and they get closed (logged in two other files). Could I parse all of the log files and see the life-cycle just by drawing inferences? It's an academic exercise, since all I have to do is query the ticketing system's API about the history of a ticket, but like I said, I'm mostly retired, but I'm still curious.

    The lines are like this:

    2024/11/28 10:54:04 INFO : Update ticket 425955 to add invoice 802436 +tag .. OK 2024/11/28 10:54:05 INFO : Update ticket 425912 to add invoice 802435 +tag .. OK 2024/11/28 10:54:06 INFO : Add note to ticket 425912 with info about i +nvoice 802435 .. OK 2024/11/28 10:57:02 INFO : Create FD ticket 425991 for order 662626 .. + OK
    So I created an AoH data structure with the filename, a useful regular expression, and an action (create or update). (Because for me, it always starts with a data structure to organize the logic.) But then I realized each log file had different elements that needed collecting. How do I handle that without having to write code for each log file? Can't I just add something clever to my data structure?

    Eventually, some of my brain cells told me I needed to use a named capture in the regular expressions to handle this. Other brain cells complained that I'd never used that before, but the first group of brain cells said, Nonsense (or Buck Up, I forget), it's all in the Camel if you just look.

    So, when you're capturing stuff in a regexp with a clause like (\d+), that first capture just gets stashed in $1. But you can also name that capture (a feature I never needed until now), like this: (?<ticket>\d+). And you get it out by looking at the magic variable %+, so the ticket value is available as $+{ ticket }. SO COOL!

    I was then able to write a bunch of regular expressions, all with named captures, and collect whatever I needed from the log lines. Then, if a particular element was there, I would add it to the history hash I was building. So one of the AoH entries looked like this:

    { filename => 'status.log', regexp => qr/Update (?<ticket>\d+) status to (?<status>.+) \.\./, action => 'update' },
    Then, putting stuff into the history hash was this large statement:
    $history{ $+{ ticket } }{ $entry->{ action } } = { date => $words[0], 'time' => $words[1], ( exists ( $+{ order } ) ? ( order => $+{ order } ) : () ), ( exists ( $+{ invoice } ) ? ( invoice => $+{ invoice } ) : () ), ( exists ( $+{ shipment } ) ? ( shipment => $+{ shipment } ) : () ), ( exists ( $+{ scheduled_date } ) ? ( scheduled_date => $+{ scheduled_date } ) : + () ), ( exists ( $+{ status } ) ? ( status => $+{ status } ) : () ), };
    I wanted to do all of this in a single statement, rather than have individual if statements for each possible element.

    The code runs fine, and does what I expect. Named captures are a very cool feature, but they do exactly what I needed to do. Props to all the smart folks who came up with that idea (and then implemented it). What a cool language.

    Alex / talexb / Toronto

    Thanks PJ. We owe you so much. Groklaw -- RIP -- 2003 to 2013.

perlrun doc inaccurate on -s switch
2 direct replies — Read more / Contribute
by Discipulus
on Nov 22, 2024 at 04:53
    Hello!

    yesterday I was trying some perl code after neverending boring weeks (workwise..) and I tried to use -s to add rudimentary switch parsing as described here (emphasis added by me):

    > -s enables rudimentary switch parsing for switches on the command line after the program name but before any filename arguments (or before an argument of --).

    The above is true when there is a real file containing a perl program:

    echo print join ' ', $0, $R > switch-test.pl # after the program name perl -s switch-test.pl -R=OK switch-test.pl OK # before an argument of -- perl -s switch-test.pl -R=OK -- switch-test.pl OK # wrong usage perl -s switch-test.pl -- -R=OK switch-test.pl

    But what if the program is just some code passed with -e (and this is a valid program also for the program name perl's internal value)?

    Even with my limited English understanding, I'd suppose something like: perl -s -e "print $R" R=a or perl -s -e -n "print $R" R=a filename (before any filename arguments) but no, it works exactly in the opposite way:

    # after the program name perl -s -e "print join ' ', $0, $R" -R=OK Unrecognized switch: -R=OK (-h will show valid options). # before an argument of -- perl -s -e "print join ' ', $0, $R" -R=OK -- Unrecognized switch: -R=OK (-h will show valid options). # it works in the opposite way of what perlrun states perl -s -e "print join ' ', $0, $R" -- -R=OK -e OK

    So, given the switch is stated as rudimentary one should expect to use with small oneliners (only our dead pope used it as signature..) and not for serious programs.

    In combination with other switches is even unfriendly:

    perl -snwe "print join ' ', $0, $R, $/" -- -R=OK lorem.txt -e OK -e OK -e OK -e OK

    ..as it shuold be put before any file name but after the --

    The docs also warns about warnings:

    > Also, when using this option on a script with warnings enabled you may get a lot of spurious "used only once" warnings.

    ..but no... or.. what happens??

    perl -wse "print join ' ', $0, $R" -- -R=OK -e OK perl -swe "print join ' ', $0, $R" -- -R=OK -e OK perl -sew "print join ' ', $0, $R" -- -R=OK #what the hell?! ..no output :)

    I think the doc should metion the above. More: in this sight also -- is poorly documented.

    Want some monk put a pr somewhere or point me, lazy peon, to the correct repository to strike?

    Have a nice weekend!

    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.
What's happening with the Cygwin project?
4 direct replies — Read more / Contribute
by Intrepid
on Oct 22, 2024 at 14:25

    What's happening with the Cygwin project?

    I recall recently seeing a remark (on a node I cannot find now) wherein the monk asked "is Cygwin still supported?" That's a good question. Certainly cygwinPerl seem to be alive and current on the Cygwin download servers (at the time of this writing, v5.40.0). But a mechanism for asking questions about Cygwin in general is seemingly problematic and has been for a while. The Cygwin website is completely out of date, directing users to mailing lists that do not exist anymore. Apparently to reach Cygwin developers one must use NNTP (we're talking old school here).

    The Cygwin.com site says: "Please note that the gmane website and its newsgroup search interface is down since August 2016. Only the aforementioned NNTP gateway is still up."

    I see a fair amount of traffic in Cygwin questions on StackOverflow and its related sites, and if someone were to ask me where to get general help with Cygwin today, that's where I would direct them.

    Oct 22, 2024 at 18:07 UTC
    Examine what is said, not who speaks.
    Love the truth but pardon error.
    Silence betokens consent.
    In the absence of evidence, opinion is indistinguishable from prejudice.
When Communities gets taken over
1 direct reply — Read more / Contribute
by talexb
on Oct 15, 2024 at 08:54

    The Wordpress and Mullenweg story popped up recently, and then just this morning, I read about Perforce and Puppet, where it sounds like Perforce took over the Slack community of Puppet.

    The final comment in the Mastodon post was on point:

      .. has something happened behind the scenes in tech that I don't know about? Because everybody seems to be acting proper weird lately.
    It seems like takeovers for profit (like the IRC kerfuffle a while back -- I can't even remember the old server name) don't work. Are the lawyers taking over? Or is this just Chaos Theory/Entropy throwing us around a bit?

    Alex / talexb / Toronto

    Thanks PJ. We owe you so much. Groklaw -- RIP -- 2003 to 2013.

Using LaTeX templates to typeset, use-case: printing labels
No replies — Read more | Post response
by bliako
on Oct 09, 2024 at 14:16

    I would like to show how I am creating printer-ready documents using LaTeX templates from within Perl with LaTeX::Easy::Templates which I have recently published. I will illustrate this introduction with preparing pdf (envelope) labels since a question (Printing Labels) about this was asked earlier.

    Latex offers to the People easy access to professional typography producing aesthetically superb documents. And to the hacker the means to do the same programmatically and automatically, with zero mouse-clicking and menu selecting. Remember, once Latex was the best (OK IMO) alternative to the evil, closed-standard, M$'s pitiful attempts to writing software. Gosh that ugly font!

    Perl users have often inlined latex in their scripts, embeded with data and then shelling out (or using LaTeX::Driver) in order to call latex to produce the final typeset. The same way HTML was produced back in the cavas [sic]! :)

    Latex templates, similar to HTML templates, achieve separation of Model, View & Controller. Additionally, the particular package LaTeX::Easy::Templates handles all the typesetting (via LaTeX::Driver) and makes it easy to typeset your data for publishing. With in-memory latex templates it means you can readily typeset data from a string template with a standalone perl script.

    For the problem at hand: printing (envelope) labels, posted by Bod, I will use the "labels" latex package (documentation) and two simple latex templates label.tex.tx and labels.tex.tx. The latter is the entry point and includes the former for each label in the input. Of course, a single template could be used instead, but the spirit is to be modular.

    Currently the only template engine supported by LaTeX::Easy::Templates is Text::Xslate which performs really fast and has some nifty features which allow for powerful expressions. Including recursion and access to any Perl module. As a consolation to TT fans, it offers a TT-like syntax, called TTerse.

    Here is the entry point latex template: ./templates/labels/labels.tex.tx:

    % I am ./templates/labels/labels.tex.tx \documentclass[12pt]{letter} \usepackage{graphicx} \usepackage{labels} \begin{document} : for $data -> $label { : include 'label.tex.tx' { label => $label }; : } \end{document}

    The template responsible for rendering a single label is the following. Notice how it is included in the above in a loop over each label:

    % I am ./templates/labels/label.tex.tx \genericlabel{ \begin{tabular}{|c|} \hline : if $label.sender.logo { \includegraphics[width=1cm,angle=0]{<: $label.sender.logo :>}\\ : } \hline <: $label.recipient.fullname :>\\ \hline : for $label.recipient.addresslines -> $addressline { <: $addressline :> : } \\ <: $label.recipient.postcode :>\\ \hline \end{tabular} }

    Save these two files under a directory called ./templates/labels, optionally create a logo image here ./templates/images/logo.png. You can create as complex a directory hierarchy as it suits you but you should adjust the file paths in the script.

    And here is the script to harness the beast:

    use LaTeX::Easy::Templates; use FindBin; my $curdir = $FindBin::Bin; # the templates can be placed anywhere as long these # paths are adjusted. As it is now, they # must both be placed in ./templates/labels # the main entry is ./templates/labels/labels.tex.tx # which calls/includes ./templates/labels/label.tex.tx my $template_filename = File::Spec->catfile($curdir, 'templates', 'lab +els', 'labels.tex.tx'); # optionally specify a logo image my $logo_filename = File::Spec->catfile($curdir, 'templates', 'images' +, 'logo.png'); if( ! -e $logo_filename ){ $logo_filename = undef } my $output_filename = 'labels.pdf'; # see LaTeX::Driver's doc for other formats, e.g. pdf(xelatex) my $latex_driver_and_format = 'pdf(pdflatex)'; # debug settings: my $verbosity = 1; # keep intermediate latex file for inspection my $cleanup = 1; my $sender = { fullname => 'Gigi Comp', addresslines => [ 'Apt 5', '25, Jen Way', 'Balac' ], postcode => '1An34', # this assumes that ./templates/images/logo.png exists, else comment + it out: logo => $logo_filename, }; my @labels_data = map { { recipient => { fullname => "Teli Bingo ($_)", addresslines => [ 'Apt 5', '25, Jen Way', 'Balac' ], postcode => '1An34', }, sender => $sender, } } (1..42); # create many labels yummy my $latter = LaTeX::Easy::Templates->new({ 'debug' => { 'verbosity' => $verbosity, 'cleanup' => $cleanup }, 'processors' => { 'custom-labels' => { 'template' => { 'filepath' => $template_filename, }, 'latex' => { 'filepath' => 'xyz.tex', 'latex-driver-parameters' => { 'format' => $latex_driver_and_format, } } }, } }); die "failed to instantiate 'LaTeX::Easy::Templates'" unless defined $l +atter; my $ret = $latter->format({ 'template-data' => \@labels_data, 'output' => { 'filepath' => $output_filename, }, 'processor' => 'custom-labels', }); die "failed to format the document, most likely latex command has fail +ed." unless defined $ret; print "$0 : done, output in '$output_filename'.\n";

    edit: check the output here: https://metacpan.org/pod/LaTeX%3A%3AEasy%3A%3ATemplates#EXAMPLE:-PRINTING-STICKY-LABELS

    edit: example of other labels. Cute? In general https://www.overleaf.com allows you to browse typeset documents and show you the source for using them as a basis.

    edit: I have set the "untemplated" latex file to be saved to 'xyz.tex' for inspection. Ideally that file can be rendered with latex using: pdflatex xyz.tex . Its only dependency is the logo image (if any) and the labels, graphicx latex packages. In production you omit specifying a filename and all is written in temp files to be erased at the end.

    edit: make sure you have latest version of LaTeX::Easy::Templates.

    OnT but OtT: LaTeX has for many years been powering the scientific publishing industry (and what an industry that is!). As free and open-source software so that they can charge $$ for the People to access free literature produced by scientists paid by their taxes.

    bw, bliako

Edge case for checkboxes when used to update data records
3 direct replies — Read more / Contribute
by davebaker
on Sep 20, 2024 at 15:56

    I spent many hours trying to solve a problem, found a solution, and would like to share it in case others might encounter it.

    A checkbox that appears on a form on an HTML page has a "name" attribute. Typically it has a "value" attribute. (If there is no "value" attribute, the default is for the web browser to send the string "on", I think, if the user has checked the checkbox before submitting the form.)

    Anyway, if it unchecked, naturally there is no value sent to the script that's receiving the submitted form data. Let's say the HTML in the form states that the name of the checkbox is "member." If the user is a member of a certain civic organization, as explained elsewhere on the web page, the web page asks the user to so advise the website owner by checking the checkbox. If not a member, then the user just leaves the checkbox unchecked.

    The interesting part is that the script receiving the form data has no idea whether there was a a checkbox named "member" unless the checkbox had been checked by the user. If it was left unchecked, the script doesn't get a "&member=''" (empty string) or even a "&member" in the submitted query string.

    Let's say the script uses the submitted data to add the user to a database. Probably a record in a table in a relational database. The script can be written to assume that the person is not to be recorded as a "member" of the civic organization if there is no value coming in for the "member" parameter. If so, the script inserts a record in the table, puts the empty string (or NULL) into the record's "member" field (here, the field in the table happens to be the same as the name of the form parameter), and life is good.

    But let's say the new user is indeed a member of the civic organization, and said so by checking the checkbox. So the script stores a "1" in the member field of the new record.

    OK. Next step: provide for the editing of the record. We want to have the script create an editing form that looks like the new-user form. The script pulls the user's record from the database, sees there is a value in the member field, and hence the form is created to include "checked=CHECKED" as an attribute, e.g., <input type="checkbox" name="member" checked=CHECKED> is somewhere in the form.

    But it's been six months since the user registered as a new user, and during that time she decided to let her membership in the civic organization lapse. So she wants to use the editing screen to update her record -- to literally uncheck the "member" checkbox. She does so, and submits the form.

    The script, because it doesn't receive any information about the member checkbox from the user's web browser (see above), has to ASSUME that a parameter named member was in the form, and that the failure to find any submitted value associated with that parameter, or find the parameter in the first place, means the user is wanting to have her record in the database updated so as to replace "1" with "0" (or the empty string, etc.). OK, no big deal. The code is fairly simple.

    But what if there were a different form presented to the user. One that is designed to let her change only her username, for example, and doesn't include the "member" checkbox. The HTML in the form is written to submit the data to the same script. But because the script has been written to assume that no incoming data for "member" means the person is no longer a member, then there's trouble when the script updates her record to change the "1" to "0" in the member field. The user only wanted to change her username.

    OK, so we revise the script to make no such assumption. Now, though, how will the script know when to change the "member" field from "1" to "0"? It can't assume that every form has given the user a "member" checkbox. This is the assumption that's been made in every code example that I've seen, though.

    The solution seems to be to have the form include a hidden input field that lists the names of all of the checkboxes in the form, so the script can safely assume that they're to be treated as having been submitted and they're to be treated as if the user intended them to be unchecked when the form was submitted. This can be done by printing a <input type=hidden value="member"> line somewhere inside the <form ...> and </form> tags.

    I used the CGI.pm module to create a form, used its checkbox() function to print a checkbox inside it, and found that, lo and behold, the HTML includes a line that says something like <input type="hidden" name=".cgiparams" value="member"> just before the </form> tag. I had successfully reinvented the wheel.

    CGI.pm is then able to redisplay the form (if, for example, the user supplied invalid data in the form such that the script is written to redisplay the form along with an error message), and the stickiness aspect of its created checkboxes means that a checkbox that initially was displayed as being checked will be correctly redisplayed as being unchecked if the user had in fact unchecked the checkbox before submitting the form. CGI.pm apparently knows that the checkbox it creates upon redisplay of the form is not to be checked this time, because it finds the member parameter in the .cgiparams list that was part of the submitted form and it determines that no value came in for the member parameter (or that the parameter didn't come in at all).

    My strategy in generating web forms has been to take advantage of CGI.pm's sticky checkboxes and to use HTML::Template for templates. (I don't want to use CGI.pm to create and display the entire form using the 1995-ish technique of $q->start_html; $q->start_form [etc.]; $q->end_form; $q->end_html; in the script, even if that seems to have been a good and novel idea back in the day.)

    So my script creates a sticky checkbox by calling $q->checkbox( -name => "member" ). CGI.pm returns a string of HTML that can be sent over to the template, where there is a <TMPL_VAR MEMBER_CHECKBOX> embedded in its text, waiting to receive the HTML for the checkbox, which might be checked due to CGI.pm's stickiness, or might not be.

    Alas, the sticky feature still wasn't working. A "view source" revealed that the magic <input type="hidden" name=".cgiparams" value="member"> wasn't part of the form in the generated web page. But, of course, why should it be? I hadn't sent it over to the template. But where is CGI.pm generating that string? How do I get it?

    It turns out that the string containing the hidden list of fields is prepended to </form> when CGI.pm's $q->end_form() is called. But beware (ask me how I know), this is the case only if $q->start_form() has been called before $q->checkbox() was called. it's not enough that the CGI module was instantiated. My template had its own <form action="https://yaddayadda.com/script.cgi"> and its own </form> tag, so I hadn't thought of using needing to call CGI->start_form() or CGI->end_form(). I only needed the creation of the sticky checkboxes.

    What wasn't intuitive to me, and might be useful to others, is that I needed to have my script actually call something like my $throwaway_string = $q->start_form(); somewhere before $template->param( MEMBER_CHECKBOX => $q->checkbox(-name => "member") ); and then needed to send over the list of hidden fields by doing something like my $hidden_list_of_fields_and_closing_form_tag = $q->end_form(); -- after the last checkbox or any other form field had been created by using a CGI.pm function -- followed by something like $template->param( HIDDEN_LIST_OF_FIELDS_AND_CLOSING_FORM_TAG => $hidden_list_of_fields_and_closing_form_tag );

    I don't need to send over the results of start_form(); I just need to have called it. The sticky checkboxes work even with the <form action=...> that's hard-coded in my template. But apparently I do need to call start_form() in order for CGI.pm to start paying attention and keeping a list of the names of the checkboxes (or other HTML form elements) that it's thereafter creating, so that $q->end_form() knows what to return in the way of a hidden list of fields.

    I know that a web application platform might handle this particular edge case behind the scenes, but I'm not sure. I've done some development with Dancer2, but even that fine platform seems to assume that the developer has picked and implemented some Perl module (ideally, one that's more recent and more sophisticated than CGI.pm) to handle the creation of form elements, and to somehow handle this checkbox edge case.


    Edited for clarity, probably unsuccessfully due to author's inability to communicate precisely :-)


Add your Meditation
Title:
Meditation:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • 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?Last hourOther CB clients
    Other Users?
    Others having a coffee break in the Monastery: (4)
    As of 2025-02-18 17:07 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      No recent polls found