Seekers of Perl Wisdom

Dear Monkees,

I am using ExtUtils::MakeMaker for all of my projects just because it is how I started. I know how to create custom targets with it using the "postamble". Now I need to modify certain targets like all in order to add more tasks during making. For example, I have need to create special files before compilation, let's call this target translations (because it translates various strings to various languages and provides multilingual strings). This target should be called prior to whatever target all does. How do I achieve this?

Of course I can add a new target allall as

allall : translations all
[download]

bw, bliako

Dear Monks

I'm trying to read a range of text from Vte::Terminal

There is a very old reference of Gtk2::Vte on how to call this method at :
https://gtk2-perl.sourceforge.net/doc/pod/Gnome2/Vte/Terminal.html

And this link documents the function and its parameters
https://api.gtkd.org/vte.Terminal.Terminal.getTextRange.html

My problem is that I don't understand how to create the $func parameter

I have tried this code, but it fails with fatal errors

$$self{_GUI}{_VTE} = Vte::Terminal->new();
# more code

my $func = sub { return 1 };
my $string = $$self{_GUI}{_VTE}->get_text_range($row, $col, $row, $end
+_col, $func, my $data = undef);
[download]

ERROR:gperl-i11n-invoke-c.c:584:_allocate_out_mem: assertion failed: (interface_info)
Bail out! ERROR:gperl-i11n-invoke-c.c:584:_allocate_out_mem: assertion failed: (interface_info)

And many other variants that make even less sense, and all of them fail. Inclusive passing the undef value to the function.

For example this line does not crash, but it does not work either

my $func = {sub => {return 1}};
my $string = $$self{_GUI}{_VTE}->get_text_range($row, $col, $row, $end
+_col, $func, my $data = undef);
[download]

I need to be able to grab the text from a line where the user clicks, so I can test for the existence of a url and then try to open the url on a browser.

This is for the open source project asbru on github

If you need a working code, the only option I can offer is to clone the repo at : https://github.com/asbru-cm/asbru-cm

Edit PACTerminal.pm and around line 1141 you should see the button_press_event

In the button_press_event, you can add the line to grab the text with any fixed parameters at any point when the user clicks

Thanks

Esteemed Monks,

I have the short script below for receiving files over HTTPS and saving them in a directory. It works great for files of a few hundred kB or less in size. However, for files around 50MB or larger, the script times out without saving the files.

I've tried increasing the timeout for the HTTP daemon (OpenBSD's httpd) but that shouldn't be needed, the upload should take only a second or so with these network speeds, as with SFTP.

#!/usr/bin/perl

use CGI::Fast;
use CGI::Carp qw(fatalsToBrowser);

use strict;
use warnings;

my $socket = '/var/www/run/sockets/upload.sock';

# max file upload size MB
$CGI::POST_MAX = 1024 * 1024 * 500;
$ENV{FCGI_SOCKET_PATH} = $socket;
$ENV{FCGI_SOCKET_PERM} = 0775;

while (my $q = CGI::Fast->new) {
    print qq(Content-Type: text/html; charset=utf-8\n\n);

    print qq(<!DOCTYPE html>\n);
    print qq(<html xmlns="http://www.w3.org/1999/xhtml">\n);
    my $head = &head_default;
    print qq(<head>\n$head\n</head>\n);
    my $body;
    if ( $q->param && $q->request_method() eq 'POST') {
    $body = &upload($q);
    } else {
    $body = &body_default;
    }
    print qq(<body>\n$body\n</body>\n);
    print qq(</html>\n);
}

exit(0);

sub head_default {
    my $css = &css;
    my $head = <<"EOH";
        <title>Hello, World</title>
    $css
EOH

    return($head);
}

sub css {
    my $css=<<EOC;
 <style type="text/css" media="screen">
  /*<![CDATA[*/
  BODY { font-family: sans-serif; margin: 0; }
  H1 { font-size: 150%; font-weight: bold;
       font-family: serif; 
       background-color: #a080ff; 
       padding-left: 1em; padding-right: 1em; 
       border-right:  thin solid #000000;
       border-left:   thin solid #000000;
    }
  P.update { clear: both; font-size: 60%; text-align: center; 
             margin-left: 0.5em; margin-right: 0.5em; }
  FORM { border: thin solid #000; }
  FORM > LABEL:has(~ DETAILS[open]) { display: none; }

  }
  /*]]>*/
</style>
EOC
    return($css);
}

