Perl Signals Aggregator

how can I get a unknown length string from a webpage

nobody@example.com (mac) — 2011-07-23T11:11:57Z

I need to get a string in perl whose length is varying each day. Look at the URL content below

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<html>
<head>
<title>Index of /isos/preFCS5.3/LATESTGOODCVP</title>
</head>
<body>
<h1>Index of /isos/preFCS5.3/LATESTGOODCVP</h1>
<table><tr><th><img src="/icons/blank.gif" alt="[ICO]"></th><th><a href="?C=N;O=D">Name</a></th><th><a href="?C=M;O=A">Last      modified</a></th><th><a href="?C=S;O=A">Size</a></th><th><a href="?C=D;O=A">Description</a></th></tr><tr><th colspan="5"><hr></th></tr>
<tr><td valign="top"><img src="/icons/back.gif" alt="[DIR]"></td><td><a href="/isos/preFCS5.3/">Parent   Directory</a></td><td>&nbsp;</td><td align="right">  - </td></tr>
<tr><td valign="top"><img src="/icons/unknown.gif" alt="[   ]"></td><td><a href="CVP-LATEST-5.3.0.37.iso">CVP-LATEST-5.3.0.37.iso</a></td><td align="right">19-Jul-2011 03:32  </td><td align="right">816M</td></tr>
<tr><td valign="top"><img src="/icons/unknown.gif" alt="[   ]"></td><td><a href="ChangeLog-LATEST.2011-07-19-03h.30m.01s">ChangeLog-LATEST.2011-07-19-03h.30m.01s</a></td><td align="right">19-Jul-2011 03:32  </td><td align="right"> 16K</td></tr>
<tr><td valign="top"><img src="/icons/unknown.gif" alt="[   ]"></td><td><a href="is.iso">is.iso</a></td><td align="right">19-Jul-2011 03:32  </td><td align="right">816M</td></tr>
<tr><td valign="top"><img src="/icons/unknown.gif" alt="[   ]"></td><td><a href="md5SUM">md5SUM</a></td><td align="right">19-Jul-2011 03:32  </td><td align="right">111 </td></tr>
<tr><th colspan="5"><hr></th></tr>
</table>
<address>Apache/2.2.3 (Red Hat) Server at www.google.com Port 80</address>
</body></html>

You can see a string named "CVP-LATEST-5.3.0.37.iso". I need to get that into $name. the string CVP-LATEST-5.3.0.37.iso will keep on changing everyday say CVP-LATEST-5.3.0.39.iso or CVP-LATEST-5.3.39a.iso or to CVP-LATEST-6.1.iso or CVP-LATEST-6.23.23.112.iso.

Is there any way I can get this ?

Here is the code

use strict;
use warnings;
use LWP::Simple;

my $oldVersion = CVP-LATEST-5.3.0.37.iso;
my $url        = 'http://www.google.com/isos/preFCS5.3/LATESTGOODCVP/';

my $newPage = get($url)
or die "Cannot retrieve contents from $url\n";

if ( $newPage =~ /href=\"CVP-LATEST-5\.3\.0\.(\d\d)/ ) {
my $version = $1;

if ( $version != $oldVersion ) {
    my $status = getstore($url . "CVP-LATEST-5.3.0.$version.iso",
                          "CVP-LATEST-5.3.0.$version.iso");
} else {
    print "Already at most recent version\n";
}

} else {
die "Cannot find version tag in contents from $url\n";
}

Here if you see the code its getting only the number(xx) after 5.3.0."XX" and is of known length that is 2.

Is there anyway I can change it so that it will read the whole filename ie. CVP-LATEST-XXXXXX*.iso and then compare it with the $oldversion ?

Please note the string "CVP-LATEST-" and ".iso" remains constant, but later numbers change and can also contain alphabets. Also note that there is one more file called is.iso in the URL content. I don't want to get that.

how to detect when compiler emits an error

nobody@example.com (Aditya Kumar) — 2011-07-23T10:22:14Z

To compile a C++ project, I want to write a perl script to compile my program and see if the compilation went wrong or not. If the compiler gives any compilation error, I'll need to perform some other task.

The perl script will be something like this:

   @l1 =  `find . -name '*.c'`;
   @l2 =  `find . -name '*.cpp'`;
   @l3 =  `find . -name '*.cc'`;
   my $err;
   my $FLAGS = "-DNDEBUG"   
   push(@l , @l1, @l2, @l3);
   chomp(@l);
   foreach (@l) {
     print "processing file $_ ...";
     $err = `g++ $_ $FLAGS`;
     if($err == something) {
       #do the needful
     }
   }

so what should be something?

Unable to read RTF file using Perl on Mac

nobody@example.com (mac) — 2011-07-23T09:28:34Z

I'm trying Perl on Mac. I have to read an RTF text file. the content of the file is "36" (without double quotes). thats it, just two characters.

Here is the code I have to read it.

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

