Been gone a while, but back with a green-field website development project:

desktop website design providing future mobile delivery groundwork preparation

We are to define the design framework for a new website from the ground up for delivery on desktops - which currently accounts for 90% of users. But, knowing that mobile users will increase, we want to lay the groundwork for mobile delivery not too far away. That is, design the desktop version so that a mobile version can be built later without havng to start from scratch again.

What's this got to do with Perl?

Our favourite framework is for dynamic websites. LAMP stack, and Template Toolkit. So our first instinct is to strip out content into separate files with semantic markup or a database, detect the browser or device, and dynamically serve the content in a custom template with appropriate css and javascript.

But

Then you get all caught up in Graceful Degradation and Progressive Enhancement and Responsive Web Design.....and suddenly the place of server-side page assembly seems in doubt. And yet - as an old server-side coder - I find myself suspecting that the reliability of server-side dynamic generation, while not "hip" or sexy anymore, is still our friend.

Note that I am talking about what might be called a "document site" - that is, not a web application - just information delivery. And lots of it - so a fairly complex and deep navigation structure.

So, if there's a question in there, I guess it's: Has Perl, or server-side processing in general, responded to the emerging mobile delivery question? Has browser or device detection through headers become any more reliable than it used to be? Is there a place for such approaches in a RWD world?

Thanks.

Hi Monks

I am not asking for anyone to write any code here but I am looking for good advice where to start with my issue.

I have a flat file and what I need to do is read the contents of that file (which is simple enough) but the part I cant work out is I need to join the contents of the file into one complete string between pointers in a file.

Example is an extract from the test file

# 20130115 175816.654330
modify 0;mc_ueid='mc.hq_i_aix_01.10f59802.0';
        mc_modhist=[hq_i_aix_01];
        repeat_count=1;
END

# 20130115 175817.304403
modify 0;mc_ueid='mc.hq_i_aix_01.10d41bfd.2';
        mc_modhist=[hq_i_aix_01];
        repeat_count=14555;
END

# 20130115 175817.615425
modify 0;mc_ueid='mc.hq_i_aix_01.10c99dfe.1';
        mc_modhist=[hq_i_aix_01];
        repeat_count=14605;
END

# 20130115 175818.571722
modify 0;mc_ueid='mc.hq_i_aix_01.10f58d1f.0';
        mc_modhist=[hq_i_aix_01];
        repeat_count=10;
END
[download]

I need to start at the # of each entry and finish at the END and remove the carriage returns and join the contents of the data into one complete string keeping the ";" separators. I need to do this for each occurrence of data which falls between # and END. I hope I've explained it ok

Any help would be much appreciated"

.
„¥„Ÿ„Ÿ Changes
„¥„Ÿ„Ÿ MANIFEST
„¥„Ÿ„Ÿ Makefile.PL
„¥„Ÿ„Ÿ README
„¥„Ÿ„Ÿ ignore.txt
„¥„Ÿ„Ÿ lib
„    „¤„Ÿ„Ÿ Net
„        „¥„Ÿ„Ÿ StackExchange
„        „    „¥„Ÿ„Ÿ V2
„        „    „    „¤„Ÿ„Ÿ Answers.pm
„        „    „¤„Ÿ„Ÿ V2.pm
„        „¤„Ÿ„Ÿ StackExchange.pm
„¤„Ÿ„Ÿ t
    „¥„Ÿ„Ÿ 00-load.t
    „¥„Ÿ„Ÿ boilerplate.t
    „¥„Ÿ„Ÿ manifest.t
    „¥„Ÿ„Ÿ pod-coverage.t
    „¤„Ÿ„Ÿ pod.t

###################
#   Inside StackExchange.pm
###################
sub new {
    return Net::StackExchange::V2->new();
}
###################
#   Inside V2.pm
###################
sub new {
    my ($class) = @_;
    my $self = {};
    bless $self, $class;
    return $self;
}
sub answers {
    return Net::StackExchange::V2::Answers->new();
}
###################
#   Inside Answers.pm
###################
sub new {
    my ($class) = @_;
    my $self = {
        auth_token => "",
    };
    bless $self, $class;
    return $self;
}
sub getAll {
    print "All Answers";
}
[download]