sub body_default {
    my $body;

    $body .= <<EOB;
        <h1>Upload a File</h1>
        <p></p>
    <form method="post" enctype="multipart/form-data">
    Select a file to upload: 
    <input type="file" name="fileToUpload" 
        id="fileToUpload"> <br />
    &nbsp; <br />
    <input type="submit" value="Upload File" name="submit">
    </form>
EOB
    
    return($body);
}

sub upload {
    my ($q) = (@_);

    if (!$q->param('fileToUpload')) {
        return(0);
    }

    my $file = $q->param('fileToUpload');
    $file =~ s/\s+/ /g;
    $file =~ s/[^\w\ \_\.\-]+//g;

    if (! $file) {
        return(0);
    }

    my $upload_dir = "/var/www/uploads";
    my $upload = $q->upload('fileToUpload');
    open ( my $ufile, ">", "$upload_dir/$file" )
        or die "$!"; 

    binmode($ufile);
    while ( my $data = <$upload> ) { 
        print $ufile $data; 
    }
    close ($ufile);

    my $body = <<EOB;
<p>
The file <b>$file</b> was uploaded successfully. <br />
Press the <b>back</b> button or close this tab.
</p>
EOB

    return($body);
}
[download]

Again, it seems to work fine with smaller files. What should I look at tweaking in order to upload larger files? Any other tips welcome, too.

i have a JSON response of this

90'+7'
[download]

my question is how to strip out of single quotes between +7 and have integer 90+7 = 97

i want to strip out of single quotes when time '+additional time' exits, if not then nothing to strip out

i need some help on parsing some json msg, am doing a get request and getting the json output, but need help in parsing it and separating both teams with thier scores in declosed "competitors": {}, {}

this is my json output

{
  "leagues": [
    {
      "id": "700",
      "season": {
        "year": 2025,
        "type": {
          "id": "1",
          "type": 13481
        }
      },
      "logos": [
        {
          "width": 500,
          "height": 500,
          "rel": [
            "full",
            "default"
          ],
          "lastUpdated": "2019-05-08T16:07Z"
        },
        {
          "width": 500,
          "height": 500,
          "rel": [
            "full",
            "dark"
          ],
          "lastUpdated": "2021-08-10T20:43Z"
        }
      ],
      "calendarType": "day",
      "calendar": [
        "2025-08-15T07:00Z"
      ]
    }
  ],
  "events": [
    {
      "id": "740633",
      "season": {
        "year": 2025,
        "type": 13481
      },
      "competitions": [
        {
          "id": "740633",
          "status": {
            "clock": 540,
            "displayClock": "9'",
            "period": 1,
            "type": {
              "id": "25",
              "shortDetail": "9'"
            }
          },
          "venue": {
            "id": "197",
            "fullName": "Turf Moor",
            "address": {
              "country": "England"
            }
          },
          "format": {
            "regulation": {
              "periods": 2
            }
          },
          "notes": [],
          "geoBroadcasts": [],
          "broadcasts": [],
          "broadcast": "",
          "competitors": [
            {
              "id": "379",
              "homeAway": "home",
              "score": "0",
              "records": [
                {
                  "name": "All Splits"
                }
              ],
              "team": {
                "id": "379",
                "name": "Burnley",
                "links": [
                  {
                    "rel": [
                      "clubhouse"
                    ],
                    "isHidden": false
                  },
                  {
                    "rel": [
                      "stats"
                    ],
                    "isHidden": false
                  },
                  {
                    "rel": [
                      "schedule"
                    ],
                    "isHidden": false
                  },
                  {
                    "rel": [
                      "squad"
                    ],
                    "isHidden": false
                  }
                ],
                "venue": {
                  "id": "197"
                }
              },
              "statistics": [
                {
                  "name": "appearances"
                }                
              ]
            },
            {
              "id": "364",
              "homeAway": "away",
              "score": "0",
              "records": [
                {
                  "name": "All Splits"
                }
              ],
              "team": {
                "id": "364",
                "name": "Liverpool",
                "links": [
                  {
                    "rel": [
                      "clubhouse"
                    ],
                    
                    "isHidden": false
                  },
                  {
                    "rel": [
                      "stats"
                    ],
                    
                    "isHidden": false
                  },
                  {
                    "rel": [
                      "schedule"
                    ],
                    
                    "isHidden": false
                  },
                  {
                    "rel": [
                      "squad"
                    ],
                    "isHidden": false
                  }
                ],
                "venue": {
                  "id": "192"
                }
              },
              "statistics": [
                {
                  "name": "appearances"
                }
             
              ]
            }
          ],
          "details": [],
          "odds": [
            {
              "provider": {
                "id": "2000"
              },
              "awayTeamOdds": {
                "summary": "1/3",
                "team": {
                  "id": "364"
                },
                "link": {
                  "language": "en-GB",
                  "rel": [
                    "away"
                  ],
                  "isHidden": false
                }
              },
              "homeTeamOdds": {
                "summary": "8/1",
                "team": {
                  "id": "379"
                },
                "link": {
                  "language": "en-GB",
                  "rel": [
                    "home"
                  ],
                  "isHidden": false
                }
              },
              "drawOdds": {
                "summary": "4/1",
                "link": {
                  "language": "en-GB",
                  "rel": [
                    "draw"
                  ],
                  
                  "isHidden": false
                }
              }
            }
          ],
          "wasSuspended": false,
          "playByPlayAvailable": true,
          "playByPlayAthletes": true
        }
      ],
      "status": {
        "clock": 540,
        "displayClock": "9'",
        "period": 1,
        "type": {
          "id": "25",
          "shortDetail": "9'"
        }
      },
      "venue": {
        "displayName": "Turf Moor"
      },
      "links": [
        {
          "language": "en-GB",
          "rel": [
            "live"
          ],
          "isHidden": false
        },
        {
          "language": "en-GB",
          "rel": [
            "stats"
          ],
          "isHidden": false
        }
      ]
    }
  ]
}
[download]