my $file = "verInfo.rtf";

unless(open FILE, $file) {
    # Die with error message
    # if we can't open it.
    die "\nUnable to open $file\n";
}

my $oldversion = <FILE>;

print "conent is $oldversion";

close FILE;

Remember all I want is to read the value 36 from file and store it as a integer in $oldversion

But when I read the file and print it, it prints following

conent is {\rtf1\ansi\ansicpg1252\cocoartf1038\cocoasubrtf360

Im not able to read 36.

Start the session bus of DBus with Perl Net::DBus

nobody@example.com (Nickolay Stavrogin) — 2011-07-23T09:20:46Z

I am using Perl and the Net::DBus module. I wrote a simple test program:

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

package MyObj;
use Net::DBus::Exporter qw(org.example.Tao);
use base qw(Net::DBus::Object);

sub new {
    my $class = shift;
    my $service = shift;
    my $self = $class->SUPER::new($service, '/MyObj');
    bless $self, $class;
    return $self;
}

dbus_method("Hello", ["string"]);

sub Hello {
    return 'Hello';
}

package main;
use Net::DBus;
use Net::DBus::Reactor;

my $bus = Net::DBus->session;
my $service = $bus->export_service("org.example.Tao");
my $object = MyObj->new($service);
my $reactor = Net::DBus::Reactor->main();
$reactor->run();

return 0;

I am connecting by ssh and using:

Perl, v5.8.8 built for x86_64-linux-thread-multi
Linux example.com 2.6.32.19-0.2.99.17.22250fd-xen #1 SMP 2010-09-13 10:16:50 +0200 x86_64 x86_64 x86_64 GNU/Linux
CentOS release 5.4 (Final)

When I try to start my test.pl, I get the error:

org.freedesktop.DBus.Error.Spawn.ExecFailed:
Failed to execute dbus-launch to autolaunch D-Bus session

This error is raised by this line:

my $bus = Net::DBus->session;

Google hinted to me about dbus-launch. I executed yum install dbus-x11.

I try start my test code again and get error in the same line:

org.freedesktop.DBus.Error.Spawn.ExecFailed: 
dbus-launch failed to autolaunch D-Bus session: 
Autolaunch error: X11 initialization failed.

After read manuals, I detect that DBUS session daemon isn't started and my ENV var DBUS_SESSION_BUS_ADDRESS is empty:

[root@zion perl]# ps ax|grep dbus|grep -v grep
1019 ?        Ss     0:00 dbus-daemon --system

Then I exec:

[root@zion perl]# dbus-launch --sh-syntax
DBUS_SESSION_BUS_ADDRESS='unix:abstract=/tmp/dbus-smHadq6yxV,guid=101ccd74fb75ae501485ed004e2a9043';
export DBUS_SESSION_BUS_ADDRESS;
DBUS_SESSION_BUS_PID=5037;
[root@zion perl]# ps ax|grep dbus|grep -v grep
1019 ?        Ss     0:00 dbus-daemon --system
5037 ?        Ss     0:00 /bin/dbus-daemon --fork --print-pid 4 --print-address 6 --session

But DBUS_SESSION_BUS_ADDRESS is same empty.

Question: I need simple two Perl apps. The first app registers the dbus session service. Another app using my registered service. What is the best and correct way to do it in my environment?

Derefencing a multi-level hash: A practical example

nobody@example.com (capser) — 2011-07-23T04:51:25Z

I have a data that I pump into this multi-level hash:

$newcomm_stat_hash{$stat_message_class}{$stat_process} = $stat_host;

I can print out the $stat_message_class, and the $stat_process with the keys-values structure:

foreach my $stat_message_class (keys %newcomm_stat_hash) {

   my $stat_message_type = $stat_message_class;

   foreach my $stat_process (keys %{$newcomm_stat_hash{$stat_message_class}} ) {

      print $stat_host;
   }
}

But when I follow the same format to print out $stat_host values (see code below), I get this error message:

Can't use string ("dc109") as a HASH ref while "strict refs" in use at multilevel_hash line 24.

I get the same message for the keys or values function.

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

my %newcomm_stat_hash; 
my $control_server = "dc100";
my $control_stat_message = "OCCD2o";

$newcomm_stat_hash{'OCCD2o'} =  { 'filesrvr' => 'dc100',
                                  'dhcpsrv'  => 'dc100',
                                  'dnssrv'   => 'dc109',
                                  'mailpfd'  => 'dc100',
                                };

$newcomm_stat_hash{'PIDmon2'} = { 'pingstat' => 'fg100',
                                  'udpmon'   => 'fg100',
                                  'ftp'      => 'dc100',
                                  'casper'   => 'dc440',
                                };

foreach my $stat_message_class ( keys %newcomm_stat_hash ) {

 my $stat_message_type = $stat_message_class;

 foreach my $stat_process ( keys %{$newcomm_stat_hash{$stat_message_class}} ) {

         foreach my $stat_host (keys %{$newcomm_stat_hash{$stat_message_class}{$stat_process}} ) {

             print $stat_host;
         } 
     }
}

After dereferencing the multilevel hash to $stat_host I want to plug this in at the end:

use TERM::ANSIColor;

if ($stat_host ne $control_server) {

    print "$stat_host, $stat_process , $stat_message_class";   
}   

elsif (  ($stat_host ne $control_server)
      && ($stat_message_class eq $control_stat_message)
      ) {   

    print color 'red';   
    print "$stat_host, $stat_process , $stat_message_class";
    print color 'reset';   
}

Upload file to NodeJS server every 30 minutes

nobody@example.com (cwhelms) — 2011-07-23T04:50:53Z

I'm trying to figure out the best way to upload a file to a NodeJS(any server I guess, but just being specific) every 30 mins.

I was thinking about using perl or python to acheive this, or even NodeJS or a CGI script?

Would it be best to just create a multi-part form?

Trying to figure out the best practice.

Thanks.

How can I use Perl to sum up individual columns in a text file?

nobody@example.com (Jay ) — 2011-07-23T04:49:51Z

I have large text files in this format and would like to do statistical analysis on these numbers, starting by adding the columns (ignoring the first line). I've tried looking at other examples and modifying them but my programming is poor! So I am wondering if someone could point me in the right direction, thanks!

AF3     F7      F3      FC5     T7      P7      O1      O2      P8      T8      FC6 
4464.62 4285.13 4503.59 4505.64 4455.9  4341.03 4257.95 4306.67 4299.49 4180    4461.54 
4473.85 4288.72 4510.26 4508.72 4455.38 4347.18 4265.64 4318.97 4310.26 4184.1  4468.21 
4474.87 4289.74 4516.92 4510.77 4450.26 4345.13 4272.82 4332.82 4312.82 4188.72 4464.62

How do I match a word followed by new line then grab the next line up to its new line?

nobody@example.com (phileas fogg) — 2011-07-22T23:21:31Z

I'm editing a bunch of SQL files and I need to remove date references in the queries. However the way the files are written is that logical operators like, OR and AND are on lines by themselves and the rest of the associated argument are on another line. Like so:

OR
   field.lastupdate > DATE_SUB(CURDATE(), INTERVAL 31 DAY))
