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> </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.
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?
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.
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?
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';
}
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.
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
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 ";".
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.
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. :)
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?
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,])
}
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;
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.
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.
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?
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;
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?
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.
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"
I'm not sure if this is the most efficient approach but I also tried HTML::TableExtract with much less success.
Thanks.
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?
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.
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.
%args = (%hash1,%hash2);
Is this guaranteed to overwrite %hash1 with %hash2 when conflict arises in Perl?
chomp($input = <>);
How do I know whether $input is Ctrl+D?
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
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 );
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 ?
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
#===============================================================================