this is my part of script i want to fix, and output all teams with the scores

for my $match (@{$parse_json->{leagues}}) {
    my $elapsed   = $match->{competitions}{status}{displayClock};
    my $status   = $match->{wasSuspended};
    my $home     = $match->{competitors}{team}{homeAway};
    my $away     = $match->{competitors}{team}{homeAway};
    my $away_goal  = $match->{competitors}{score};
    my $home_goal  = $match->{competitors}{score};
    
    print "$elapsed: $home: $home_goal: Suspended Match: $status";
    print "$elapsed: $away: $away_goal: Suspended Match: $status";
}
[download]

I'm trying to create a signature_for an import method that should be called like:

    MyPackage->import(qw(symbol1 symbol2 symbol3));
[download]

I need to validate that: It's a proper method call (class name first) Followed by at least one non-empty string argument But I want the arguments to remain as individual scalars in @_, not get wrapped into an arrayref. Every approach I've tried with slurpy ends up forcing the string arguments into an arrayref:

use Type::Params qw( signature_for );
use Types::Standard qw( slurpy Any );

signature_for import => (
    method => 1,
    pos => [ slurpy Any ],
);

sub import {
    warn "Args: ", join(", ", map { ref($_) || $_ } @_), "\n";
    # Shows: Args: MyPackage, ARRAY(0x...)
}
[download]

Currently using Params::Validate which works fine, but curious if Type::Params can handle this use case.

I want to retrieve and print the contents of a Text Area exactly as it was input from a keyboard, i.e. with no HTML formatting. I am using the code noted below. The content is retrieved and printed but as a single line when it was entered as multiple paragraphs. This is the code I am using

 use strict;
use warnings;
use CGI;

my $q = CGI->new;

# Print the HTTP header
print $q->header;

# Get the content of the text area.
# Replace 'textarea_name' with the actual 'name' attribute of your HTM
+L textarea.
my $textarea_content = $q->param('message');

# Print the content exactly as received
####print "Content of the text area:\n";
print $textarea_content;
[download]