AND
  *some more code*

I want to remove the OR (and it can be an AND too) up to the newline character, in this example, after the second parenthesis. However I want to leave the rest of the code intact.

I think the regex should be straightforward except how do I ignore the newline after the OR but stop at the following newline?

I should note that some of the date lines I want to remove end with a ";" which I do not want to remove.

Here's a more complete example that I hope clears things up:

OR
        x.is_deleted = 0
OR
        x.lastupd > DATE_SUB(CURDATE(), INTERVAL 31 DAY))
AND
        (j.active = 1
OR
        j.is_deleted = 0
OR
        j.lastupd > DATE_SUB(CURDATE(), INTERVAL 31 DAY));

So you see I want to keep the first "OR" and it's following line,

delete the second "OR" and the line that follows it.

Keep the "AND" and the line that follows it as well as the following "OR" and it's corresponding line.

And then delete the final "OR" and it's line while leaving the final ";".

Perl client to JAX-WS java server issue

nobody@example.com (user811165) — 2011-07-22T23:06:29Z

I have a JAX-WS java server which publishes a web-service

@WebService(endpointInterface="calculator.operation.Calculator")
public class CalculatorWs implements Calculator{

public String[] add(String a) {

    System.out.println(a);

    String[] test = {"this", "that"};
    System.out.println(test);
    return test;
}

}

and

@WebService
@SOAPBinding(style=SOAPBinding.Style.DOCUMENT)
public interface Calculator {
    String[] add(String a);
}

and have a perl client

use SOAP::Lite +trace => 'all';
$SOAP::Constants::PREFIX_ENV = 'soapenv';
$SOAP::Constants::PREFIX_ENC = "SOAP-ENC";
my $soap = SOAP::Lite
->service('http://localhost:8080/tomcat/calculator?wsdl')
->soapversion('1.1');
my $var = {'a' => "test"};
my $result = $soap -> add($var);

The problem I'm having is that the Java server does not receive the arguments passed by the Perl client, although the value returned by the Java server is received and recognized by the client.

<?xml version="1.0" encoding="UTF-8"?>
<soapenv:Envelope xmlns:wsu="http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-utility-1.0.xsd" soapenv:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:wsp="http://www.w3.org/ns/ws-policy" xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/" xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" xmlns:wsam="http://www.w3.org/2
007/05/addressing/metadata" xmlns:wsp1_2="http://schemas.xmlsoap.org/ws/2004/09/
policy" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:SOAP-ENC="ht
tp://schemas.xmlsoap.org/soap/encoding/" xmlns:tns="http://operation.calculator/
" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><soapenv:Body><tns:add><c-gensym3
><a xsi:type="xsd:string">test</a></c-gensym3></tns:add></soapenv:Body></soapenv
:Envelope>