#########
# UsageTest.pl
#########
use lib("some_path_to_module/Net-StackExchange/lib");
use Net::StackExchange;
my $a = Net::StackExchange->new();
my $r = $a->answers->getAl();
print $r;
# Using Dumper..
print Dumper($r);
#returns => All Answers$VAR1 = 1
[download]

The output I get is : All Anwers1

I cannot figure out for the life of me where that 1 (one) came from? Is it the one from the package returning 1? Doesn't make any sense to me!!

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

use DBI;

my $user = "qwer";
my $passwd = "qwer";
my $server = "asdf";
my $database='rd_db';
my $dbd='Sybase';
my $an_dt_file = "an_dt_file";

# Connect to the database

my $dbh = DBI->connect($server,$user,$passwd,$dbd, {RaiseError => 1,Au
+toCommit => 1 });
# Prepare the SQL query for execution
my $sql = "SELECT $ans_rid, $ans_qcn, $ans_loc FROM ft_int_tbl WHERE $
+ans_rid is not null";
my $sth = $dbh->prepare($sql) or die "Couldn't prepare statement:$DBI:
+:errstr; stopped";

# Execute the query
$sth->execute() or die "Couldn't execute statement: $DBI::errstr; stop
+ped";
#open JKLL, ">$an_dt_file" or die "can't open file $ansb_detail_file f
+or write,\n";

# Fetch each row and print it
while ( my ($ans_rid, $ans_qcn, $ans_loc) = $sth->fetchrow_array() ) {
my ($ansb_cktid, $ansb_mcn, $ansb_soc) = unpack("A3 A3 A3", $_);
#print JKLL"Field 1: $ansb_cktid Field 2:$ansb_mcn Field 3: $ansb_soc 
+\n";
print "Field 1: $ansb_cktid Field 2:$ansb_mcn Field 3: $ansb_soc \n";

}

# Disconnect from the database
$dbh->disconnect();
[download]

I have here a web server which generates some dynamic content. The dynamic pages constantly touched by other developers and I finally came to decision to test some critical functionality from outside using simple http client and something like Test::More. So I found Test::WWW::Mechanize but can't figure it out how to

1. ensure that some URI is closed for unauthorized access. I mean there should be a method to check the HTTP code (401 or 403)
2. check redirection (HTTP 302) and check its destination url

Maybe there is another test framework for this? Please sugest if so.

I saw code as below by someone. Though no error reported, I'm curious whether it's right:

sub new
{
    my $this = {};
    bless $this;
    return $this;
}
[download]

Generally we return bless {},package. It's true that an object of Perl is indeed a data structure saying a hash. Does Perl create an new area for the object returned by bless? Does this new sub correct acctually?

#file UTest.pm
package UTest;

use warnings;
use strict;

sub new {
  my $class = shift;
  my $self = {
    'name'      => '',
    'condition' => '',
    'args'        => [],
  };
  return bless $self, $class;
}
# other sub ...
1;
[download]

#file Service.pm
package Service;
use UTest;
our @ISA = qw(UTest);

sub new {
  my ($class)  = shift;
  my $self = UTest->new();
  $self->{'captures'} = {};
  bless $self, $class;
  return $self;
}
#others sub...
1;
[download]

#file test.pl
use Lib::Service;

my $service = Service->new;
#... other codes
[download]

Can't locate UTest.pm in @INC (@INC contains: /etc/perl /usr/local/lib
+/perl/5.14.2 /usr/local/share/perl/5.14.2 /usr/lib/perl5 /usr/share/p
+erl5 /usr/lib/perl/5.14 /usr/share/perl/5.14 /usr/local/lib/site_perl
+ .) at Lib/Service.pm line 2.
BEGIN failed--compilation aborted at Lib/Service.pm line 2.
Compilation failed in require at ./mytest.pl line 2.
BEGIN failed--compilation aborted at ./mytest.pl line 2.
[download]

    open   $files{ "foo" }, "  > xyz";
    print  { $files{ "foo" } } "done\n";
    close  { $files{ "foo" } };
[download]

    "Not a GLOB reference at ..."
[download]

Respected Monks

