Customary      Generic    Meaning        Interpolates
''                      q{}          Literal           no
""                     qq{}        Literal           yes
``                    qx{}        Command     yes*
                        qw{}       Word list       no
                        qr{}         Pattern         yes*

I ran into this while debugging a fellow programmers code. Took a bit to realize the problem and was wondering if this is an expected situation...

When calling a subroutine/function from within a loop, if we call 'next' within that function (outside of a looping construct itself), it actually iterates the loop of the calling scope rather than issuing an error. Code example:

use strict;

my @stuff = (1, 2, 3, 4, 5);

foreach my $s (@stuff) {
   test($s);
   print "past\n";
}

sub test { my ( $s ) = @_;
   if ($s == 3) {
      next;  #note that this is not within a loop in the
             #scope of the subroutine
    }
    else {
      print $s . "\n";
    }
}

What I would expect is that I get a compile time error similar to if I attempted to call next outside a loop. Instead what I get is:

1
past
2
past
4
past
5
past

This shows that the subroutine is actually iterating the last loop, independent of the scope.

My opinion is on the fence on whether I like this result or not...but I do find it unexpected. I assumed that the actions within a subroutine is in its own scope and would not be able to affect the outer loop of a calling scope.

The functionality makes it seem as if the batch of the sub is 'imported' into the process, retaining the scope of the batch for variables but not for things like looping constructs.

Thoughts?

use strict;
use GD;

my $gd = GD::Image->new(400,400);

my $black = $gd->colorAllocate(0,0,0);
my $white = $gd->colorAllocate(255,255,255);

$gd->filledRectangle(0,0,399,399,$white);
$gd->setAntiAliased($black);
$gd->line(0,0,399,399,gdAntiAliased);


open(IMG,">","out.png");
binmode IMG;
print IMG $gd->png;

I want to convert <U+xxxx> literals into wide hexadecimal values, how do I do that? Probably trivial, but I don't see it now...

use Encode;
use encoding 'utf8';

my $test = "<U+010C>";
$test=~s/\<U\+(.*)\>/\\x\{$1\}/g;
print "$test\n"; # prints \x{010C}

my $probe1=encode("utf8","\x{010C}"); # works
my $probe2=encode("utf8","$test"); # does not work?

How many different ways can Perl code fail in a string eval? By "different" here I mean different enough to require a separate regression test to ensure that all the error codes and messages are captured when the eval'd code fails in that way. Warnings count as failures for this purpose. My current census of potential sources of information about the failure of a string eval are

1. The eval's return value.
2. The $EVAL_ERROR variable.
3. Warning messages trappable using $SIG{__WARN__}.

I want to know this because I'm writing regression tests of the error messages which Parse::Marpa returns to users who supply Perl code to be eval'd inside the module. The application is a parser generator, and the user code is used (for example) for the semantics of rules in the grammar for which Parse::Marpa generates the parser. The code to be eval'd is not known as of the compile phase, so string eval's are necessary. I have these five cases:

1. Compile phase warnings. For example:

   # this should be a compile phase warning
   my $x = 0;
   my $x = 1;
   my $x = 2;
   

2. Compile phase fatal errors. For example:

   # this should be a compile phase error
   my $x = 0;
   $x=;
   

3. Run phase warnings. Here I'm just using the warn builtin:

   # this should be a run phase warning
   warn "Test Warning 1";
   

4. Run phase fatal error. I use a division by zero to create this.

   # this should be a run phase error
   my $x = 0;
   $x = 711/0;
   

5. An explicit run phase call to die().

Note I treat an explicit call to die() as different from a non-explicit fatal error in the run phase. I'm not sure this is necessary. I don't treat a warning created explicitly with a call to warn() as a special case. And I don't handle calls to die() in the compile phase (which can happen in a BEGIN block) as a special case. Senior monks may be able to advise here.

There's a cost to identifying special cases, because there are 8 places in Parse::Marpa where user code is called, so every special case of Perl code failure needs eight tests. My test module is already long, as you can see below. The goal here is to identify as many cases as necessary, but no more. :-)

thanks!

I have an object of an unknown class and I want to invoke a method of which I will know the name only at execution time.

I can test if the object contains this method with

