Yesterday I needed a Perl one-liner ( -e ) to loop over ( -n ) several subtitle files glob*.srt to find those which are in sync with the video I had.

Hence I needed paragraph mode ( -00 ) to see the timestamps

=== FILENAME.srt ===
672
00:35:09,358 --> 00:35:11,027
Ditto ...
[download]

trouble is cmd.exe doesn't do *glob expansion, and my git-bash didn't like the paragraph mode, most probably because of different understandings of line endings

I ended up with something like this

perl -00nE"BEGIN{@ARGV=<@ARGV>}say qq{=== $ARGV ===\n$_} if /ditto/i" *Filenames*

but the BEGIN block is a bit ugly.

Any more elegant way to do this?

One generic workaround could be a special module wglob to do the BEGIN part with perl -Mwglob but I'd like to ask the community first...

header1,header2,header3....
info01,info02,info03...
info11,info12,info13..
  :       :      :
[download]

$VAR1 = {
          info01 => {
                       info02 => {
                                    info03 => {

         info11 =>  {  
                      info12  => {
                                   info13 => {
[download]

#  MODULES
use strict;
use warnings;
use Pod::Usage;
use Data::Dumper;
use Getopt::Long;
use File::Basename;
use Cwd 'abs_path';

use Data::Dumper qw(Dumper);
use Text::CSV;


my $csv = Text::CSV->new({
    binary    => 1, 
    auto_diag => 1, 
    sep_char  => ','
});


my @columns;

open(my $input, '<:utf8',"input.csv") or die;

while (<$input>){
        $csv->parse($_) or die "parse() failed: ";
        my @data = $csv->getline($input);
        
        for my $i (0..$#data) {
               # push @{$columns[$i]}, $data[$i];
               push @{$columns[$i]}, $data[$i];
            


        }
}
close $input;

my %hash = map {shift @$_ => $_} @columns;

use Data::Dumper;
print Dumper(\%hash);
[download]

grep /^..(A|B)./,@a;
[download]

BTW it seems inconsistent that the parens in this statement might be moot. Seems odd to have syntax there that is meaningless in this context. If $1 was returned as an arrayref, it would make good sense, vis-a-vis over-loading et all?

Not strictly a Perl question although the solution will be implemented in Perl and the modules will probably appear on CPAN...

I am writing three, perhaps more, related modules which will have the same basic methods. The three modules will post content to different social media sites. I want to be able to use them something like this:

my $social;
if ($network eq 'Facebook') {
    $social = Bod::Social::Facebook->new( ... );
}
if ($network eq 'Twitter') {
    $social = Bod::Social::Twitter->new( ... );
}
if ($network eq 'LinkedIn') {
    $social = Bod::Social::LinkedIn->new( ... );
}
unless ($social) {
    #  Handle invalid network;
}

# Post text content to whichever network has been selected without car
+ing which
$social->post("Some test text");

# Post text and image content
my $image_handle = $social->upload("images/test.jpg");
$social->post("Test text with image", $image_handle);
[download]

1 - Three separate module
Simply write three modules with similar names as in the code above. Each module has methods with the same names and similar new method. All social media platforms use OAuth2 so new can be largely the same.

2 - Three modules that all inherit from one class
Have a Bod::Social module that defines the methods. Then have modules as in the code above that inherit from Bod::Social and implement the methods. A bit like what I understand an interface to be in Java¹. I don't see any advantage in this option in Perl over option 1 but there are certainly modules on CPAN that do this. Either there is good reason or they are written by people coming from stricter OOP languages.

3 - Have a single method and Service Providers
Have a single module that the code uses. In the new method, specify a Service Provider that is different for each social network. Each service provider implements the platform specific calls needed for interacting with the network. LWP::Authen::OAuth2 is implemented this way and it seems to work reasonably well but, again, I don't understand the advantages and disadvantages of this approach. Like this:

my $social;
if ($network eq 'Facebook') {
    $social = Bod::Social->new( 
        service_provider   => 'Facebook',
        ... ,
    );
}
if ($network eq 'Twitter') {
    $social = Bod::Social->new( 
        service_provider   => 'Twitter',
        ... ,
    );
}
if ($network eq 'LinkedIn') {
    $social = Bod::Social->new( 
        service_provider   => 'LinkedIn',
        ... ,
    );
}
[download]

4 - Use a Factory Class
Use a Factory Class as we discussed here -> Factory classes in Perl
As these modules will always run in the same environment this strikes me as overkill.

I don't see there being a need to add new networks very frequently but it is quite possible that others will need adding. Which approach would you take or would you use a different solution I haven't considered? Why would you do it that way?

This more general than just this application. Since writing Business::Stripe::WebCheckout I have decided that it would be useful if there was also Business::PayPal::WebCheckout that behaves exactly the same. Therefore the end user's code only has to call a different constructor and everything else gets called the same for multiple payment gateways. I am sure there will be more requirements for multiple related module.

¹ I'm not a Java programmer and only use it when I need to create simple Android apps.

Edit 1: - Added option 4

Edit 2: - Added reference to Business::Stripe::WebCheckout and corrected spelling errors.

#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::ProgressBar;

my %pid=(ex1=>{as=>'temp', val=>'-21.5'});

my $mw=MainWindow->new();
my $tmpbar=$mw->Frame()->pack( -padx=>30 );
PBar( \$tmpbar, \$pid{ex1}{val}, '-30', '70' )->pack();
$tmpbar->Label( -textvariable => \$pid{ex1}{val} )->pack();
$tmpbar->Label( -text => "$pid{ex1}{as}" )->pack();

print STDOUT "val Labels: $pid{ex1}{val}\n";

MainLoop;

sub PBar {
    my($frame, $val, $min, $max)=@_;
    print STDOUT "val PBar1: $$val\n";
    my $pbar=$$frame->ProgressBar(
        -anchor=>'s',
        -width=>40,
        -length=>500,
        -blocks=>100,
        -gap=>1,
        -resolution=>0.5,
        -variable=>$val,
        -from=>$min,
        -to=>$max
    );
    print STDOUT "val PBar2: $$val\n";
    return $pbar;
}
[download]

So I have found using perl canvases to debug problems; and visualize things in my field can be quite easy and fast to do. Anyway what I've found is that if I do more than say 400x400 pixels worth of stuff on a canvas, it tends to bog down; and basically it will hang.

If i stay at say 200x200; the canvas behaves fast and I just don't get this problem. I have found (maybe superstitiously); that using idletasks to break things up helps, but I'm not sure exactly what is going on. I suspect without it, I am flooding some queue inside TK. There also seems to be a relationship with the hang and the amount of memory I am using.

Anyway I can't post my 'real' script, as it's tied to real work. Essentially i need to simulate a legacy graphics system, and I'm using perl/tk to test things out before we do the real work on the target. My real resolution I need to hit is just over 400x400; but if i operate it that way, I can generally only get 1-2 images displayed before it will hang. (200x200; runs nice) So i created this little script to just see if i could get the same thing to happen to post here, and it generally has the same issue. If you run this, you can then use the mouse (press and hold, move, and release) to draw lines. Hitting go will redraw the back ground. If you do those things 2-3 times; especially if you make the resolution a bit higher; it is locking up for me.

Can anyone enlighten me on what can be done to avoid this, or what is happening under the hood? Is there an easier way to just do straight pixel level screen outputs? (image magic ? I tried getting that to work but had issues on my work machine...) So would rather just stick with TK because it is very lightweight to support. (easy to install / support; anyone with perl 5.8 already has it too...)

Thanks.

ONE last thing; in reviewing this; I found I am not clearing TAGS array. So that will keep eating more memory. But even if you do @TAGS =(); if you run the script enough; you'll still see the same thing happening. So that seems to be a clue; that it's a memory thing...

Hi everyone.

I am working with a combination script that is giving me problems.

This is as below:

I have two static numbers: 1 and 2.

And also I have a non-static number that represent the size of the combinations.

Example: 3 (combinations of 3 characters).

I need to perform ALL combinations using the static number, but considering the non-static number.

In the example with "3" as non-static number, this will be:

1 1 1
1 1 2
1 2 1
1 2 2
2 1 1
2 1 2
2 2 1
2 2 2

( I think I don't forget any combination :P )

Someone can help me with the code, please? I tried using use Algorithm::Combinatorics qw( combinations ); but I could not solve it.

Thanks all!

I have installed perl 5.26 on windows10 and trying to install Tk module manually, since my application uses Tk module, but getting below error.

C:\Users\VinothG\Desktop\Tk-804.036>perl Makefile.PL
Cannot find 'C:\TEMP\ActiveState--------please-run-the-install-script-
+-------\lib/CORE/perl.h' have you installed C:\Perl64\bin\perl.exe?
Compilation failed in require at Makefile.PL line 37.
BEGIN failed--compilation aborted at Makefile.PL line 39.
[download]

Could someone help me to fix this error, Am I doing something wrong here?

Good evening fellow Monks

I've just been writing a bit of code to partially hide an email address such that the owner of the address would recognise it but anyone else would find it difficult, at least to work out. I tried a simple substitution but hit a problem. How can I determine how many characters there are and replace them with that same number of full stops or asterisks or whatever?

I have come up with a three line solution but it seems like the sort of problem that should be able to be done with a regexp substitution

use strict;
use warnings;

my @email = (
    'someone@example.co.uk',
    'andrew.test@some.company.co.uk',
    'jo@abc.com',
);

foreach my $em(@email) {
    print "$em - ";

    my ($name, $comp) = split /@/, $em;
    $em =~ /^(\w[\w|\.]).*@(\w\w).*\.(\w+)$/;
    $em = $1 . '.' x (length($name) - 2) . "\@$2" . '.' x (length($com
+p) - length($3) - 2) . $3;

    print "$em\n";
}
[download]

C:\Users\joolz\Perl>perl regtest.pl
someone@example.co.uk - so.....@ex.........uk
andrew.test@some.company.co.uk - an.........@so..............uk
jo@abc.com - jo@ab..com
[download]

Is there a nice, simple, succinct way to do this?

I guess the nicest solution would change the number of characters properly displayed as a function of the overall length!

I needed to save the cookies in HTTP::Cookies into Netscape format (aka 'cookies.txt'). Unfortunately I discovered that this functionality is offered by HTTP::Cookies::Netscape alone, which is a subclass of HTTP::Cookies overriding parent-class's load() and save() methods.

However, if one has no control over the creation of the cookie jar (that is, someone has created it and passed it on to us) then it's a bit of a puzzle on how to do that, easily. Actually I did not find a way apart from doing it manually myself by copy-pasting the contents of HTTP::Cookies::Netscape::save() into my own "static" sub which takes in a HTTP::Cookies and saves it in "Netscape" format. But that's a round-about way which also suffers from missing on any patches on the original code.

What I eventually did was to bless the original HTTP::Cookies object into a HTTP::Cookies::Netscape. Call the save() method, which is now different. And when that's done, bless-back to HTTP::Cookies. I just hope this method is as clean as it looks like without side-effects, provided that nobody touches the object in-between its many blessings.

Here is code demostrating the bless/re-bless:

use HTTP::Cookies;
use HTTP::Cookies::Netscape;
use LWP::UserAgent;
my $cookie_jar = HTTP::Cookies->new();
my $browser = LWP::UserAgent->new( );
$browser->cookie_jar( $cookie_jar );
# hit some pages
# now re-bless the cookie jar to obtain ::Netscape functionality
bless $cookie_jar => 'HTTP::Cookies::Netscape';
$cookie_jar->save("mycookies.txt");
# and now re-bless back to original
bless $cookie_jar => 'HTTP::Cookies';
[download]

bw, bliako