I have a cgi script that is supposed to redirect the user on success. I was running it on a somewhat antiquated version of Ubuntu, and when I upgraded it to Lucid (running Perl 5.10.1 under apache 2.2.14), it stopped working. The error message is,

Invalid header value contains a newline not followed by whitespace: 
status: 302 found
location: http://localhost/
[download]

The relevant code seems to be this:

    my $set_username = $q->cookie(
      -name => "user_name",
      -value => $user_name,
      -expires => "+1d",
      );

    my $set_session = $q->cookie(
      -name => "session",
      -value => $secret,
      -expires => "+1d",
      );

    print $q->header( -cookie => [ $set_session, $set_username ],
$q->redirect("http://localhost/"));

[download]

I've tried chomping the relevant variables, adding whitespace, etc., but it doesn't seem to help. As you may have guessed, it is a login script. Does anybody have any pointers on how to fix this?

my $x;
my @array;
@array = qw( a b c);

($x) =  qw( a b c);
print $x  . "\n";

$x =  qw( a b c);
print $x  . "\n";

[download]

C:\dev\learningPerl>perl ex3c.pl
a
c
[download]

Nested transactions - thoughts, suggestions and comments requested.

Microsoft's SQL-Server supports nested transactions something that seem "natural" to Perl's notion of modules. Yet many databases do not support nested transactions - MySQL comes to mind. Perhaps the very nature of my being somewhat of a "clueless newbie" incited me to wonder if it's feasible to implement what amounts to nested transactions for those databases that don't support it.

I've been experimenting with "code" that looks like

  ### Transaction starts
  my $dbh=DBI->connect(...);
  transactionalize {
  
      # Code to be run as a transaction here 
      #- no begin_work, commit, rollback, START TRAN, COMMIT TRAN, ROL
+LBACK TRAN
      ...
  
       } using ($dbh);
  ### Transaction ends
[download]