if ( $obj->can( $method ) ) {
   # now I want to invoke $method on $obj

How?

Thanks for any hints

Update: added client script, changed INADDR_BROADCAST to INADDR_ANY for server (thanks @ikegami)

Good day,

a friend of mine asked me how UDP-Broadcasts with Socket worked. I hardly know anything about UDP, but I tried to learn a little bit about and wrote the following two pieces of code:

#! /usr/bin/perl
use warnings;
use strict;

use Socket qw(:all);

$|++; # no suffering from buffering

my $udp_port = 9999;

socket( UDPSOCK, PF_INET, SOCK_DGRAM, getprotobyname('udp') ) or die "
+socket: $!";

select( ( select(UDPSOCK), $|=1 )[0] ); # no suffering from buffering

setsockopt( UDPSOCK, SOL_SOCKET, SO_REUSEADDR, 1 )
    or die "setsockopt SO_REUSEADDR: $!";
setsockopt( UDPSOCK, SOL_SOCKET, SO_BROADCAST, 1 )
    or die "setsockopt SO_BROADCAST: $!";

my $broadcastAddr = sockaddr_in( $udp_port, INADDR_ANY );
bind( UDPSOCK, $broadcastAddr ) or die "bind failed: $!\n";

my $input;
while( my $addr = recv( UDPSOCK, $input, 4096, 0 ) ) {
    print "$addr => $input\n";
}

use warnings;
use strict;

use Socket qw(:all);
use POSIX ":sys_wait_h";

socket( SOCKET, PF_INET, SOCK_DGRAM, getprotobyname("udp") )
    or die "Error: can't create an udp socket: $!\n";

select( ( select(SOCKET), $|=1 )[0] ); # no suffering from buffering

my $broadcastAddr = sockaddr_in( 9999, INADDR_BROADCAST );
setsockopt( SOCKET, SOL_SOCKET, SO_BROADCAST, 1 );

send( SOCKET, "I'm here", 0,  $broadcastAddr )
    or die "Error at sendding: $!\n";

close SOCKET;

But the server waits forever, it doesn't get any message from client.pl. I started the scripts on the same PC, an OpenSuse 10.3 Linux with perl5.8.

Please, can you give me a hint what I'm doing wrong? I searched perlmonks and google, but couldn't find anything helpful.

use Win32::PowerPoint;

# Global var(s)
my $file = "E:\\rameshwar\\dedupe\\test_presentation.pptx";

# create construtor for ppt App and if script dies #un-expectedly then
+ quit the App
my $ppt_ref =  Win32::PowerPoint->new || die("Opps, failed to open PPT
+ App", Win32::OLE::LastError());

# Make it visible by setting property Visible to 1:: if set 0 it is in
+visible
$ppt_ref->{Visible} = 1;

# set presentation-wide information
$ppt_ref->new_presentation(
      background_forecolor => [255,255,255],
      background_backcolor => 'RGB(0, 0, 0)',
      pattern => 'Shingle',
);

# and master footer if you prefer (optional)
$ppt_ref->set_master_footer(
      visible         => 1,
      text            => 'My Slides',
      slide_number    => 1,
      datetime        => 1,
      datetime_format => 'MMMMyy',
);

# do whatever you want to do for each of your slides
my @slides;
for my $slide (@slides) {
#    my $slide = $ppt_ref->new_slide;
      $ppt_ref->add_text($slide->title, { size => 40, bold => 1 });
      $ppt_ref->add_text($slide->body_text);
      $ppt_ref->add_text($slide->link,  { link => $slide->link });
}
    $ppt_ref->save_presentation($file);

    $ppt_ref->close_presentation;

This is a draft tutorial on the sticky subject of context. It's terrible and in dire need of your comments. Please, if you value the quality of the tutorials at this fine site, read this with a patch over the uncritical eye and tell me where it's unclear, awkward, and just plain wrong so I can fix it before putting it in the Tutorials section. Don't let it go to those hallowed halls in this sad pathetic state.

I wrote it by reading the Camel book's three pages about context, reducing them to nine bullet points, and then expanding the bullet points into this, once I'd forgotten what I read. Really, it needs your help.

Thank you.

Thank you for reading this far! Having endured so much, please take a short time longer and tell me which parts of it are the most horrendous. Thanks again.

Update: I've made small changes based on numerous private comments I've received. (Y'all are welcome to point out my mistakes publicly. I won't be offended.)

Recently I was looking for the fastest way to clear an array I was using as a buffer. It had a specific length, it needed to have 'undef' for 'empty' values, and it may or may not have current values, plus it is going to be immediately refilled with 'real' values.

This isn't really something that's often needed: Anything is fast. But I was trying to squeeze every last bit of performance out of this code, so it mattered a bit.

Anyway, asking on the chatterbox got me several answers: Everyone seems to have an opinion, no one seems to know.

So I benchmarked. Here are the results for your trivia pleasure:

#!/usr/bin/perl

use strict;
use warnings;

use Benchmark qw(cmpthese);

my @working;
$#working = 100;

cmpthese( -10, {
    assign          => '@working = (); $working[$_] = $_ foreach ( 0..
+.100 );',
    assign_undef    => 'undef @working; $working[$_] = $_ foreach ( 0.
+..100 );',
    assign_length   => '@working = ()[0...100]; $working[$_] = $_ fore
+ach ( 0...100 );',
    using_x         => '@working = (undef) x 101; $working[$_] = $_ fo
+reach ( 0...100 );',
    x_with_value    => '@working = 1 x 101; $working[$_] = $_ foreach 
+( 0...100 );',
    } );