Given below is the script reads EMC Celerra NAS Array IPs from a text file and then logs into those NAS Arrays, runs a command and then gathers the output and sends out an e-mail. Please let me know if there is a better and more idiomatic way to write it. I tried running multiple commands using the "shell" option of Net::SSH2, but something isnt working. That portion is not given here as I want to try all the possibilities and error checks before I ask it here, but this is what I have as of now.

Here is the script

 
#!/usr/bin/perl
use warnings;
use strict;
use Net::SSH2;
use MIME::Lite;
MIME::Lite->send ("smtp", "mail.server.com");

if (!open my $fh , "<" , "C:/path/to/nas_array_ip_list.txt")
{
    my $msg = MIME::Lite->new
          (
          From    => 'name@email.com',
          To      => 'name@email.com',
          Data    => "Error:nas_array_ip_list.txt:$!.$^E\n",
          Subject => "IP List File - nas_array_ip_list.txt - Not Found
+ For $0 Script on $ENV{COMPUTERNAME}\n",
          );

$msg->send ();
    
}
else {
    print "Please wait. $0 script is being executed...\n";
    open my $mailfh, ">", "C:/path/to/dmcheck.txt";
    print  $mailfh "\n############################################\n";
    print  $mailfh "\nUser: $ENV{USERNAME} running $0 from $ENV{COMPUT
+ERNAME}\n\n";
    print  $mailfh "\n###########################################\n";
    while (<$fh>)
    {
        next if (/^#/);
        
        my ($ipname, $ipaddr) = split /\t+|\s+/;
        
        my $username = 'username';
        my $password = 'password';
        
        my $ssh2 = Net::SSH2->new();
        
        
        print $mailfh "\n----------------------------";
        
        print $mailfh "\nData Mover Check For $ipname ($ipaddr)\n";
        
        print $mailfh "----------------------------\n";
        $ssh2->connect("$ipaddr") || die "PROBELM -$!";
        
        $ssh2->auth_password("$username","$password") || die "Username
+/Password not right";
        
        my $chan = $ssh2->channel();
        
        
        $chan->blocking(0);    
        $chan->exec('/nas/sbin/getreason');
        sleep 3;
        
        while (<$chan>)
        {
        chomp;
        
        next if (/10 - slot_0 primary control station/);
        if ($_ =~ /contacted$/)
        {
            
            print $mailfh "DM is OK: $_\n";
        }
        else
        {
            
            print $mailfh "POSSIBLE DM FAILURE:Please check $ipname ($
+ipaddr): $_ POSSIBLE DM FAILURE:\n";
        
        
        }
        
        
        };
        
        
        $chan->close();
         
    }
    
    close $mailfh;
    my $nasmailmsg = MIME::Lite->new(
        From        =>'name@email.com',
        To         => 'name@email.com',
        Subject     => "Automated Check For NAS DataMover Health.",
        Type    => 'Multipart/mixed',
                        
                    );
        
        $nasmailmsg->attach (
        Type        => 'TEXT',
        Path        => "dmcheck.txt",
        Filename    => "dmcheck.txt",
        Disposition    => 'inline',
                );
        $nasmailmsg->send;
        system "del dmcheck.txt";
                           
        print "$0 execution completed.Please check your mailbox for Ma
+il Titled - \n\"Automated Check For NAS DataMover Health.\"\n";
    
}
[download]

And here is the text file called "nas_array_ip_list.txt" that contains the IPs.

###############################################################
#
#Lines beginning with "#" will be ignored by the script.
#
#This file contains the NAS IPs. 
#
#Please use tab or space to seperate the name and IP of #the NAS Array
+s.
#
###########################################################
NASBOX1        127.0.0.1
NASBOX2        127.0.0.2
NASBOX3        127.0.0.3
NASBOX4        127.0.0.4
[download]

I intend to tweak it to perfection so that later some time, I can put this under "Cool Uses For Perl"

On another note, wanted to thank the PerlMonks and the authors of Learning Perl. This site and the book have been instrumental in getting me to a level where I could write a script like this. This script is already running in our production environment (which is why I had to fill the text file with localhost IPs as I couldnt share the actual IPs), and that feeling is really awesome. Just want to take the script to the next level.

#!/usr/bin/perl -w

use strict;
use IO::Socket;
use MIME::Lite;
use Time::Out qw(timeout);
$SIG{PIPE} = "IGNORE";
$| = 1;