and implemented transactionalize/using (along the lines of Try::Tiny's try/catch) with

  { # This code implement the transactionalize { ... } using ( dbh );
      my (@dbh_AO,$dbh_HRef,$error_E);
      sub transactionalize(&;$) {
          my ($body_CRef,$dbh_CRef)=@_;
  
          eval {
              ### Setting dbh_O ...
              push(@dbh_AO,(defined $dbh_CRef) ? $dbh_CRef->() : $Defa
+ultdbh_O);
              local $dbh_AO[-1]->{RaiseError}=1;
              warn "@dbh_AO ";
              ### BEGIN TRANSACTION ...
              unless (exists $dbh_HRef->{$dbh_AO[-1]}) {
                  $dbh_AO[-1]->begin_work;
                  $dbh_HRef->{$dbh_AO[-1]}=$dbh_AO[-1];
                   };
  
              ### Do the stuff here ...
              $body_CRef->();
  
              ### COMMIT TRANSACTION ...
              if (@dbh_AO == 1) {
                  for my $dbh_s (keys %$dbh_HRef) {
                      ### $dbh_s
                      $dbh_HRef->{$dbh_s}->commit();
                       };
                   };
              pop(@dbh_AO);
               };
          if ($@) {
              $error_E||=$@;
              ### ROLLBACK TRANSACTION ...
              if (@dbh_AO == 1) {
                  for my $dbh_s (keys %$dbh_HRef) {
                      ### $dbh_s
                      eval { $dbh_HRef->{$dbh_s}->rollback(); };
                       };
                   };
              pop(@dbh_AO);
              Carp::confess $error_E;
               };
           } # transactionalize {}:
  
      sub using($) {
          my $dbh_O=shift;
          ### <where>: $dbh_O
          return sub { return $dbh_O; };
           };
  
       };
[download]

Initial trials give me hope. Much more testing remains.

There are no doubt bugs that remain and enhancements that are needed.

Thoughts, suggestions, comments appreciated.

added: RaiseError

I have a script that installs CPAN modules automatically and redirects all the CPAN output to a file (since they are huge). Now since all output is redirected to a file, user can't see any prompt that is thrown by CPAN installer and hence it will appear as the process has stuck forever.

So, is there a way to bypass questions like this (or any other user prompt for that matter):

MIME::Lite is designed to take advantage of a variety of external modules if they are not present then MIME::Lite will attempt to do its best but its strongly recommend that you install them.

These modules are:
MIME::Types
Mail::Address
I can add these modules to the prereq list which will cause the files to be automatically installed if they aren't already present 
Add prereqs? Yes

I have tried setting 'o conf prerequisites_policy follow' but these prompts are not bypassed with that configuration. It only bypass dependency installation prompts.

use strict;
use warnings "all";
use IPC::Open3;
use POSIX;

my $timeout = shift @ARGV;
my ($cpid);

eval{
     local $SIG{ALRM} = sub {die "alarm\n"};
     alarm $timeout;
     #setsid();
     #setpgrp(0,0);
     $cpid = open3("<&STDIN", ">&STDOUT", ">&STDERR", @ARGV) or die $!
+;
     waitpid($cpid, 0);
     alarm 0;
};
if($@){
    die if $@ ne "alarm\n";
    print "timed out\n";
    my $num = kill 15, $cpid;
    print "sent kill to $num\n";
    waitpid($cpid, 0);
}
[download]

Here's output:

$ perl test.pl 2 perl -e 'system("sleep 3; echo My work is done")'
timed out
sent kill to 1
$ My work is done

As you see child child process didn't get killed. If run with kill -15 and setsid uncommened:

> perl test.pl 2 perl -e 'system("sleep 3; echo My work is done")'
timed out
sent kill to 0
My work is done

Please teach me how to kill entire process group spawned by IPC::Open3.  Final goal is to be able to timeout a process, which spawns child (child accepts input from STDIN).

Thanks

#!/usr/bin/perl -w
#

sub security;
sub sensorium;
sub emotion;
sub think;
sub volition;
sub motorium;

while (1) 
{
  security();
  sensorium();
  emotion();
  think();
  volition();
  motorium();
}

sub security 
{
  # security 
}

sub sensorium 
{
  # sensorium
  print "Press ENTER or ESCAPE key: ";
  $_ = <STDIN>;
  exit if (/^\027/);
}

sub emotion 
{
  # emotion 
}

sub think 
{
  # think 
}

sub volition 
{
  # volition 
}

sub motorium 
{
  # motorium 
}

#---
[download]

There is a school of thought, to which I think I am rapidly coming, that suggests that recursive locks are not just unnecessary, but actually dangerous.

My question is, does anyone know of a particular algorithm or use-case that would be impossible or difficult to implement without recursive locks?

Opinions; examples; references; all sought.

Hello guys,

I really really need your help fast.

I'm doing a project and I have no idea how to do something.

Here is the deal.

I have a while cycle where i read every key pressed. When i press 'Enter' i want to execute a sub which has a while cycle in it but also there is a sleep in it.

Here is some example code :

do 
{ 
if($key eq "\n") 
#execute sub_example() 
if($key eq "261) 
#do something else 
}while ((key = getch()) ne ERR) 

sub_example 
{ 
do 
{#....... 
sleep 5 
#.... 
while(1>0)} 
} 
[download]

So my issue is that when i execute sub_example the program freezes and waits for the cycle in the sub to finish. I want it to run in the background and still have the possibility to read from the keyboard and do stuff.

Thank you very much for your help i really needed.

I come seeking the wisdom of the all knowledgeable monks.

I'm working on a script that passes user input into a subroutine and compares the value to a regex for compliance. Below is a couple snippets of code to show what I'm doing. The variable names in the hash have been changed and do not reflect what I am using in my actual script.

use strict;
use warnings;
use diagnostics;

my ($input, $value)
my %vlan = (
    "vlan1" => "",
    "vlan2" => "",
    "vlan3" => "",
    "vlan4" => "",
);

sub verification {
    print "Entering the subroutine\n"; #added for debugging purposes
    print "$value"; #added for debugging purposes
    if ($value =~ m{(25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.
         (25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.
         (25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.
         (25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\/
         (2[0-4]?$)}x) {
        %vlan{$value}=$input;
    } else {
        print "\t\tInvlaid response.  Please try again.\n";
        #enter return
    }
    print "Exiting the subroutine.\n"; #added for debugging purposes
}

---lines omitted---

print "Enter IP address in x.x.x.x/x format\n";
foreach $_(keys %vlan) {
    print "\t$_: ";
    chomp ($input = <STDIN>);
    $input = $value;
    #call subroutine to check user input
    verification($value)
}
[download]

I'm having a problem with passing $value into the subroutine. When I test my script, I get the  Entering the subroutine message followed by an error stating that I am using an undefined value, and the the closing  Exiting the subroutine message.

Can someone please point me in the direction how I can pass this value to my subroutine for verification?

Thanks for all of your help.

Hi

What is the fastest way to calculate directory sizes in linux (that also works on windows)? I have used File::Find module but it is very slow. Also there is Win32::ole module but it is only for windows. Is there any other way to do fast directory size calculation?

I've got a test harness that captures emails by overriding the subroutine MIME::Lite::send. This works brilliantly about 90% of the time.

Unfortunately, I sometimes need to test subroutine Foo, which happens to have a system call and so my override loses its effect. If I'm calling the system call directly, I've got a module with an import method that can create the override using -M, but in the case where it's buried inside Foo that's not possible.

Does anybody know of a way that the override can persist into a system call? Or alternatively, a different method for capturing email in a test framework.

Hi Fellow Monks,

What with all the stuff going down about SOPA and PIPA, I've sort of being keeping my head down and hoping it would go away. But then I lost my YouTube password, and it automatically logged me on with Google. I was a little shocked. I did some research and I found what I should have known anyway, and you probably already know, that Google owns pretty much the whole Universe, apart from Microsoft, which now has only 3% of the search engine market plus the 5% it gets from Yahoo (also powered by Bing), and Facebook (I think).

So I started to wonder are there ways round it and I came across yacy.net, a P2P search engine, sadly for us written in Java. Although it's been around for a few years, it's still in it's infancy as far as performance and user experience, but it got me thinking.

It seems to me that what is a dynamic network of global peer-peer contributors (like us) is much harder to influence than a single huge company with all the political ties that it inevitably has.

So I am asking my fellow monks, what experience does Perl and the Perl community have on P2P applications and what is there out there that we can draw on in our own development.

As usual I look forward to your thoughts.

Regards

Steve

My head is sore from knocking up against a number of project development issues that I now think are related. Some have chided me for my obsessions but if these issues are trivial, why aren't there good solutions? Note that when I hear many shouts of Oh, that's done and each wagging finger points to a different shortest distance between points, I'm in doubt. And there seems to be no greater disagreements than about overall project management, structure, development, and deployment.

Apart from a few contrarians, everyone agrees that it's wise to use strict, wise to use no hard tabs in code, unwise to write spaghetti code. When dealing with databases some use should be made of DBD; when parsing command line arguments, GetOpt::Long still is the favorite; when testing, Test::More and Test::Harness are standard. Why then does the picture get so blurry when the camera zooms out?

This promises to be a big project itself with many smaller projects attached to it. So I'm not interested in any solution bound to a limited number of platforms or languages. I run Perl on Linux so that will be the reference implementation. Others will have different needs. Therefore the good solution will be platform and language agnostic.

What Metadata?

I've been avoiding the word metadata; too heavily overloaded. I see people using it when they mean description or index. It's also a favorite playground for CS theorists and data professionals. But I must admit that many of my outstanding issues seem to tie into the same thing; which properly is project metadata.

Rather than attempt an abstract definition I'll give examples:

Summary

The bulk of my efforts over the past few years have run aground on what seems to me issues of metadata. Now I believe I will not be content to move ahead with any project until I have a reliable method for interchanging metadata among the various stages of a project's life.

Thanks

• moritz for shoving me out of the CB on this topic.
• bigcheese for a few concise words at the right time.

Changes

Suggestions for improvement are welcome and will be incorporated.

2012-01-28:

- new

To create a password a la xkcd:

perl -le '@w=<>;chomp@w;print join" ",map{$w[rand@w]}1..4'</usr/share/
+dict/words
[download]

Update: Slightly better, though a bit nasty to whoever owns the domain...

perl -MLWP::Simple -lE '@w=get("http://jbauman.com/gsl.html")=~/^\d+\s
++\d+\s+([a-z]+)/xmsg;say join" ",map{$w[rand@w]}1..4'
[download]