(The last is just to see if pre-filling with something approaching valid values makes a difference.)

Results:

• Perl 5.10

                   Rate  using_x assign_undef x_with_value assign_length
  +    assign
  using_x       21456/s       --          -5%          -7%          -12%
  +      -13%
  assign_undef  22605/s       5%           --          -2%           -8%
  +       -8%
  x_with_value  23108/s       8%           2%           --           -5%
  +       -6%
  assign_length 24448/s      14%           8%           6%            --
  +       -1%
  assign        24637/s      15%           9%           7%            1%
  +        --
  

• Perl 5.8.5 (Different box.)

                   Rate  using_x assign_undef assign_length x_with_value
  +    assign
  using_x       35870/s       --          -1%           -1%          -2%
  +       -4%
  assign_undef  36133/s       1%           --           -0%          -1%
  +       -4%
  assign_length 36298/s       1%           0%            --          -1%
  +       -3%
  x_with_value  36540/s       2%           1%            1%           --
  +       -3%
  assign        37497/s       5%           4%            3%           3%
  +        --
  

Note these results are about as stable as you would expect seeing those close numbers: That is, not very. 'Assign' and 'assign_undef' are generally the fastest, but expect pair switching between any pair on any run. (With occasional far-switching.)

I went with 'assign'.

Edit: Updated to fix some testing methodology problems noted by ikegami below. Thanks.

In this, the second in a series of challenges (see the first such challenge), the goal is to explore the language in ways to create a filename. Inspired by a brief conversation on the CB where thezip suggested the mundane "sprintf is your friend," I'm looking for any and all ways to create a filename.

As in the previous challenge, the wording is deliberately vague. You can take this to mean anything you want, as long as the end result is the name of a file. The file may exist, or it may not exist, or its existence may be indeterminate. The choice is up to you.

Entries need not be serious - they can be exploratory (as davido pointed out last time, exporing the corners of the language is sometimes valuable), but pros and cons should be listed. Sometimes an off-beat approach is just what is needed, and knowing the pros and cons of an approach is vital in such evaluation. And, in the context of this challenge, it proves you know what you're doing rather than just copying and pasting it :-)

As to some examples:

# thezip's method:
$fn = sprintf "%s.%04d-%02d-%02d-%02d%02d%02d.ext",
              $base_name,
              (localtime)[5,4,3,2,1,0];

# my method (from CB):
$fn = '';
{
  open my $fh, '>', \$fn;
  print $fh $base_name, '.';
  print $fh strftime("%F-%T");
}

If you have some standard tools, even if wacky, esoteric, domain-specific, please share them. Or if you just are going for bonus points for obtuseness, please do. I managed to learn a lot from last time (including IO::All, the "cat $file |" trick for too-large-for-perl files, using Win32::OLE on Windows, though not necessarily in this order of usefulness ;-)), and I noticed others did as well, so don't be afraid to add your trick - you won't know who will find it helpful, even as an eye-opener, unless you do.

When you turn Perl on
Will it return the favor
Does it have shebang

$_=($_=LWP::UserAgent->new->request(HTTP::Request->new
(GET,"http://www.perlmonks.org/?node_id=735555"))->content)
  ? join(' ', split(/\W+\w+?\W/, (/.+(just.+?hacker).+/si)[0]))
  : $;; print; use LWP::UserAgent

$_=($_=LWP::UserAgent->new,$_->agent("Mozilla/5.0"),
$_=$_->request(HTTP::Request->new
(GET,"http://www.google.com/search?q=japh"))->content)
   ? join(q/ /, split(q{_}, (/(just.+?hacker)/si)[0]))
   : $;; print; use LWP::UserAgent

{$}=(scalar(%::)=~/\/(\d+)/&&$1)}{package JAPH}
print(($_)=[%::]->[$_]=~/(\w+)/,$/)for+($}-2..$}-2)