When content is entered as HTML it is returned as originally entered. Otherwise the return is one line. Is there a way to solve my problem? Thanks for any and all help!

(Assuming the PM is sooner alive than dead & I can still read/write here), I noticed some cpan modules have a label (the _: to be specific, mostly in modules by SPROUT, but also perl itself if example is needed) at the end of a sub; it's deparsed into () i.e. empty list. Why? Is this behaviour documented anywhere?

I've got an observation/question to make that isn't about the Perl language but instead is about our Perl infrastructure. Hope it's ok to put it at SoPW anyhow.

I went to look at what's been released recently, at metacpan.org, and found Image::ExifTool v13.35, released a day ago. On my CygwinPerl installation I have cpanplus set up to install CPAN modules. In the cpanp shell I typed i Image::ExifTool and cpanplus found v13.30, not v13.35! Is this a known thing? How would metacpan have a newer release than cpan.org? Aren't packages uploaded to cpan.org first, then somehow appear on metacpan.org?

What I did about it was this. I first ran x --update_source, which did not cause the newer Image-ExifTool to show up. Then, I uninstalled v13.30 (probably an unnecessary step). Then I downloaded the ExifTool .tar.gz package from metacpan and unrolled the archive, typed i <path to archive dir> and hit enter. Pleasingly, that worked (cpanplus does have some good features).

— Soren

Sep 07, 2025 at 22:09 UTC

A just machine to make big decisions
Programmed by fellows (and gals) with compassion and vision
We'll be clean when their work is done
We'll be eternally free yes, and eternally young
Donald Fagen —> I.G.Y.
(Slightly modified for inclusiveness)

Not a Perl question per-se: This code creates an Excel file containing a column chart with one series of 36 points. The color of each column in this series is the same color.

My question is: how can one use Perl to assign the fill color '#ED7D31' to the first 12 columns, '#4472C4' to the following 12 columns, and '#00B050' to the final 12 columns?

In case it matters: perl 5.24 running on Windows 7.

#!  perl -w

use strict;
use warnings;

use Excel::Writer::XLSX;

my $workbook     = Excel::Writer::XLSX->new( 'test.xlsx' );
my $worksheet    = $workbook->add_worksheet( 'C' );

my $a_fill_color = $workbook->add_format( bg_color => '#ED7D31' );
my $b_fill_color = $workbook->add_format( bg_color => '#4472C4' );
my $c_fill_color = $workbook->add_format( bg_color => '#00B050' );

my $headings = [ 'FY 2024 Big-3', 'Total' ];
my $data     = [
   [ 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec', 'Jan', 'Feb', 'Mar', 'A
+pr', 'May', 'Jun',
     'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec', 'Jan', 'Feb', 'Mar', 'A
+pr', 'May', 'Jun',
     'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec', 'Jan', 'Feb', 'Mar', 'A
+pr', 'May', 'Jun',
   ],
   [ 15, 18, 17, 16, 13, 12, 20, 16, 35, 10, 22, 21,
     10, 22, 20, 28, 24, 28, 23, 34, 39, 27, 56, 35,
      5,  7,  7,  2,  7,  5,  7,  3,  6, 12,  3,  2,
   ],
];
$worksheet->write( 'A1', $headings );
$worksheet->write( 'A2', $data );

my $chart = $workbook->add_chart(
  type     => 'column',
  subtype  => 'clustered',
  embedded => 1,
  name     => 'CHART03' );
$chart->add_series(
  name        => '=C!$B$1',
  categories  => '=C!$A$2:$A$37',
  values      => '=C!$B$2:$B$37',
  data_labels => { value => 1 },
  gap         =>  40,
);

$chart->set_title ( name     => 'FY 2024 Big-3' );
$chart->set_legend( position => 'none' );
$chart->set_style( 10 );
$chart->set_x_axis( name => '', minor_unit => 1, major_unit => 1 );
$chart->set_y_axis( name => '' );
$chart->set_size(width => 1200, height => 600);
$worksheet->insert_chart( '=C!$D$1', $chart, 10, 10 );
$workbook->close() or die "XLSX: Error closing file: $!";
exit(0);
[download]

Searched for donut and crumpit. Found donate and stumbit instead.

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`