my $nb_secs = 10;
my $buf = "";

my $sock = new IO::Socket::INET (PeerAddr => '192.168.173.9',
                              PeerPort => 4002,
                              Proto    => 'tcp',
                  Type     => SOCK_STREAM,
                );
die "cannot open socket" unless ($sock);


my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(t
+ime);
my $hrmin = sprintf ("%02d%02d",$hour,$min);
my $ymd = sprintf("%04d%02d%02d%02d%02d%02d",$year+1900,$mon+1,$mday,$
+hour,$min,$sec);
my $filename = "/tmp/$ymd.txt";
print $filename, "\n";
open FILE, ">$filename" || die("Couldn't open file");

while (my $line = <$sock>) {

# Close existing file and reopen a new one at midnight.
    if($hrmin == 1114) {
    sleep 1;
    close FILE;
    my $ymd = sprintf("%04d%02d%02d%02d%02d%02d",$year+1900,$mon+1,$md
+ay,$hour,$min,$sec);
    my $filename = "/tmp/$ymd.txt";
    print $filename, "\n";
    open FILE, ">$filename" || die("Couldn't open file");
    }

    if ($line =~ m/^(ALARM: )/) {

.......

    };
#Print current line to open file.
    print FILE $line;

}
    sleep 10; # allow sometime to exit
close FILE;

[download]

Anyone know of anything?

I read once that JS-regexes follow the standards of Perl4.

Now I was quite surprised to learn that JS doesn't have a /s single-line modifier to let '.' also match on linebreaks like \n.

As a compensation JS offers to use [^] to match everything (the negation of nothing is everything).

>>> "a <\n \n> z".match('<[^]*>')
["<\n \n>"]
[download]

I like the concept and was wondering if there is any equivalent in Perl ...

Here [^] is a syntax error because at this position Perl magically expects ']' to be part of the negated char-class and still expects another closing ']'.

The closest that I was able to find was (?:.|\n)

  DB<118> "a <\n \n> z" =~ /<(?:.|\n)*>/  ; $ &
 => "<\n \n>"
[download]

Any other suggestions?

Update

Another option is to use single-line locally: (see perlrecharclass)

  DB<146> "a <\n \n> z" =~ /<(?s:.)*>/;$ &
 => "<\n \n>"
[download]

not shorter but cleaner!

For functions which are non-volatile (i.e. the same inputs will always produce the same outputs) with no side-effects, it often makes sense to "memoize" them. That is, cache the results for the next time they're called.

This is an especially good idea in the case of recursive functions. The following benchmark script illustrates the massive speed up.

use strict;
use warnings;
use Memoize;
use Benchmark 'cmpthese';

sub fib1 {
    my $n = shift;
    return $n if $n < 2;
    return fib1($n-1) + fib1($n-2);
}

sub fib2 {
    my $n = shift;
    return $n if $n < 2;
    return fib2($n-1) + fib2($n-2);
}

memoize('fib2');

my %fib3_cache;
sub fib3 {
    my $n = shift;
    return $fib3_cache{$n} ||= do {
        $n < 2 ? $n : fib3($n-1) + fib3($n-2)
    };
}

for (0..5) {
    die "something bad" unless fib1($_)==fib2($_);
    die "something bad" unless fib1($_)==fib3($_);
}

cmpthese(-1, {
    fib1 => sub { fib1 20 },
    fib2 => sub { fib2 20 },
    fib3 => sub { fib3 20 },
});

__END__
         Rate     fib1     fib2     fib3
fib1   18.2/s       --    -100%    -100%
fib2  37594/s  206668%       --     -87%
fib3 289129/s 1590107%     669%       --
[download]

The Memoize module gives you a pretty decent speed up, without needing to change the guts of the function. Just add memoize('fib2') and the Memoize module will wrap the original function with memoization code.

The manually memoized version is clearly faster still, because it avoids the overhead of function wrapping - the memoization code is added to the guts of the function.

Of course, there's no such thing as a free lunch - you're trading CPU for memory.

A number of other sites have comments that can be collapsed and expanded by clicking on them. Is there a reason why this cannot be done within the Monastery for a more enlightening experience?

As it would be Javascript driven. I presume one cannot add user javascript the same way you can CSS stylesheets.