this is the SOAP request sent by the Perl client. Im assuming the way its building the SOAP request is to blame . But if anyone could help me figure it out, would be greatly appreciated. Thanks.

Is there an equivalent to imagecolorset for GD from PHP in Perl?

nobody@example.com (user811250) — 2011-07-22T21:57:00Z

I have a transparent image and I would like to change it's color. In PHP this was done by using imagecolorset but I have read through CPAN's doc on GD and I am unable to comprehend how to do it in Perl. (Using fill does not preserve the transparency)

Thank you. :)

make adds an 'exec' line to my scripts

nobody@example.com (mrburns) — 2011-07-22T20:25:05Z

I'm trying to build a perl package (module + scripts).

My Makefile.PL has the following to include my script

EXE_FILES => [
               'bin/somescript1',
             ],

But after installing the script, it adds the following to the beginning of the installed script.

eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell

Why does it do this and can I make it not include that?

Connecting keeps closing?

nobody@example.com (Shahab) — 2011-07-22T19:52:30Z

so i'm having a problem trying to automatically login to a internal website. I'm able to send a post request but in the response I always get the Header Connection: close. I've tried to pass is through the post request but it still seems to respond with Connection: close. I want to be able to navigate through the website so I need the Connection: keep-alive so that i can send more request. Could anyone tell me what I'm doing wrong? here's the code:

#usr/bin/perl
#NetTelnet.pl

use strict; use warnings;

#Sign into cfxint Unix something...
use Net::Telnet;

# Create a new instance of Net::Telnet, 
my $telnetCon = new Net::Telnet (Timeout => 10,
                             Prompt => '/bash\$ $/') or die "Could not make connection.";

my $hostname = 'cfxint';

# Connect to the host of the users choice                                
$telnetCon->open(Host => $hostname,
             Port => 23) or die "Could not connect to $hostname.";

use WWW::Mechanize;

my $mech = WWW::Mechanize->new(cookie_jar => {});
&login_alfresco;


sub login_cxfint {
#get username and password from user
my $CXusername = '';
my $CXpassword = '';

# Recreate the login
# Wait for the login: message and then enter the username
$telnetCon->waitfor(match => '/login:/i');

# this method adds a \n to the end of the username, it mimics hitting the enter key after entering your username
$telnetCon->print($CXusername);

# does the same as the previous command but for the password
$telnetCon->print($CXpassword);

#Wait for the login successful message
$telnetCon->waitfor();
}

sub login_alfresco{

my $ALusername = '';
my $ALpassword = '';
$mech->get('http://documents.ifds.group:8080/alfresco/faces/jsp/login.jsp');

my $res = $mech->res;
my $idfaces = '';

if($res->is_success){
    my $ff = $res->content;
    if($ff =~ /id="javax.faces.ViewState" value="(.*?)"/){
         $idfaces = $1;
    }
    else {
        print "javax.faces /Regex error?\n";
        die;
    }
}

print $idfaces, "\n";

#Send the get request for Alfresco
$mech->post('http://documents.ifds.group:8080/alfresco/faces/jsp/login.jsp',[
'loginForm:rediretURL' =>,
'loginForm:user-name' => $ALusername,
'loginForm:user-password' => $ALpassword,
'loginForm:submit' => 'Login',
'loginForm_SUBMIT' => '1',
'loginForm:_idcl' => ,
'loginForm:_link_hidden_' => ,
'javax.faces.ViewState' => $idfaces], **'Connection' =>'keep-alive'**);

$res = $mech->res;

open ALF, ">Alfresco.html";
print ALF $mech->response->as_string;

if($res->is_success){
    my $ff = $res->content;
    if($ff =~ /id="javax.faces.ViewState" value="(.*?)"/){
         $idfaces = $1;
    }
    else {
        print "javax.faces /Regex error?\n";
        die;
    }
}
print $idfaces, "\n";

#Logout
$mech->post('http://documents.ifds.group:8080/alfresco/faces/jsp/extension/browse/browse.jsp', [
'browse:serach:_option' => '0',
'browse:search' => ,
'browse:spaces-pages' => '20',
'browse:content-pages' => '50',
'browse_SUBMIT' => '1',
'id' => ,
'browse:modelist' => '',
'ref'=>'',
'browse:spacesList:sort' => ,
'browse:_idJsp7' => ,
'browse:sidebar-body:navigator' => ,
'browse:contentRichList:sort' => ,
'browse:act' => 'browse:logout',
'outcome' => 'logout',
'browse:panel' => ,
'javax.faces.ViewState' => $idfaces,])
}

How to ignore 'Certificate Verify Failed' error in perl?

nobody@example.com (Shahab) — 2011-07-22T19:25:47Z

I want to access a website where the certificate cannot be verified. I'm using WWW::Mechanize get request. So how would go about ignoring this and continues to connect to the website?

Thanks

use strict;use warnings;

use WWW::Mechanize;

$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0;
my $url = '';
my $mech = new WWW::Mechanize;



my $response = $mech->get($url);

print $response->as_string;

Dereferencing perl hashes

nobody@example.com (Charles) — 2011-07-22T18:17:31Z

Using Text::Ngram I have

my $c = ngram_counts($text, 3);
my %ct = %($c);

which doesn't work (Scalar found where operator expected). I think this is a combination of not knowing what I'm doing (still not very good with Perl) and being confused about what exactly I'm getting as output from Text::Ngram. Help? I just want to look at the generated n-grams:

my @keys = sort {$ct{$a} cmp $ct{$b} } keys %ct;
foreach my $k (@keys) {
    print "$k: $ct{$k}\n"
}

Edit: Stupid error on my part, thanks everyone.

How do I convert little Endian to Big Endian using a Perl Script?

nobody@example.com (John Smith) — 2011-07-22T18:14:00Z

I just want to take a file in linux which is in binary form and convert the data to big endian. I tried using the unpack("H*", $StringIn") but it didn't work.

Perl: Safe templating language

nobody@example.com (Nemo) — 2011-07-22T17:59:32Z

Here are already several questions in SO about the safe template languages, like:

but the above questions are for asp, ruby, python.

My question is: What templating language can allow to be edited by users in perl based web-app?

I want allow for users edit pages, (like in an wiki) with some programming possibilities, so full featured mean with cycles, conditionals, variable substitutions, includes and so on.

Is TT "enough safe"? Is here another solution as TT?

Perl problem 'require' the same file

nobody@example.com (lwijono) — 2011-07-22T17:28:15Z

I have a shared module in perl. The main program needs two files, first, a shared file (let's call it 'X'), and, second, a 'package' file. File 'X' is also included in the 'package' file using 'require'. When I compile this program it gives me the following error:

Undefined subroutine &main::trim called at testing.pl line 8.

My understanding is that perl couldn't find the trim() module. If I don't include the package file, then this will run without any problem.

Can anyone shed light on this problem?

These are my codes:

Main program: testing.pl

#!/usr/bin/perl -w

use strict;
use postgres;

require "shared.pl";

trim("als");

Package File: postgres.pm

#!/usr/bin/perl

package postgres;

use strict;
use DBI;

require "shared.pl";

1;

shared file: shared.pl

#!/usr/bin/perl

# =============
# shared module 
# =============

use strict;

sub trim($)
{
}

1;

How do I set the build path for E-P-I-C in Eclipse Galileo?

nobody@example.com (Craig) — 2011-07-22T17:24:44Z

I have E-P-I-C installed on Eclipse Galileo. When I go to run a Perl script nothing happens because I don't believe is any connection from Eclipse to the Perl SDK (is that the right term? I don't know if it is different because it's Perl).

I'm pretty sure it has something to do with C:\Perl\bin

If I click on Perl E-P-I-C project and click on properties I can then see Perl include Path. I have added the above but it didn't change anything.

What this comes down to is: How do I set up the build path for Perl in Eclipse Galileo?

perl ".../config.h, needed by `Makefile'" problem after OSX Lion upgrade

nobody@example.com (Johannes Ernst) — 2011-07-22T17:03:02Z

SOLVED. See at bottom.

Just upgraded to OSX Lion and trying to get my Perl install running again:

sudo /usr/bin/perl -MCPAN -e 'install "MODULENAME"'

with any value of MODULENAME that I tried (e.g. JSON) produces:

...
Checking if your kit is complete...
Looks good
Writing Makefile for JSON
make: *** No rule to make target `/System/Library/Perl/5.12/darwin-thread-multi-2level/CORE/config.h', needed by `Makefile'.  Stop.
  MAKAMAKA/JSON-2.53.tar.gz
  /Developer/usr/bin/make -- NOT OK

I can't find anything resembling config.h anywhere, the directory exists though ...

Not even this works:

/usr/bin/cpan CPAN

SOLVED: Download and install latest version of XCode from AppStore. Note that just downloading XCode from AppStore does not install it (why, Apple, oh why?) but only dumps an installer into /Applications. Run the installer, which will fix this issue.

How to use HTML::TokeParser to extract data

nobody@example.com (thebourneid) — 2011-07-22T16:52:41Z

I want to write a code to extract specific information from the imdb.com Awards Section. With the below snippet I can print the text as a whole

use strict; 
use warnings;
use autodie;
use utf8;
use WWW::Mechanize;
use HTML::TokeParser;

#Example
my $url = 'http://www.imdb.com/title/tt1375666/awards';

my $mech = WWW::Mechanize->new;
$mech->agent_alias( 'Windows Mozilla' );
$mech->get( $url );

if ($mech->find_link(text_regex => qr/(?:Academy Awards|Golden Globes)/i)) {

    my $tp = HTML::TokeParser->new(\$mech->content);

    while (my $token = $tp->get_tag('big')) {
        $token = $tp->get_trimmed_text('big');
        if ( $token =~ /(?:Academy Awards|Golden Globes)/ ) {

            print "$token\n";

        }
    }

}

but I don't know how to separate the different tokens because most of them have the same tags and also how to define the loop for each 'category/recipient' and print on new line if present.

my $year = $tp->get_trimmed_text();
my $result = $tp->get_trimmed_text();
my $award = $tp->get_trimmed_text();
my $category = $tp->get_trimmed_text();
my $recipient = $tp->get_trimmed_text();

print "$year $result $award $category $recipient\n"

$year Won Oscar $category $recipient1..n
etc.
$year Nominated Oscar $category $recipient1..n
etc.
$year Won Golden Globe $category $recipient1..n
etc
$year Nominated Golden Globe $category $recipient1..n
etc.

I'm not sure if this is the most efficient approach but I also tried HTML::TableExtract with much less success.

Thanks.

Sending email via Gmail

nobody@example.com (gangabass) — 2011-07-22T16:45:17Z

I have email sending code which doesn't work without any error messages (by "doesn't work" i mean all seams OK but i have no message in my mail box):

use strict;
use warnings;
use Email::Send;
use Email::Simple::Creator;

report_update();

sub report_update {

    my $mailer = Email::Send->new(
        {
            mailer      => 'SMTP::TLS',
            mailer_args => [
                Host     => 'smtp.gmail.com',
                Port     => 587,
                User     => $CONFIG{EMAIL_USER},
                Password => $CONFIG{EMAIL_PASS},
                Hello    => 'localhost',
            ]
        }
    );

    my $email = Email::Simple->create(
        header => [
            From    => $CONFIG{EMAIL_USER},
            To      => $CONFIG{TARGET_EMAIL},
            Subject => 'Updated info finded!',
        ],
        body => 'Updated info finded!',
    );

    eval { $mailer->send($email) };
    die "Error sending email: $@" if $@;

    print "Finished!\n";
}

Could you give me a hint what's wrong with it?

problems with Crypt::SSLeay and using HTTPS request?

nobody@example.com (Shahab) — 2011-07-22T14:36:33Z

I'm trying to connect to a website via HTTPS, by sending a WWW::Mechanize get request and whenever I try and run my script I get this error:

This Application has faile to start because libeay32_.dll was not found. Re-installing the application may fix this problem

And inside the command prompt I get:

Error GETing http...: can't load 'C:/strawberry/perl/vendor/lib/auto/Crypt/SSLeay/SSLeay.dll for module Crypt::SSLeay: load_file: The specified module could not be found (Crypt::SSLeay or IO::Socket::SSL no installed) at ...

I don't understand the problem because I'm very new to programming with Perl. Crypt::SSLeay is installed, the .dll is in the proper location and IO::Socket::SSL is also installed, or whenever I try to install it via cpan i get the libeay error again. The libeay32_.dll is located in the C:\straberry\c\bin. I don't have full access right to the computer because I am doing this from work. If someone could explain to me the reason for the problem it would be appreciated.

MongoDB--add/drop elements in a field of array of hash how to

nobody@example.com (Weiyan) — 2011-07-22T10:47:50Z

I am using perl MongoDBx::Class, following the tutorial I inserted the document below. The tags field is an array of hash. Tried to remove tag and add tag using mongodb's $pull and $addToSet function without success.

How to add/drop elements to/from tags field? If you are not a perl programmer, answer in mongodb shell command also wlcome.

Thanks.

my $novel = $novels_coll->insert({
   _class => 'Novel',
   title => 'The Valley of Fear',
   year => 1914,
   author => {
      first_name => 'Arthur',
      middle_name => 'Conan',
      last_name => 'Doyle',
   },
   added => DateTime->now(time_zone => 'Asia/Jerusalem'),
   tags => [
      { category => 'mystery', subcategory => 'thriller' },
      { category => 'mystery', subcategory => 'detective' },
      { category => 'crime', subcategory => 'fiction' },
   ],
});

This is the document inserted:

{
    "_id": {
        "$oid": "4e27eae3008a6ee40f000000"
    },
    "_class": "Novel",
    "added": "2011-07-21T12:01:23+03:00",
    "author": {
        "middle_name": "Conan",
        "last_name": "Doyle",
        "first_name": "Arthur"
    },
    "tags": [
        {
            "subcategory": "thriller",
            "category": "mystery"
        },
        {
            "subcategory": "detective",
            "category": "mystery"
        },
        {
            "subcategory": "fiction",
            "category": "crime"
        }
    ],
    "title": "The Valley of Fear",
    "year": 1914
}

Edit:

After deeper exploration of MongoDBX, the update method overrided offical MongoDB driver, so the $pull, $addToSet may not work. I will use this stupid method:

my $novel = $novel_coll->find_one({ some criteria });
my @tags = $novel->tags;
my @updated_tags = grep(unless($tag{category=>CATEGORY}, @tags);  #to pull out unwanted tag. Or use push to add new tag.
$novel->update({tags=>\@updated_tags});

I hope MongoDBx has method to updated arrayRef field.

Is this guaranteed to overwrite %hash1 with %hash2 when conflict arises?

nobody@example.com (asker) — 2011-07-22T08:59:55Z

%args = (%hash1,%hash2);

Is this guaranteed to overwrite %hash1 with %hash2 when conflict arises in Perl?

How can my Perl code catch Ctrl+D?

nobody@example.com (asker) — 2011-07-22T08:09:13Z

chomp($input = <>);

How do I know whether $input is Ctrl+D?

Perl replace nth substring in a string

nobody@example.com (user857223) — 2011-07-22T04:10:10Z

i have a scenario, i need to replace the nth sub-string in a string.

s/sub-string/new-string/g; will replace all the sub strings. but i need to do for a particular occurrence say (3rd Occurrence).

please help me with this

Thanks

Why do some functions in Perl have to be called with parens and others don't?

nobody@example.com (xenoterracide) — 2011-07-22T03:51:29Z

An example to illustrate is the Synopsis of my own Test::Version.

use Test::More;
use Test::Version 0.04;

# test blib or lib by default
version_all_ok();

done_testing;

I don't have to include parenthesis on done_testing(); I can simply call it. However when I've tried to call version_all_ok; ( note: First attempt at Dist::Zilla::Plugin::Test::Version failed this way) I get an error. Why is this?

Update Perhaps my example is not quite as good as I've thought. The actual error I've gotten is

Bareword "version_all_ok" not allowed while "strict subs" in use at t/release-test-version.t line 19.

and here's the full code

#!/usr/bin/perl

BEGIN {
  unless ($ENV{RELEASE_TESTING}) {
    require Test::More;
    Test::More::plan(skip_all => 'these tests are for release candidate testing');
  }
}

use 5.006;
use strict;
use warnings;
use Test::More;

eval "use Test::Version";
plan skip_all => "Test::Version required for testing versions"
    if $@;

version_all_ok; # of course line 19, and version_all_ok() works here.
done_testing;

The following should be relevant snippets pulled from Test::Version 1.0.0 for exportation.

use parent 'Exporter';
our @EXPORT = qw( version_all_ok ); ## no critic (Modules::ProhibitAutomaticExportation)
our @EXPORT_OK = qw( version_ok );

Why don't I see race conditions when my processes are writing to file?

nobody@example.com (Rubin) — 2011-07-21T22:35:19Z

I use the Parallel::ForkManager module for fetching some pages. Below is the relevant code snippet:

use Parallel::ForkManager;

open FILE,">myfile" or die "cann't open file$!";
$pm = new Parallel::ForkManager(5);

foreach $data (@all_data) {

    my $pid = $pm->start and next;
    #doing the fetching here and get the result on parsed_string

    print FILE $parsed_string;
    $pm->finish; # Terminates the child process
}

Could someone expain why the results are OK and don't overlap one with the other even there is more than one process writing to the same File ?

PERL -- VB Script migrate to new printer server, match & delete printer locally -- HELP with printer that have long share names..

nobody@example.com (Will Fix) — 2011-07-21T21:43:38Z

This script will effectively migrate to new print server and delete, for example, these printers (short share name):

printer name=\\p1\(share)Laserjet 1000 -- share name/UNC path=\\p1\share

printer name=\\p1\(share1)Laser 1000 -- share name/UNC path=\\p1\share1

If I have a printer with a long share name/UNC Path, it won't remove that printer:

printer name=\\p1\(share)Laserjet 1000 -- share name/UNC path=\\p1\(share)Laserjet1000

printer name=\\p1\(share1)Laser 1000 -- share name/UNC path=\\p1\(share1)UniversalHP

Rules:

I cannot use WMI, as not everyone has WMI running..

I need to stick to languages that do not require any framework to be installed..this is why i chose PERL and VBScript.

The parentheses always exists, and always has the correct share name in it.

Idea: I imagine I have to use "net view" to match the printer name with the actual share name..I want to implement something like this, to remove printers with long share names:

sub RemovePrinterLong
{
print "Long printer names:";
my @list = `net view $OldServer`;
foreach my $line (@list)
{
if($line =~ /sharename/i)
{
my($shr,$rest) = split(/Print/,$line);
$shr =~ s/\s+$//;
if($shr =~ /sharename\)/i)
{
print "\\\\$OldServer\\$shr\n"; 
}
#$line =~ /^\s*(.)\s+Print\s+/; $newLine = $1;
#print "=$newLine=";
}
}
}

Basically, I want it to catch if it's a long share name by catching the parentheses and then run a net view on the old server to create a vbs script to remove those printers with long share names...

Here is the PERL script:

#this script will not migrate novaPDF pritter
my @printers;
my %PQ2;
my %PQ;
my @NewPQ;
my $NewServer = "P3";
my $OldServer = "P1";

#Retrive print queues info from the new network print server
print "Generating a printer list on $NewServer..\n";
@NewPQ = `net view $NewServer`;


#Create a required TEMP folder on C:
system("md C:\\TEMP") if(not (-e "C:\\TEMP"));

#Create a VBScripts to enumerate network printer connections
open(OUTFILE,">C:\\TEMP\\EnumPQ.vbs") or die "Unable to create TEMP file";

print OUTFILE  "Option Explicit\n";
print OUTFILE  "Dim objNetwork, objPrinter, intDrive, intNetLetter\n";
print OUTFILE  "Set objNetwork = CreateObject(\"WScript\.Network\")\n";
print OUTFILE  "Set objPrinter = objNetwork.EnumPrinterConnections\n";
print OUTFILE  "For intDrive = 0 To (objPrinter.Count -1) Step 2\n";
print OUTFILE  "  intNetLetter = IntNetLetter +1\n";
print OUTFILE  "  Wscript.Echo objPrinter.Item(intDrive +1)\n";
print OUTFILE  "Next\n";
print OUTFILE  "Wscript\.Quit(1)\n";

close OUTFILE;

#Run VBScript EnumPQ.vbs to generate a list of connected network printers
print "Enumerating local printers...\n";
my @results = `cscript c:\\TEMP\\EnumPQ.vbs`;
print "Local printer enumeration complete\n";

my $FOUND = 0;
#Search for printer(s) on PQ1
foreach my $rec (@results)
{
    chomp $rec;

    next if($rec =~ /nova/i); #bypass nova PDF printer
    #Searching for old server in the form of \\ServerName
    if($rec =~ /\\\\$OldServer/i)
    {
        #Exp rec=\\P1\(05-103) HP Color LaserJet 4650 PS 6=
        push @printers, $rec;
        $FOUND = 1;
    }
}

if($FOUND)
{
    &RemovePrinter();
    &AddPrinter();
}
else
{
    print "No network printer on $OldServer found..\n"
}

exit 0; #exit main
#===============================================================================
#Creat a VB script to remove network printer(s)
#===============================================================================
sub RemovePrinter
{

   open(OUTFILE,">C:\\TEMP\\rmprint.vbs") or die "Error open outfile..";
   print OUTFILE 'Set WshNetwork = WScript.CreateObject("WScript.Network")'."\n\n";

   foreach my $printer (@printers)
   {
     $printer =~ m/^\\\\$OldServer\\\((.+)\)/i;
     $PQ2{$1} = "old printer";
   }

   foreach my $shrname (@NewPQ)
   {
     chomp $shrname;
     $shrname =~ m/^.+\((.+)\).+/i;
     $PQ{$1} = "New printer";
   }

   my @PQ2Printers = keys %PQ2;

   foreach my $prt (@PQ2Printers)
   {
      if(exists $PQ{$prt})
      {
         #Create VB Script to remove the found printers
         print OUTFILE "PrinterPath = \"\\\\$OldServer\\$prt\"\n";
         print OUTFILE "WshNetwork.RemovePrinterConnection PrinterPath, true, true\n\n";
      }
   }


   print OUTFILE  "Wscript\.Quit(1)\n";
   close OUTFILE;

   print "Deleting $OldServer printer(s)..\n";
   sleep 2;
   my $rm_results = `cscript c:\\TEMP\\rmprint.vbs`;
   #print "remove result:\n";
   #print $rm_results."\n";


}#end sub RemovePrinter
#===============================================================================
#Create a VB script to add network printers
#===============================================================================
sub AddPrinter
{
   open(OUTFILE,">C:\\TEMP\\addprint.vbs") or die "Error open outfile..";
   print OUTFILE 'Set WshNetwork = WScript.CreateObject("WScript.Network")'."\n\n";


   my @PQ2Printers = keys %PQ2;

   #if old printer exists on new server, map it.
   foreach my $prt (@PQ2Printers)
   {
      if(exists $PQ{$prt})
      {
         #Create VB Script to map the found printers to new server
         print OUTFILE "PrinterPath = \"\\\\$NewServer\\$prt\"\n";
         print OUTFILE "WshNetwork.AddWindowsPrinterConnection PrinterPath, true, true\n\n";
         print "Remapping $OldServer printer to: \\\\$NewServer\\$prt\n";
      }
   }

   print OUTFILE  "Wscript\.Quit(1)\n";
   close OUTFILE;

   sleep 2;
   my $add_results = `cscript c:\\TEMP\\addprint.vbs`;
   #print "Add result:\n";
   #print $add_results."\n";

}#end sub AddPrinter
#===============================================================================