Re: Regex question.
1- Remove all the leading 000 from any field like acct# = 00037839842 should be 37939842 and Post# should be 1980 s/^0+//; 2- Want to format dates like birth = 02151956 should be 02/15/1956 my $date = $1/$2/$3/ if (/(\d\d)(\d\d)(\d\d\d\d)/) HTH Paul Kraus -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
RE: [Perl for Beginners] RE: Welcome to perlforbeginners
Here u go for the srvtst26.pl
rgds
venkat
*
#use diagnostics;
use integer;
#use File::Spec;
use Socket;
use FileHandle;
# Fork to create child daemon process #
unless ($pid = fork)
{
# Start of Child process
setpgrp(0, $$);
# Define the Constant values #
use constant PROTOCOLNAME = TCP;
use constant SRVPORTADDR = 5775;
use constant RCVTIMEOUT = 10;
use constant MAXRECVLENGTH = 4096;
use constant QUEUELEN = 200;
# Define initial variables #
$LogOpen = no;
# Set Month and Weekday Lists #
@MonthList = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
@WeekDayList = qw/Sun Mon Tue Wed Thu Fri Sat/;
# Set Current Date and Time variables #
($TimeSec, $TimeMin, $TimeHour, $Day, $MonthIdx, $Year, $WeekDay) = localtime(time);
$Year += 1900;
$Month = $MonthIdx + 1;
# Create Save Date Using Day Month Year
$SaveDate = ($Day-$MonthList[$MonthIdx]-$Year);
# Create Save Temp for Testing
#$SaveDate = ($TimeHour-$Day-$MonthList[$MonthIdx]-$Year);
# Main Body of the Program #
$DateTime = sprintf(%02d:%02d:%02d
${WeekDayList[$WeekDay]}-$Day-${MonthList[$MonthIdx]}-$Year, $TimeHour, $TimeMin,
$TimeSec);
write_log(AHD API Server - Start of Server Initialisation - $DateTime\n);
write_log(AHD API Server - Operating System Type is $^O\n);
# Setup the Listen Server Port #
listenserver(*SERVERSOCKET, SRVPORTADDR, PROTOCOLNAME, QUEUELEN);
# Continually Process Client connects #
while(1)
{
ACCEPT_CONNECTIONS:
# Accept Client connections#
write_log(AHD API Server - Waiting on Acceptance of Client Connection\n);
unless ($Remote_Address = accept (CHILDSOCKET, SERVERSOCKET))
{
write_log(AHD API Server - Client Accept Failure - $!\n);
redo ACCEPT_CONNECTIONS ;
}
$Remote_IP = inet_ntoa((unpack_sockaddr_in($Remote_Address))[1]);
write_log(AHD API Server - Accepted Client Connection from IP =
$Remote_IP\n);
autoflush CHILDSOCKET 1;
# Determine if data is ready #
write_log(AHD API Server - Now Doing Select\n);
$RBitsIn = '';
vec($RBitsIn, fileno(CHILDSOCKET), 1) = 1;
select($RBitsOut = $RBitsIn, undef, undef, RCVTIMEOUT);
if ($RBitsIn ne $RBitsOut)
{
write_log(AHD API Server - Client Receive Timeout of .RCVTIMEOUT.
seconds\n);
last ;
}
# sleep(3);
# Receive Client data #
write_log(AHD API Server - Now Receiving Data\n);
$rc = recv (CHILDSOCKET, $Buffer, MAXRECVLENGTH, 0);
unless (defined $rc)
{
write_log(AHD API Server - Client Receive Failure - $!\n);
last ;
}
$Buffer = ($Buffer\n);
write_log(AHD API Server - Buffer length = .length($Buffer).\n);
# print Return Code = ${rc} \n;
# if (defined $rc)
# {
# write_log(Return code is Defined\n);
# }
#
#
#
# if ($rc eq '')
# {
#write_log(Return code is Null\n);
# }
write_log(AHD API Server - Data = $Buffer\n);
# write_log(unpack('H354',$Buffer).\n);
#$Buffer = (\$NX_ROOT/bin/bop_cmd -f \$NX_ROOT/site/mods/scripts/cradd08.frg
\newcr('null','INFO','4','5','null','AOD','#Infoman','-','Created from Infoman Record
19075340','null','null')\\n);
# write_log(AHD API Server - Data2 = $Buffer\n);
# write_log(unpack('H354',$Buffer).\n);
# write_log(AHD API Server - Buffer length = .length($Buffer).\n);
# Process the passed data #
Dump Html file as output from CGI script
Greetings to all that is Perl Is it possible to specify using a cgi script to read and output a Pure HTML file as output.. so that it can process the form data.. and return a specific html file output to be returned at the browser end.. Thanks Sam
stdout+stderr to file?
I'm writing scripts that are basically wrappers for Linux shell commands.
I want to be able to 1) print messages to screen along with say the first
line of any STDERR, and 2) print messages, STDOUT, and STDERR to go to a
file.
The best I've come up with is something like the followng, which doesn't
include STDOUT...
open (LOG, $locations{log_file}) or die [fail]...;
#open (STDERR, LOG) or die [fail] Can't dup STDERR;
#open (STDOUT, LOG) or die [fail] Can't dup STDOUT;
select (LOG); $| = 1;# make unbuffered
sys (cp foobar baz,
'copy to baz', 0);
sub sys
{
my ($cmd, $english, $fatal) = (@_, 1);
feedback ($english);
print LOG `$cmd 21`;
if ($? == '0') {
feedback ([okay] $cmd);
return 1;
} else {
feedback ([fail] $cmd);
feedback ([error] $!$^E);
$failed = 1;
cleanup() if ($fatal==1);
return 0;
}
}
sub feedback
{
my $line = sprintf (%s %s, (strftime %H:%M, localtime), $_[0]);
print LOG $line\n;
$line = (substr $line, 0, 79).\n;
$emailtext .= $line;
print STDOUT $line;
}
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Perl Monitor MySQL Table
I am working on a project where machines will use a perl script to write to a table in a MySQL database. I want a perl script to run everytime there is a new entry, but I don't know how to trigger the perl script when there is a new entry (the perl to be triggered will be sitting on the same box as the database). I know how to do basic database stuff with DBI, but I am still a perl beginner. Thanks, Nick -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
Re: perl script for running an exe (OT)
Panneer Selvan wrote:
Hi,
By this program key functions are execute after running the exe.. I want to execute the key funtions before completion of exe
use Win32::GuiTest qw(FindWindowLike GetWindowText
SetForegroundWindow SendKeys);
system('EXE FILE NAME);
SendKeys({TAB});
SendKeys({ENTER});
I use a certain editor via its macro script language has capability can
launch then send keystrokes to an exe. The editor written in Delphi
which can send keystrokes. Maybe can do with Perl but I don't know how.
www.notetab.com
--
Alan.
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
looping script
Hi
Using WinNt and ActiveState 5.6
I have a script reading data from a modem. For some reason it will not run with a
while loop. (I'm using a module which I don't fully understand, yet)
I can run the script from the command line, let it finish and rerun it manually every
thing works fine (with some impact on resources which I can live with for the moment)
How do I make it rerun?
I tried wrapping the script in a
while(1){
use My::Module;
some script
exit;
}
and then run it from the command line but it does not stay live
Gosh! I hope this makes sense it looks like my medication needs a boost!
Assistance appreciated
Regards
Clinton
Re: looping script
On Wed, 2 Jul 2003, Clinton wrote:
Hi
Using WinNt and ActiveState 5.6
I have a script reading data from a modem. For some reason it will not run
with a while loop. (I'm using a module which I don't fully understand, yet)
I can run the script from the command line, let it finish and rerun it
manually every thing works fine (with some impact on resources which I
can live with for the moment)
How do I make it rerun?
I tried wrapping the script in a
while(1){
use My::Module;
some script
exit;
Remove the 'exit' and it should run in(fine)tely. :)
George P.
}
and then run it from the command line but it does not stay live
Gosh! I hope this makes sense it looks like my medication needs a boost!
Assistance appreciated
Regards
Clinton
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Re: using table_info()
Shaunn Johnson wrote:
Howdy:
I would like to use the table_info() method for getting
database / table metadata from a database. In this case,
PostgreSQL 7.2.x.
I am reading the Programming the Perl DBI book and
I am using the following for my script to get a list of
tables and get *some* information.
[snip]
#!/usr/bin/perl -w
# script to connect to Postgres do a count
# get a list of tables info (DDL) and make
# new DDL files to move to Oracle
#
# need table owner, table name, column, type
# and pass that into a file
#
# should be cool
use strict;
use diagnostics;
use DBI;
use POSIX 'strftime';
my $datestr=strftime '%d%B%Y',localtime;
# connect to postgres via DBI
my $dbh=DBI-connect('dbi:Pg:dbname=test_db', 'joe_user')
or die Can not connect: $!;
our $listo=getTable();
sub getTable() {
my $tabsth = $dbh-table_info();
while (my ($qual, $owner, $name, $type, $rem)=
# rename the name - table for fetching
# and remembering what it's called later
$tabsth-fetchrow_array() ) {
my $table = $name;
open (FILE, $name.dll) or die Snootch-to-the-nootch\n;
print FILE --Owner: $owner\n;
print FILE create $type $name (\n;
# statement
my $statement = select * from $table;
# prep and execute the SQL statemetn
my $sth = $dbh-prepare ($statement);
$sth-execute();
my $fields = $sth-{NUM_OF_FIELDS};
print FILE Number of fields: $fields\n\n;
# iterate through allthe fields and dump
# the field info
for (my $i = 0; $i $fields; $i++) {
my $type = $sth-{TYPE}-[$i];
my $prec = $sth-{PRECISION}-[$i];
print FILE $name\t$type\t$prec\n;
}
#print FILE $owner, $name\n;
#return $qual, $owner, $name, $type, $rem;
}
}
print $listo\n;
close (FILE);
$dbh-disconnect;
__END__
[/snip]
And so far, these are the results I am seeing.
[snip]
--Owner: joe
create TABLE temp_gaps (
Number of fields: 4
contract1042
d_eff_dt1082
gapd_eff_dt 1082
gapd_end_dt 1082
[/snip]
My question is: is it possible to just get
the $type to reflect what it's named for (as an
example, I can only assume that '1042' is
really 'CHAR' and '1082' is DATE. But I don't
want to go through some 1500 tables to figure
that out).
Hi Shaunn.
What you need is the 'type_info' method. Like this
my $type = $sth-{TYPE}-[$i];
my $type_name = $dbh-type_info($type)-{TYPE_NAME};
HTH,
Rob
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Authenticating to the proxy
Hullo Friends I need to authenticate to a proxy server in order to access the internet. How can I do this so that my lwp scripts may run ? I tried this but am still unable to connect to the net : use LWP::UserAgent; $ua = LWP::UserAgent-new; $ua-proxy(['http', 'ftp'] = 'http://myproxyserver:80'); $req = HTTP::Request-new(GET = 'http://www.google.com'); $req-proxy_authorization_basic(myusername, mypasswd); $res = $ua-request($req); print $res-content if $res-is_success; Also, how can I have access to the net through proxy using PPM ? I have set the user variables HTTP_proxy , HTTP_proxy_user and HTTP_proxy_pass but I still get the msg Could not locate a PPD file for... Thanks aman -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
RE: Last Logon of ALL users in the domain (U)
UNCLASSIFIED
Thank you both for the great script to do this.
I was doing it the long way, querying each DC, and getting the last logon
time of each user.
Where can I find more information on different methods/properties like you
used in the script?
-Original Message-
From: Tim Dumas [mailto:[EMAIL PROTECTED]
Sent: Thursday, June 12, 2003 2:00 PM
To: 'Leon'; 'Tillman, James'; 'Robert-Jan Mora'
Cc: 'perl'; 'win32'; 'Yahoo Beginner Perl'
Subject: RE: Last Logon of ALL users in the domain
If you want the Time of logon along with the date you can use this modified
version.
use Win32::OLE;
use Win32::OLE::Variant;
use Win32::OLE::NLS qw(:LOCALE :DATE);
my $domain = Win32::OLE-GetObject(WinNT://DomainHere);
foreach my $object (in $domain)
{
if ($object-{Class} eq 'User')
{
my $last_login;
if ($object-{LastLogin})
{
$last_login_date = $object-{LastLogin}-Date(DATE_LONGDATE);
$last_login_time = $object-{LastLogin}-Time();
}else
{
$last_login_date = Unknown;
$last_login_time = Unknown;
}
print $object-{Name} . = . $last_login_date . .
$last_login_time .\n;
}
}
Tim Dumas
-Original Message-
From: [EMAIL PROTECTED]
[mailto:[EMAIL PROTECTED] Behalf Of Leon
Sent: Thursday, June 12, 2003 12:03 PM
To: Tillman, James; Robert-Jan Mora
Cc: perl; win32; Yahoo Beginner Perl
Subject: RE: Last Logon of ALL users in the domain
This totally 100 percent worked.
Thank you so much
Tillman, James [EMAIL PROTECTED] wrote:
This works on my own domain from a Win2k or NT box:
use Win32::OLE;
use Win32::OLE::Variant;
use Win32::OLE::NLS qw(:LOCALE :DATE);
my $domain = Win32::OLE-GetObject(WinNT://IRM-NT);
foreach my $object (in $domain) {
if ($object-{Class} eq 'User') {
my $last_login;
if ($object-{LastLogin}) {
$last_login = $object-{LastLogin}-Date(DATE_LONGDATE)
}
else {
$last_login = Unknown;
}
print $object-{Name} . = . $last_login . \n
}
}
Just a thought...
jpt
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
RE: Authenticating to the proxy
just send me the same if any body replies to ur query, since i need to access the same rgds venkat -Original Message- From: Aman Thind [mailto:[EMAIL PROTECTED] Sent: Wednesday, 2 July 2003 4:20 PM To: [EMAIL PROTECTED] Subject: Authenticating to the proxy Hullo Friends I need to authenticate to a proxy server in order to access the internet. How can I do this so that my lwp scripts may run ? I tried this but am still unable to connect to the net : use LWP::UserAgent; $ua = LWP::UserAgent-new; $ua-proxy(['http', 'ftp'] = 'http://myproxyserver:80'); $req = HTTP::Request-new(GET = 'http://www.google.com'); $req-proxy_authorization_basic(myusername, mypasswd); $res = $ua-request($req); print $res-content if $res-is_success; Also, how can I have access to the net through proxy using PPM ? I have set the user variables HTTP_proxy , HTTP_proxy_user and HTTP_proxy_pass but I still get the msg Could not locate a PPD file for... Thanks aman -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
Re: perl script for running an exe
From: PANNEER SELVAN [EMAIL PROTECTED]
Here is a simple program which runs an exe and does two
key functions{ tab and enter}.. Basically i want to apply
these key functions after start of the exe.These keys
functions are required for successful completion of
executing the exe. Here the problem is system command
creates a child process and run the exe.. so i could not
able to give the key functions to the exe. By this program
key functions are execute after running the exe.. I want
to execute the key funtions before completion of exe
use Win32::GuiTest qw(FindWindowLike GetWindowText
SetForegroundWindow SendKeys);
system('EXE FILE NAME);
system(1, 'EXE FILE NAME);
or
use Win32::Process; # see the docs
And you will probably want to sleep($aFewSeconds) to give the program a chance to
start up.
SendKeys({TAB});
SendKeys({ENTER});
Is there any way to solve this problem?
HTH, Jenda
= [EMAIL PROTECTED] === http://Jenda.Krynicky.cz =
When it comes to wine, women and song, wizards are allowed
to get drunk and croon as much as they like.
-- Terry Pratchett in Sourcery
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
UTF-8 pack hurts socket I/O ?
Howdy, # Perly ;-?
### What I'm trying to do (the socket part) ###
I wrote in Perl CGI app for Xitami web server, which (my app) is LRWP
(Long_Running_Web_Process) - it does 'socket/connect' with web server on
startup and then sysread/syswrite to talk to the web server to handle requests
(output is in XML encoded in UTF-8), so if user points its web browser to
http://my_host/xmlData?arg=flows, it is feeded with xml data. # Actually, I've
taken an example of LRWP and modified it to suit my needs.
### Where's the problem? Working non-elegant, long solution [A] ###
I have to convert some texts from win-cp1250 to UTF-8, to properly send it xml.
First, I've did it like this (and this way it is working!):
Perl
require 5;
use strict;
use warnings;
use diagnostics;
my ( @chars, @uchars, @uints );
# win 2 UTF-8 transcoding:
# init {{
# char-s that I want to convert FROM
@chars = ( , , , , , , , , );
# UTF double-bytes that I want to convert TO
@uchars = ( 0xC4, 0x85, 0xC4, 0x87, 0xC4, 0x99, 0xC5, 0x82, 0xC3, 0xB3, 0xC5,
0x84, 0xC5, 0x9B, 0xC5, 0xBC, 0xC5, 0xBA );
@uints = ();
for( my $i=0 ; $i=$#chars ; $i++ ){
$uints[$i] = pack( S, ($uchars[2*$i+1]8) | $uchars[2*$i] );
}
# }} init
# there's buffer to convert:
$xmlBuf = Za gl ja; # this is like Brown fox jumps over .*
# let me ashame to do it like that (but it works!)
for( $i=0 ; $i( $#uchars / 2 ) ; $i++ ){
$f = $chars[$i];
$t = $uints[$i];
$xmlBuf =~ s/$f/$t/g;
}
# now $xmlBuf is written with syswrite back to webserver...
/Perl
### IMHO better UTF solution [B], but sysread fails? ###
Then I've commented all above solution and did:
Perl
require 5;
use strict;
use warnings;
use diagnostics;
# there's buffer to convert:
$xmlBuf = Za gl ja; # this is like Brown fox jumps over .*
$xmlBuf = pack( U*, map( ord($_), split( //, $xmlBuf ) ) );
# now $xmlBuf is written with syswrite back to webserver...
/Perl
In both [A] and [B] solutions I've also written $xmlBuf to a file and both
files were IDENTICAL. But second solution [B] causes that:
1) not whole buffer is seen in web-browser (?) although syswrite reports that
the same amount of bytes is written to $socket and ...
2) after writing this request reply, my app should wait in 'sysread $socket
...' call for next request, but sysread returns 0 bytes read (don't blocks)!
And this really beates me!
Any ideas why solution [A] is working, and [B] is better - but not working?
Best regards,
---
Grzegorz HaydukAkademia Grniczo-Hutnicza, EAIiE, KANiUP
P.S. ($OS, $PerlVer)=(Win98OSR2, v5.6.1);
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Re: Question about filehandles
From: Azubi CAI [EMAIL PROTECTED]
Hi there,
I need to substitute a string in a .rtf file with a string from an
HTML form. I thought about using placeholders in the .rtf document and
then searching and overwriting them with the data from the HTML form.
I tried it out with that code:
#!/usr/bin/perl -w
open PASSWD, test.rtf
or die nichts gefunden ($!) ;
while (PASSWD) {
chomp;
if (/welt/) {
s/welt/mars/;
}
}
there aren't any warn messages from the compiler, but the string
hallo welt hasn't changed into hallo mars. But whats' wrong? Or is
it a problem with the .rtf format?
You are not writing the results anywhere.
Anyway there is one more problem ... you will have to escape the
stuff you want to insert into the RTF. Plus it's sometimes not so
trivial to find the right spot to put the placeholders if you edit
the raw RTF and it's not guaranteed to work correctly if you enter
the placeholder in MSWord or some other editor (the editor may insert
some RTF markup into the placeholder!)
You may want to use my http://Jenda.Krynicky.cz/#Template::RTF
instead.
Jenda
= [EMAIL PROTECTED] === http://Jenda.Krynicky.cz =
When it comes to wine, women and song, wizards are allowed
to get drunk and croon as much as they like.
-- Terry Pratchett in Sourcery
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Re: Perl Monitor MySQL Table
From: Nick Diel [EMAIL PROTECTED] I am working on a project where machines will use a perl script to write to a table in a MySQL database. I want a perl script to run everytime there is a new entry, but I don't know how to trigger the perl script when there is a new entry (the perl to be triggered will be sitting on the same box as the database). I know how to do basic database stuff with DBI, but I am still a perl beginner. I think you will have to ask in some MySQL related list whether MySQL is able to trigger some external process on INSERT. I don't think it will. So you basicaly have two options. Either the script can be running all the time as a daemon and check for new entries once even N minutes or the script(s) that add the entries can trigger the script directly. How will they do this may depend on the operating system. It might be easiest if the script to trigger is a CGI and they use LWP::Simple to call it. Jenda = [EMAIL PROTECTED] === http://Jenda.Krynicky.cz = When it comes to wine, women and song, wizards are allowed to get drunk and croon as much as they like. -- Terry Pratchett in Sourcery -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
Re: combining array to scalar
Date sent: Tue, 1 Jul 2003 00:56:10 -0700 (PDT)
From: Ling F. Zhang [EMAIL PROTECTED]
Send reply to: [EMAIL PROTECTED]
Subject:combining array to scalar
To: [EMAIL PROTECTED]
say I have array:
@a=[I,LOVE,PERL]
I would like to make a scalar:
$b=I Love Perl\n
can I do this with a simple one-liner?
Assuming you meant
@a=(I,LOVE,PERL);
$b = join(' ', map {ucfirst(lc($_))} @a) . \n;
print $b;
Jenda
= [EMAIL PROTECTED] === http://Jenda.Krynicky.cz =
When it comes to wine, women and song, wizards are allowed
to get drunk and croon as much as they like.
-- Terry Pratchett in Sourcery
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Objects and inheritance....
Hi Folks,
I have an object called Cisco:cs2600. I have a constructor that will new
that will initialise all the object with all the relavant information.
Now, I call the constructor to create a new instance of this object.
$deviceType = Cisco::cs2600-new($systemObjectID);
So, now I have an object of a Cisco 2600. But that is not what I am
looking to manipulate. That mearly tells me what I can do with this type
of device. What I would like is to create an instance of a Cisco 2600
type.
The specific instance will have an IP address, Community string, etc.
associated with it.
So,
$device = Device-new($IPAddress, $CommunityString).
QUESTION1: I have declared Cisco::cs2600 class, can I just declare a
class called Device, or should it be Cisco::Device?
Now I know this is inheritance, and I know I should just include an ISA
in the top of the Device package like so:
package Device;
use strict;
@Device::ISA = qw( Cisco::cs2600 );
sub new {
$self = $_[0];
bless { _ipaddress = $_[1],
_community = $_[2]
};
}
QUESTION2: If I would like to initialise the DeviceType when should it
be done?
So for example, I have 10 devices all with different IPAddresses and
Community strings, but all Cisco 2600's, should I do this:
$deviceType = Cisco::cs2600-new($systemObjectID);
foreach $IPAddress ( keys %{$All_Network_Switches} ) {
$kit = Device-new($IPAddress, $All_Network_Switches{$IPAddress});
.do something with this kit, then get the next one.
}
Finally, in the 'do something with this kit,.', I would like to
get certain attributes for the deviceType, could I do something like
Device-get_DeviceType_information();
and this would call the method from Cisco::cs2600.
Thanks in advance for reading to here. As a special addition to the
persistent reader, I give you this special gifta 1 year subscription
to all my received spam ;-). Only kidding.
Thanks.
Hamish
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Fwd: RE: reading a text file - any takers
From: Biju Ramachandran [EMAIL PROTECTED]
To: [EMAIL PROTECTED], [EMAIL PROTECTED]
Subject: RE: reading a text file
Date: Mon, 30 Jun 2003 13:51:50 -0400
This is an extract from spl liscenece log file
06/16/03 10:07:46 NOTICE: ./spm_key (Ver.1.1.11) started to install
licenses.
06/16/03 10:09:37 INFO: (fd=195.0): SPM license connection from
[EMAIL PROTECTED]
035.cinegroupe.com[192.168.20.81] established
(client SPM-version 1.1.11 [1223])
06/16/03 10:09:37 INFO: (fd=195.0) OUT xsirender XSIBatAdv2X 3.0
(SOFTIMAGE) granted:1(1) (1 shared)
06/16/03 10:09:38 INFO: (fd=192.0): IN xsirender XSIBatAdv2X 3.0
(SOFTIMAGE) returned:1
Here is what I am trying to do:
When ever there is a Notice line.. zap the table and continue to do the
following
- get the host name from the SPM licence connection line like xsirender
with reference to the fd #
update the table with host name and fd# and host name
- look for OUT line with the same FD# get the tag name like XSIBatAdv2X
3.0 and check if its
granted - up date the table with tag name
- then look for IN line with the same fd# and delete the all the entreid
with the saem FD#
The point of all this to find out how many liscences are being used.
here is the tabke structure
id - autoincrement
fd#
userid
tag
hostname
time
Let me know if u need more info on this
Thanks
Biju
From: Dan Muey [EMAIL PROTECTED]
To: Biju Ramachandran [EMAIL PROTECTED],[EMAIL PROTECTED]
Subject: RE: reading a text file
Date: Mon, 30 Jun 2003 11:02:02 -0500
Hi there
Howdy
In perl how do I read a text file and search for multiple
use open() or possibly File::SLurp
perldoc -f open
perldoc File::Slurp or search.cpan.prg
matching patterns
Use regular expressions, this is a big topic.
if($text_file_guts =~ m/JoeMama/i) { ...
and once found, write it to an Mysql
use DBI;
perldoc DBI
My question would be: once what is found write what to mysql?
Perhaps more details would help us help you :)
Thanks
No sweat!
HTH
Dmuey
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
_
Protect your PC - get McAfee.com VirusScan Online
http://clinic.mcafee.com/clinic/ibuy/campaign.asp?cid=3963
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
_
The new MSN 8: advanced junk mail protection and 2 months FREE*
http://join.msn.com/?page=features/junkmail
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
RE: sockets: packing an inet sructure
In article [EMAIL PROTECTED], [EMAIL PROTECTED] (James Kipp) writes: $template = 'S n C4 x8'; $| = 1; socket(MY_SOCKET, AF_INET, SOCK_STREAM, 0) || die Socket: $!\n; $addr = (gethostbyname(10.1.101.12))[4]; $paddr = pack($template,AF_INET,$port,$addr); bind(MY_SOCKET, $paddr) || die $0: Cannot bind .. $!\n; How primitive...may I suggest IO::Socket::INET: $socket = IO::Socket::INET-new(PeerAddr = 10.1.101.12, Proto= tcp, PeerPort = $port); $port = 6668; Or perhaps POE::Component::IRC :-) -- Peter Scott http://www.perldebugged.com -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
RE: Perl Monitor MySQL Table
I don't think you can tell mysql to run any commands whena records is inserted. But what I do to achievge asimilar effect is this: In the table I have a INT(1) field, say, Proc. INSERT INTO Proc=1 ... Then I cron a script to do this every hour or whatever: SELECT ... WHERE Proc=1.. Foreach record returned: do what you want and if successful: UPDATE ... SET Proc=2 This way you can have many levels of processing and always be able to tell what's been done and what needs done. I also incorporate DATETIME fields for further control of doing things based on INSERTS/UPDATES/ETC HTH DMuey I am working on a project where machines will use a perl script to write to a table in a MySQL database. I want a perl script to run everytime there is a new entry, but I don't know how to trigger the perl script when there is a new entry (the perl to be triggered will be sitting on the same box as the database). I know how to do basic database stuff with DBI, but I am still a perl beginner. Thanks, Nick -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
RE: Dump Html file as output from CGI script
Greetings to all that is Perl
Howdy
Is it possible to specify using a cgi script to read and
output a Pure HTML file as output.. so that it can process
the form data..
Do you mean can it output an html form to a browser, process it on submit and return
html to the browser?
Sure can.
You simply have it print html code:
print 'htmlbodyh1Hello Suckers/h1/body/html';
You'll also need the proper headers.
I'd say look at the CGI module at search.cpan.org
It will help you greatly in form processing and output:
use warnings;
use strict;
use CGI qw(:standard);
print header();
if(param('action') =~ 'process') { print proc(); }
else { print mainpg(); }
sub proc {...
sub mainpg {...
Now if you're talking about reading a file and writing a file that can be done also.
perldoc -f open
perldoc File::Slurp
HTH
DMuey
and return a specific html file output to be returned at the
browser end..
Thanks
Sam
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Extract pst file
Hi List Is it possible to extract the contents of MS Outlook pst file using perl?. TIA Free multi-lingual web-based and POP3 email service with a generous 15MB of storage, a choice of themes for your mailbox, message filtering, plus spam and virus protection Sign up now: http://www.gawab.com -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
Re: Objects and inheritance....
Hamish,
There are lots of ways to do object orientedness and inheritance. How
you do it depends very much on the problem(s) you are trying to solve,
and often on personal style...I'll try to answer your questions in-line.
Hamish Whittal [EMAIL PROTECTED] writes:
Hi Folks,
I have an object called Cisco:cs2600. I have a constructor that will new
that will initialise all the object with all the relavant information.
Now, I call the constructor to create a new instance of this object.
$deviceType = Cisco::cs2600-new($systemObjectID);
So, now I have an object of a Cisco 2600. But that is not what I am
looking to manipulate. That mearly tells me what I can do with this type
of device. What I would like is to create an instance of a Cisco 2600
type.
The specific instance will have an IP address, Community string, etc.
associated with it.
So,
$device = Device-new($IPAddress, $CommunityString).
QUESTION1: I have declared Cisco::cs2600 class, can I just declare a
class called Device, or should it be Cisco::Device?
Well, is a 'Device' a generic thing, which Cisco::cs2600 is a kind of?
Or is 'Device' a part of a 'Cisco::cs2600'? Or is 'Device' a specific
kind of 'Cisco::cs2600'?
To pick the correct class relationship, it usually helps to work out
what the 'real life' relationships between the objects you are
modeling is. Things like a frumple is a kind of widget, all snaz's
contain a bar.
In this case, I'm guessing that the following statements are true: 'A
cs2600 is a kinda of Cisco Device', 'We may be modeling more than one
type of Cisco Device', and 'We may have to model Devices which are of
a different kind than Cisco.'
Given the above, and according to my personal style, I would make the
following directories/files:
NetDevice/
NetDevice.pm
NetDevice/Cisco/
NetDevice/Cisco/cs2600.pm
And set things up so that the top part of 'cs2600.pm' looks like this:
code
package NetDevice::Cisco::cs2600;
use strict;
use warnings;
use NetDevice;
our @ISA = qw/NetDevice/;
__END__
/code
Notice I'm leaving out a 'Cisco.pm' - I don't have enough meat yet to
justify it. If I had stuff which was specific to Cisco devices, I
would create Cisco.pm and modify the above file appropriately.
Now I know this is inheritance, and I know I should just include an ISA
in the top of the Device package like so:
package Device;
use strict;
@Device::ISA = qw( Cisco::cs2600 );
I think 'our @ISA = qw/Cisco::cs2600/;' is a more common syntax, but I
think the above works just as well.
sub new {
$self = $_[0];
bless { _ipaddress = $_[1],
_community = $_[2]
};
}
I don't think the above code works, but perhaps I'm missing something.
Usually a standard 'new' looks more like this:
sub new {
my $class = shift;
my @attr = @_;
my $self = bless {_ipaddress = $attr[0],
_community = $attr[1],
}, $class;
return $self;
}
QUESTION2: If I would like to initialise the DeviceType when should it
be done?
So for example, I have 10 devices all with different IPAddresses and
Community strings, but all Cisco 2600's, should I do this:
$deviceType = Cisco::cs2600-new($systemObjectID);
foreach $IPAddress ( keys %{$All_Network_Switches} ) {
$kit = Device-new($IPAddress, $All_Network_Switches{$IPAddress});
.do something with this kit, then get the next one.
}
I think that this would work with the scheme you mention above, but
you aren't using '$deviceType' - none of the '$kit's would have any
notion of being a Cisco::cs2600.
I would do the above like so:
foreach $IPAddress ( keys %{$All_Network_Switches} ) {
$kit = NetDevice::Cisco::cs2600-new($IPAddress, $All_Network_Switches{$IPAddress});
.do something with this kit, then get the next one.
}
However, there's a problem - the 'new' sub I wrote above doesn't know
how to handle systemObjectID's - which is one of the data members of
the Cisco device you described above. I've included a couple of files
at the bottom which show the way I've been solving this problem lately.
Finally, in the 'do something with this kit,.', I would like to
get certain attributes for the deviceType, could I do something like
Device-get_DeviceType_information();
and this would call the method from Cisco::cs2600.
If 'Device' ISA 'Cisco::cs2600', then yes, this would work. (This is
a class method, btw.)
Thanks in advance for reading to here. As a special addition to the
persistent reader, I give you this special gifta 1 year subscription
to all my received spam ;-). Only kidding.
I'd like to finish responding to your question with some code, and
another question. The code is what I came up with after thinking
about your problem. It may not be the right setup for your situation.
It follows the template I've been using lately for objects with an 'is
a kind of' relationship. It certainly isn't production-ready as-is.
What it does
create files in multi directories
Hi, How would I create a bunch of files with the same name, save them under the same root directory, but only in part of the subdirectories change one word in the text inside the files? ?Ronen Kfir System Administrator T.A.U Computing Division Tel: 972-3-6407416 Fax: 972-3-6405158 Cellular: 972-55-405910 E-mail: [EMAIL PROTECTED] -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
File move
Just want to check and make sure this snippet of code will do what I think it will.
Trying to copy all files from $reportsdir to $oldreportsdir
my $reportsdir = '/usr2/reports';
my $oldreportsdir = '/usr2/oldreports';
# Move everything from the report directory to the old report directory
opendir(DIR, $reportsdir) or die can't opendir $reportsdir: $!;
while (defined($file = readdir(DIR))) {
move($reportsdir/$file, $oldreportsdir/$file)
or die move failed: $!;
}
Tony
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
TCP/IP question
I think I'm missing a concept here...
I built a very simple TCP/IP server like the one on p. 441 of the Camel
book.
But my server only ever sees the first message from any given client.
Subsequent messages to my server are ignored. Does anyone know what I have
to do to get my server to handle more than one message?
#!/usr/bin/perl
use warnings;
use strict;
my ($server, $server_port, $client, $input);
use IO::Socket::INET;
$server_port = 33000;
$server = IO::Socket::INET-new (LocalPort = $server_port,
Type = SOCK_STREAM,
Reuse = 1,
Listen= 10 ) #or SOMAXCONN
or die Couldn't be a TCP server on port $server_port: $! \n;
while ($client = $server-accept()) {
my $n = sysread($client,$input,1000);
print $input\n ;
next; #THIS DOESN'T HELP
}
_
This message and any attachments are intended only for the use of the addressee and
may contain information that is privileged and confidential. If the reader of the
message is not the intended recipient or an authorized representative of the
intended recipient, you are hereby notified that any dissemination of this
communication is strictly prohibited. If you have received this communication in
error, please notify us immediately by e-mail and delete the message and any
attachments from your system.
Re: File move
Hi Anthony.
Anthony Akens wrote:
Just want to check and make sure this snippet of code will do what I think it will.
Trying to copy all files from $reportsdir to $oldreportsdir
Well you shouldn't be asking us, as we can make guesses - usually
Very Good Guesses - as to whether it will work, but we are not your
computer and it may not agree with us.
use strict; # always
use warnings; # usually
my $reportsdir = '/usr2/reports';
my $oldreportsdir = '/usr2/oldreports';
# Move everything from the report directory to the old report directory
opendir(DIR, $reportsdir) or die can't opendir $reportsdir: $!;
- You're checking that the 'opendir' works on $reportsdir. How about checking
that $oldreportsdir exists?
die No destination directory unless -d $oldreportsdir;
- You may prefer to
chdir $reportsdir;
first, so that you don't have to assemble the fully-qualified source file name.
while (defined($file = readdir(DIR))) {
move($reportsdir/$file, $oldreportsdir/$file)
- 'readdir' will give you directories as well as plain files. I suggest
my @files = grep -f, readdir(DIR);
foreach (@files) {
:
}
- What's this 'move' thing? Have you sneakily added 'use File::Copy without
telling us? If so, then
move($reportsdir/$file, $oldreportsdir);
is clearer.
- Do you want existing files of the same name overwritten? If not you need
to check first whether the destination file exists.
- Try your program first with 'copy' instead of 'move'. Then if it doesn't work
you shouldn't have done any damage.
or die move failed: $!;
}
Hmm. That's probably not the answer you were hoping for!
Even so HTH,
Rob
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Re: looping script
George P. wrote:
On Wed, 2 Jul 2003, Clinton wrote:
Hi
Using WinNt and ActiveState 5.6
I have a script reading data from a modem. For some reason it will not run
with a while loop. (I'm using a module which I don't fully understand, yet)
I can run the script from the command line, let it finish and rerun it
manually every thing works fine (with some impact on resources which I
can live with for the moment)
How do I make it rerun?
I tried wrapping the script in a
while(1){
use My::Module;
some script
exit;
Remove the 'exit' and it should run in(fine)tely. :)
George P.
}
and then run it from the command line but it does not stay live
Gosh! I hope this makes sense it looks like my medication needs a boost!
Assistance appreciated
Hi Clinton.
George is right, but I have this feeling there may be something else amiss.
For a start, you do still need to terminate the process somehow. Also, 'use'
is a compile-time statement and, while it can be placed anywhere, it doesn't
make sense to put it anywhere other than at the top of the containing file.
Go for
use strict; # always
use warnings; # usually
use My::Module;
my $finished;
while (1) {
some_script();
exit if $finished;
}
sub some_script {
:
}
HTH,
Rob
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Help with required fields checking
Hello:
I have a form entirely design with perl and it has many radio button.
What I trying to do is to make some fields required and if one is
missed, then the a subroutine is called and it will display the list of
the missed fields. Here is the sub:
sub process_form
{
my
($one,$two,$three,$four,$five,$six,$seven,$eight,$nine,$ten,$eleven,$twelve,$thirteen,$fourteen,$fifteen,
$sixteen,$seventeen,$eighteen,$nineteen,$twenty,$twentyone,$twentytwo) =
(param(one),param(two),param(three),param(four),param(five),param(six),param(seven),param(eight),
param(nine),param(ten),param(eleven),param(twelve),param(thirteen),param(fourteen),param(fifteen),param(sixteen),
param(seventeen),param(eighteen),param(nineteen),param(twenty),param(twentyone),param(twentytwo));
@required_fields = (one,two,three,
four,five,seven,eight,nine,eleven, twelve,fourteen,
sixteen,seventeen,nineteen); #these are the required fields
#here is another set of required fields depending upon some conditions
push(@required_fields, six) if $five eq Yes;
push(@required_fields, ten) if $nine eq No;
push(@required_fields, thirteen) if $twelve eq Difficult;
push(@required_fields, fifteen) if $fourteen eq Yes;
push(@required_fields, eighteen) if $seventeen eq Fair || $seventeen
eq Poor;
push(@required_fields, twenty) if $nineteen eq Less frequently||
$nineteen eq Discontinue;
@errors = ();
foreach my $i(@required_fields)
{
push(@errors, $i);
}
if([EMAIL PROTECTED])
{
print(Thank you for your time.);
}
else
{
print(Fill out the required fields number:);
foreach my $error(@errors)
{
print(li( $error ));
}
survey_form();
}
}
Apparently, the ckecking is not performed. I purposely left all the
field unchecked and it display the array @errors list. And when I
checked some radio button, it display the same list. It seems that I am
missing something here. Could someone tell me what it is and if there is
a better way of doing this.
Thanks.
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Re: create files in multi directories
Hi Ronen. You need to give us a foothold here. Ronen Kfir wrote: How would I create a bunch of files with the same name These files are to be a copy of an existing file? Or have some other prescribed content? save them under the same root directory but only in part of the subdirectories You have constant values of some sort which are the names of the root directory and of all the subdirectories? change one word in the text inside the files? You know what this word is, where it is to be found (in what is presumably a template file), and what it needs to be changed to? Programming is largely a process of rigorously defining a problem using a programming language. The bulk of the work is describing the problem! Cheers, Rob -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
Re: combining array to scalar
Jenda Krynicky wrote:
Assuming you meant
@a=(I,LOVE,PERL);
$b = join(' ', map {ucfirst(lc($_))} @a) . \n;
$b = qq@{[map\u\L$_,@a]}\n; # :-)
print $b;
John
--
use Perl;
program
fulfillment
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Re: stdout+stderr to file?
- Original Message -
From: isao [EMAIL PROTECTED]
Date: Tuesday, July 1, 2003 7:07 pm
Subject: stdout+stderr to file?
I'm writing scripts that are basically wrappers for Linux shell
commands.
I want to be able to 1) print messages to screen along with say
the first
line of any STDERR, and 2) print messages, STDOUT, and STDERR to
go to a
file.
The easeast thing would be to use IPC::Open3, you cna chekc out perldoc perlipc for
other methods of redirection.
The best I've come up with is something like the followng, which
doesn'tinclude STDOUT...
open (LOG, $locations{log_file}) or die [fail]...;
#open (STDERR, LOG) or die [fail] Can't dup STDERR;
#open (STDOUT, LOG) or die [fail] Can't dup STDOUT;
select (LOG); $| = 1;# make unbuffered
sys (cp foobar baz,
'copy to baz', 0);
sub sys
{
my ($cmd, $english, $fatal) = (@_, 1);
feedback ($english);
print LOG `$cmd 21`;
if ($? == '0') {
thats not how you check for the exit status. since you are on a linux system you can
probebly use POSIX::WEXITSTATUS
feedback ([okay] $cmd);
return 1;
} else {
feedback ([fail] $cmd);
feedback ([error] $!$^E);
$failed = 1;
cleanup() if ($fatal==1);
return 0;
}
}
sub feedback
{
my $line = sprintf (%s %s, (strftime %H:%M, localtime),
$_[0]);print LOG $line\n;
you should probebly use printf here
$line = (substr $line, 0, 79).\n;
$emailtext .= $line;
print STDOUT $line;
}
HTH,
Mark G
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
RE: TCP/IP question
McMahon, Christopher x66156 wrote:
I think I'm missing a concept here...
I built a very simple TCP/IP server like the one on p. 441 of the
Camel book.
But my server only ever sees the first message from any given
client. Subsequent messages to my server are ignored. Does anyone
know what I have to do to get my server to handle more than one
message?
#!/usr/bin/perl
use warnings;
use strict;
my ($server, $server_port, $client, $input);
use IO::Socket::INET;
$server_port = 33000;
$server = IO::Socket::INET-new (LocalPort = $server_port,
Type = SOCK_STREAM,
Reuse = 1,
Listen= 10 ) #or SOMAXCONN
or die Couldn't be a TCP server on port
$server_port: $! \n;
while ($client = $server-accept()) {
my $n = sysread($client,$input,1000);
print $input\n ;
Well, you're only calling sysread() once for each client and then going back
to call accept() to get the next client connection. You need to read in a
loop if you want to get all the client's input:
print while $client;
But, your server can only handle one client at a time. The kernel will queue
up additional clients (up to 10) as they connect, but they will be blocked
until the server gets around to them. You should investigate a forking
server. There's a (rather lengthy) example in perldoc perlipc.
next; #THIS DOESN'T HELP
}
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Re: TCP/IP question
- Original Message -
From: McMahon, Christopher x66156 [EMAIL PROTECTED]
Date: Wednesday, July 2, 2003 12:55 pm
Subject: TCP/IP question
Hello Christopher,
I think I'm missing a concept here...
I built a very simple TCP/IP server like the one on p. 441 of
the Camel
book.
But my server only ever sees the first message from any given
client.Subsequent messages to my server are ignored. Does anyone
know what I have
to do to get my server to handle more than one message?
#!/usr/bin/perl
use warnings;
use strict;
my ($server, $server_port, $client, $input);
use IO::Socket::INET;
$server_port = 33000;
$server = IO::Socket::INET-new (LocalPort = $server_port,
Type = SOCK_STREAM,
Reuse = 1,
Listen= 10 ) #or SOMAXCONN
or die Couldn't be a TCP server on port $server_port:
$! \n;
while ($client = $server-accept()) {
my $n = sysread($client,$input,1000);
print $input\n ;
next; #THIS DOESN'T HELP
}
you should read your loop carefully, in he while condition you will be accepting
connections, you then read a line from a socket, print it , and go onto accepting your
next connection with out closing the socket. hance your client gets stuck. This calls
for a double loop, one for accepting connections and another for reading the data
something like this:
while ($client = $server-accept()) {
while( sysread($client,$input,1000) ){
print $input ;
}
}
HTH,
Mark G
_
This message and any attachments are intended only for the use of
the addressee and
may contain information that is privileged and confidential. If
the reader of the
message is not the intended recipient or an authorized
representative of the
intended recipient, you are hereby notified that any dissemination
of this
communication is strictly prohibited. If you have received this
communication in
error, please notify us immediately by e-mail and delete the
message and any
attachments from your system.
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
RE: File move
Actually Rob your tips are very handy...
I have a nasty habit of posting only part of the code when
asking questions here, gotta break that habit.
use strict; # always
use warnings; # usually
Doing those :)
- What's this 'move' thing? Have you sneakily added 'use File::Copy without
telling us? If so, then
You guessed it
- Do you want existing files of the same name overwritten?
Yes
So now my code looks like this:
use strict;
use warnings;
use File::Copy;
my $reportsdir = '/usr2/reports';
my $oldreportsdir = '/usr2/oldreports';
die No destination directory unless -d $oldreportsdir;
opendir(DIR, $reportsdir) or die can't opendir $reportsdir: $!;
my @files = grep -f , readdir(DIR);
foreach (@files) {
move($reportsdir/$file, $oldreportsdir)
or die move failed: $!;
}
closedir(DIR);
Thanks for the help - mainly I want to make sure my code is
sane and refined. Your reply was very useful.
Tony
-Original Message-
From: Rob Dixon [mailto:[EMAIL PROTECTED]
Sent: Wednesday, July 02, 2003 11:57 AM
To: [EMAIL PROTECTED]
Subject: Re: File move
Hi Anthony.
Anthony Akens wrote:
Just want to check and make sure this snippet of code will do what I think it will.
Trying to copy all files from $reportsdir to $oldreportsdir
Well you shouldn't be asking us, as we can make guesses - usually
Very Good Guesses - as to whether it will work, but we are not your
computer and it may not agree with us.
use strict; # always
use warnings; # usually
my $reportsdir = '/usr2/reports';
my $oldreportsdir = '/usr2/oldreports';
# Move everything from the report directory to the old report directory
opendir(DIR, $reportsdir) or die can't opendir $reportsdir: $!;
- You're checking that the 'opendir' works on $reportsdir. How about checking
that $oldreportsdir exists?
die No destination directory unless -d $oldreportsdir;
- You may prefer to
chdir $reportsdir;
first, so that you don't have to assemble the fully-qualified source file name.
while (defined($file = readdir(DIR))) {
move($reportsdir/$file, $oldreportsdir/$file)
- 'readdir' will give you directories as well as plain files. I suggest
my @files = grep -f, readdir(DIR);
foreach (@files) {
:
}
- What's this 'move' thing? Have you sneakily added 'use File::Copy without
telling us? If so, then
move($reportsdir/$file, $oldreportsdir);
is clearer.
- Do you want existing files of the same name overwritten? If not you need
to check first whether the destination file exists.
- Try your program first with 'copy' instead of 'move'. Then if it doesn't work
you shouldn't have done any damage.
or die move failed: $!;
}
Hmm. That's probably not the answer you were hoping for!
Even so HTH,
Rob
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
RE: TCP/IP question
But my server only ever sees the first message from any
given client.
Subsequent messages to my server are ignored. Does anyone
know what I have
to do to get my server to handle more than one message?
#!/usr/bin/perl
use warnings;
use strict;
my ($server, $server_port, $client, $input);
use IO::Socket::INET;
$server_port = 33000;
$server = IO::Socket::INET-new (LocalPort = $server_port,
Type = SOCK_STREAM,
Reuse = 1,
Listen= 10 ) #or SOMAXCONN
or die Couldn't be a TCP server on port
$server_port: $! \n;
while ($client = $server-accept()) {
my $n = sysread($client,$input,1000);
print $input\n ;
next; #THIS DOESN'T HELP
}
Eventually what you are going to need to have is a forking server that
spawns child processes for each client connection. Other posters already
mentioned how you can fix your loop to handle more than one 'message' coming
from a client.
start off by reading:
perldoc -f fork
perldoc perlipc
perldoc IO::SOCKET
so you will something like:
while ($new_cli = $sock-accept()) {
if ($pid == fork) {
#child is now dealing with the ne client
#exit when this child is done and go to next.
exit;
} else {
#read from the new sock here
#close when done
}
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Re: combining array to scalar
From: John W. Krahn [EMAIL PROTECTED]
Jenda Krynicky wrote:
Assuming you meant
@a=(I,LOVE,PERL);
$b = join(' ', map {ucfirst(lc($_))} @a) . \n;
$b = qq@{[map\u\L$_,@a]}\n; # :-)
($b=lc@a\n)=~s/\b(.)/\U$1/g;
or
($b=[EMAIL PROTECTED])=~s/\b(.)/\U$1/g; # :-))
Jenda
= [EMAIL PROTECTED] === http://Jenda.Krynicky.cz =
When it comes to wine, women and song, wizards are allowed
to get drunk and croon as much as they like.
-- Terry Pratchett in Sourcery
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
-w vs. use warnings
Greetings! Is there any difference between #!/bin/perl -w code and #!/bin/perl use warnings; code ? Thanx! -Michael -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
RE: -w vs. use warnings
Michael, Read 'perlexwarn' in the perl documentation for a complete discussion. HTH, Charles K. Clarkson -- Head Bottle Washer, Clarkson Energy Homes, Inc. Mobile Home Specialists 254 968-8328 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
RE: -w vs. use warnings
Charles K. Clarkson wrote at Wed, 02 Jul 2003 13:43:26 -0500: Read 'perlexwarn' in the perl documentation ^ Better to read perldoc perllexwarn ^^ for a complete discussion. Greetings, Janek -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
Thanks!! RE: TCP/IP question
Thanks to all who answered! I don't need for this process to fork
(yet!), but thanks for the pointers.
I thought I was reading for new messages from the same client, but
instead I was looking for a new client while hanging on my first client. I
was missing a whole level of the process. The difference is clear to me
now, this makes all kinds of sense.
-Chris
-Original Message-
From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED]
Sent: Wednesday, July 02, 2003 11:39 AM
To: McMahon, Christopher x66156
Cc: [EMAIL PROTECTED]
Subject: Re: TCP/IP question
- Original Message -
From: McMahon, Christopher x66156 [EMAIL PROTECTED]
Date: Wednesday, July 2, 2003 12:55 pm
Subject: TCP/IP question
Hello Christopher,
I think I'm missing a concept here...
I built a very simple TCP/IP server like the one on p. 441 of
the Camel
book.
But my server only ever sees the first message from any given
client.Subsequent messages to my server are ignored. Does anyone
know what I have
to do to get my server to handle more than one message?
#!/usr/bin/perl
use warnings;
use strict;
my ($server, $server_port, $client, $input);
use IO::Socket::INET;
$server_port = 33000;
$server = IO::Socket::INET-new (LocalPort = $server_port,
Type = SOCK_STREAM,
Reuse = 1,
Listen= 10 ) #or SOMAXCONN
or die Couldn't be a TCP server on port $server_port:
$! \n;
while ($client = $server-accept()) {
my $n = sysread($client,$input,1000);
print $input\n ;
next; #THIS DOESN'T HELP
}
you should read your loop carefully, in he while condition you will be
accepting connections, you then read a line from a socket, print it , and go
onto accepting your next connection with out closing the socket. hance your
client gets stuck. This calls for a double loop, one for accepting
connections and another for reading the data something like this:
while ($client = $server-accept()) {
while( sysread($client,$input,1000) ){
print $input ;
}
}
HTH,
Mark G
_
This message and any attachments are intended only for the use of
the addressee and
may contain information that is privileged and confidential. If
the reader of the
message is not the intended recipient or an authorized
representative of the
intended recipient, you are hereby notified that any dissemination
of this
communication is strictly prohibited. If you have received this
communication in
error, please notify us immediately by e-mail and delete the
message and any
attachments from your system.
Today is sen, lin 2, 2003.*
Just got the Learning More Perl aka PORM, aka the alpaca book today. It does a nice job of building up examples and models, explaining enough of the underlying structure for complex data structures, references, etc. so that one can see a little of the how and why (though still without too many of the messy technical details). A nice gentle introduction to modules early one (with, I assume, more to come later). My vocabulary is expanding, I can now throw off phrases like anonymous array constructor and marshalling (I thought that was 'serializing') as if I knew what I was talking about; I'm sure I'll be dreaming of package names and autovivification tonight. Nice book; if you like(d) the Learning Perl approach, you'll like this even more (that is unless you haven't been doing your homework). -K * in Oogaboogoo -- Kevin Pfeiffer International University Bremen -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
Re: Today is sen, lin 2, 2003.*
Kevin - Thanks for the rec! I've been eyeing that book from my Safari account. I've been suffering a bout of I've been diddling with Perl since 1995, don't you think I'd know it by now? Keyword: diddling. I think if I'd been lucky enough to have a job *doing* something with Perl, I'd be way better off, now. Just a tidbit from my TMI file. - Glenn Becker On Wed, 2 Jul 2003, Kevin Pfeiffer wrote: Just got the Learning More Perl aka PORM, aka the alpaca book today. It does a nice job of building up examples and models, explaining enough of the underlying structure for complex data structures, references, etc. so that one can see a little of the how and why (though still without too many of the messy technical details). A nice gentle introduction to modules early one (with, I assume, more to come later). My vocabulary is expanding, I can now throw off phrases like anonymous array constructor and marshalling (I thought that was 'serializing') as if I knew what I was talking about; I'm sure I'll be dreaming of package names and autovivification tonight. Nice book; if you like(d) the Learning Perl approach, you'll like this even more (that is unless you haven't been doing your homework). -K * in Oogaboogoo -- +-+ There are no motionless targets +-+ -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
Child signal problem
I'm having a problem in a rather large program, so I've written this small
example to illustrate.
What this does is fork a process, then exec in the child to run a separate
program without waiting. In reality my main program doesn't end, so I need
to reap the children as they finish. After I exec the child process, I move
on and open another program as a pipe, using its output.
My problem is that this other program I open as a pipe, when it finishes,
sends the CHLD signal to my main program, so my signal processing happens
before the close statement.
#!/usr/bin/perl -w
use strict;
use POSIX :sys_wait_h;
$SIG{CHLD} = sub {
my $kid;
do {
$kid = waitpid(-1, WNOHANG);
print Child process $kid finished\n if $kid 0;
} until $kid == -1;
};
my $child_pid;
if ($child_pid = fork) {
print Forking process $child_pid\n;
} elsif (defined $child_pid) {
exec('banner test');
exit; #just in case
} else {
die Cannot fork: $!;
}
open LS, ls | or die Cannot open ls: $!;
while (LS) {
print;
}
close LS or warn Cannot close ls: $!;
print \n;
My output looks like this:
# ## #
## # #
## #
### #
## ## #
### #
Child process 29348 finished
Forking process 29348
Child process 29349 finished
limits.cfg
pumpWarn.pl
pumpd.pl
sigTest.pl
Cannot close ls: No child processes at sigTest.pl line 29.
So, the signal sub is reaping my piped program before the close, which then
warns the process is already gone.
Should I do anything about this or just not warn on this close statement?
-Mark
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Re: combining array to scalar
Jenda Krynicky wrote:
Date sent: Tue, 1 Jul 2003 00:56:10 -0700 (PDT)
From: Ling F. Zhang [EMAIL PROTECTED]
Send reply to: [EMAIL PROTECTED]
Subject:combining array to scalar
To: [EMAIL PROTECTED]
say I have array:
@a=[I,LOVE,PERL]
I would like to make a scalar:
$b=I Love Perl\n
can I do this with a simple one-liner?
Assuming you meant
@a=(I,LOVE,PERL);
$b = join(' ', map {ucfirst(lc($_))} @a) . \n;
print $b;
FWIW there's no need for the explicit parameter to 'lc' or
the parentheses:
$b = join ' ', map {ucfirst lc} @a;
Rob
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
how to remove last comma in file?
Howdy:
First off, many thanks to all (esp. R. Dixon and T. Lowery)
for the help with the 'using table_info()' thread.
I'm just about done with that script, but I have
one tiny problem.
In my SECOND while loop, I place a comma (,) at the end
so that when the *.ddl files are built, it looks
just like I've done it by hand. And close to the
way I want to use the scripts for porting to Oracle.
Almost.
I have one comma too many and I would like to know
how can I either:
1) go back over the files AFTER they're done and
remove the very last comma in the file
2) set up the loop statement so that I only put
commas on all of the columns except for the last row
of data.
Are either of these possible?
I am including the script in case anyone is interested
in how it's set up. Yes, I know it could be shorter
and much, much cleaner - please feel free to muck
with it and pass on hints to making it better.
[snip]
#!/usr/bin/perl -w
use strict;
use warnings;
use DBI;
use POSIX 'strftime';
use Cwd;
# hey! this works!
# 02 Jul 03 - 1551EST
# script to get a list of tables from
# PostgreSQL and then get the table
# structure
# thought I had a copy of this somewhere else ...
# 2 Jul 03 -X
# set up some variables
my $datestr=strftime '%d%B%Y',localtime;
# connect to the database
my $dbh=DBI-connect('dbi:Pg:dbname=test_db', 'joe_user')
or die Can not connect: $!;
# set up query
my $sql = qq|
SELECT tablename, tableowner
FROM pg_tables
where tablename like 't_%'
order by 1
|;
# test the database handler and prep the sql statements for
# execution
my $sth=$dbh-prepare($sql) or die Error =, DBI::errstr;
# check for errors
unless ($sth-execute) {
print\n\tExecute failed for stmt:\n\t$sql\nError = , DBI::errstr;
$sth-finish;
$dbh-disconnect;
die \n\t\tClean up finished\n;
}
while ( my($table, $tableowner)=$sth-fetchrow ) {
open (FILE, $tableowner\.$table.ddl);
print FILE connect $tableowner/$tableowner;\n\n;
print FILE create table $table (\n;
print Starting ddl build of $table...\n;
# statement
my $statement =
SELECT
a.attname,
format_type(a.atttypid, a.atttypmod)
FROM pg_class c, pg_attribute a
WHERE c.relname = '$table'
AND a.attnum 0 AND a.attrelid = c.oid
AND c.relkind = 'r'
AND c.relname not like 'pg_%'
ORDER BY a.attnum, c.relname
;
# prep and execute the SQL statement
my $sth = $dbh-prepare ($statement);
$sth-execute();
while ( my($first, $second)=$sth-fetchrow ) {
print FILE $first\t\t$second,\n;
}
print FILE )\n;
print FILE ;\n;
print FILE END;\n;
}
print Done.\n;
close (FILE);
$dbh-disconnect;
__END__
[/snip]
Thanks!
-X
Simplest way to send mail from CGI script
Greetings list does anyone have the script which uses the minimal LIB or modules to send an email to the administrator.. I already have got cgiemail running.. but I want to customize it .. and it wont let me!.. So I decided to look at other options where they all have there own requirements.. Finally I concluded that I need to do a custom script -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
RE: Simplest way to send mail from CGI script
Greetings list Go to cpan and check out Mail::Sender or Net::SMTP does anyone have the script which uses the minimal LIB or modules to send an email to the administrator.. HTH Dmuey -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
Re: how to remove last comma in file?
Hi Shaunn.
Shaunn Johnson wrote:
Howdy:
First off, many thanks to all (esp. R. Dixon and T. Lowery)
for the help with the 'using table_info()' thread.
I'm just about done with that script, but I have
one tiny problem.
In my SECOND while loop, I place a comma (,) at the end
so that when the *.ddl files are built, it looks
just like I've done it by hand. And close to the
way I want to use the scripts for porting to Oracle.
Almost.
I have one comma too many and I would like to know
how can I either:
1) go back over the files AFTER they're done and
remove the very last comma in the file
2) set up the loop statement so that I only put
commas on all of the columns except for the last row
of data.
Are either of these possible?
I am including the script in case anyone is interested
in how it's set up. Yes, I know it could be shorter
and much, much cleaner - please feel free to muck
with it and pass on hints to making it better.
[snip bulk of script]
I think it's this comma you're talking about?
while ( my($first, $second)=$sth-fetchrow ) {
print FILE $first\t\t$second,\n;
}
Firstly, I'm surprised the 'fetchrow' method still works
with 'DBI'. What I would normally call here is
'fetchrow_array' which returns a list, regardless of
context. Anyway, the answer...
The classical solution is to print a comma /before/
each record unless it is the first record. This is
often easier because checking for the first item
is usually easier than checking for the last. In this
case though, the most straightforward way is to count
the number of rows you've printed and compare it with
$sth-rows to see if it needs terminating. Like this
my $row = 0;
while ( my($first, $second) = $sth-fetchrow ) {
print FILE $first\t\t$second;
print , unless ++$row = $sth-rows;
print \n;
}
HTH,
Rob
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Re: how to remove last comma in file?
Rob Dixon wrote:
Hi Shaunn.
Shaunn Johnson wrote:
Howdy:
First off, many thanks to all (esp. R. Dixon and T. Lowery)
for the help with the 'using table_info()' thread.
I'm just about done with that script, but I have
one tiny problem.
In my SECOND while loop, I place a comma (,) at the end
so that when the *.ddl files are built, it looks
just like I've done it by hand. And close to the
way I want to use the scripts for porting to Oracle.
Almost.
I have one comma too many and I would like to know
how can I either:
1) go back over the files AFTER they're done and
remove the very last comma in the file
2) set up the loop statement so that I only put
commas on all of the columns except for the last row
of data.
Are either of these possible?
I am including the script in case anyone is interested
in how it's set up. Yes, I know it could be shorter
and much, much cleaner - please feel free to muck
with it and pass on hints to making it better.
[snip bulk of script]
I think it's this comma you're talking about?
while ( my($first, $second)=$sth-fetchrow ) {
print FILE $first\t\t$second,\n;
}
Firstly, I'm surprised the 'fetchrow' method still works
with 'DBI'. What I would normally call here is
'fetchrow_array' which returns a list, regardless of
context. Anyway, the answer...
The classical solution is to print a comma /before/
each record unless it is the first record. This is
often easier because checking for the first item
is usually easier than checking for the last. In this
case though, the most straightforward way is to count
the number of rows you've printed and compare it with
$sth-rows to see if it needs terminating. Like this
my $row = 0;
while ( my($first, $second) = $sth-fetchrow ) {
print FILE $first\t\t$second;
print , unless ++$row = $sth-rows;
print \n;
}
Written in haste, and my apologies to all. The value of
$sth-rows isn't in general guaranteed for 'select'
statements as the database will do its filtering as
required by subsequent 'fetch' operations. So we revert
to the less obvious but fully functional 'classical'
solution:
my $row = 0;
while ( my($first, $second) = $sth-fetchrow ) {
print \n, if $row++;
print FILE $first\t\t$second;
}
print \n;
Rob
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
RE: how to remove last comma in file?
-Original Message-
From: Rob Dixon [mailto:[EMAIL PROTECTED]
Sent: Wednesday, July 02, 2003 3:15 PM
To: [EMAIL PROTECTED]
Subject: Re: how to remove last comma in file?
Rob Dixon wrote:
Hi Shaunn.
Shaunn Johnson wrote:
Howdy:
First off, many thanks to all (esp. R. Dixon and T. Lowery)
for the help with the 'using table_info()' thread.
I'm just about done with that script, but I have
one tiny problem.
In my SECOND while loop, I place a comma (,) at the end
so that when the *.ddl files are built, it looks
just like I've done it by hand. And close to the
way I want to use the scripts for porting to Oracle.
Almost.
I have one comma too many and I would like to know
how can I either:
1) go back over the files AFTER they're done and
remove the very last comma in the file
2) set up the loop statement so that I only put
commas on all of the columns except for the last row
of data.
Are either of these possible?
I am including the script in case anyone is interested
in how it's set up. Yes, I know it could be shorter
and much, much cleaner - please feel free to muck
with it and pass on hints to making it better.
[snip bulk of script]
I think it's this comma you're talking about?
while ( my($first, $second)=$sth-fetchrow ) {
print FILE $first\t\t$second,\n;
}
Firstly, I'm surprised the 'fetchrow' method still works
with 'DBI'. What I would normally call here is
'fetchrow_array' which returns a list, regardless of
context. Anyway, the answer...
The classical solution is to print a comma /before/
each record unless it is the first record. This is
often easier because checking for the first item
is usually easier than checking for the last. In this
case though, the most straightforward way is to count
the number of rows you've printed and compare it with
$sth-rows to see if it needs terminating. Like this
my $row = 0;
while ( my($first, $second) = $sth-fetchrow ) {
print FILE $first\t\t$second;
print , unless ++$row = $sth-rows;
print \n;
}
Written in haste, and my apologies to all. The value of
$sth-rows isn't in general guaranteed for 'select'
statements as the database will do its filtering as
required by subsequent 'fetch' operations. So we revert
to the less obvious but fully functional 'classical'
solution:
my $row = 0;
while ( my($first, $second) = $sth-fetchrow ) {
print \n, if $row++;
print FILE $first\t\t$second;
}
print \n;
Or,
my $row = 0;
while ( my($first, $second) = $sth-fetchrow ) {
print , if $row++;
print FILE $first\t\t$second\n;
}
-Mark
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
While loop, confused...
Hi all!
I have this while loop in my script:
while (($type ne Windows) || ($type ne Linux)) {
print Enter TYPE of server to build. Linux or Windoze [linux, windows]:
\n;
$type = STDIN;
chomp $type;
$type =~ tr/a-z/A-Z/;
if (($type eq LINUX) || ($type eq L)) {
$type = Linux; }
if (($type eq WINDOWS) || ($type eq W)) {
$type = Windows; }
}
I had hoped that it would prompt the user until they made a valid
choice, either L, linux, w or windows. Instead it loops over and over
even if valid input is received. What am I doing wrong here?
I have another while loop that works just fine:
while ($LUN !~ /\d+.\d+.\d+.\d+/) {
print Enter LUN to build boot partition on. LUN Format is 3.0.0.33
[X.X.X.X]: \n;
$LUN = STDIN;
chomp $LUN; }
Thanx!
Re: While loop, confused...
Bill Akins wrote:
Hi all!
Hello,
I have this while loop in my script:
while (($type ne Windows) || ($type ne Linux)) {
Your problem is that you are using or when you should be using and.
print Enter TYPE of server to build. Linux or Windoze [linux, windows]:
\n;
$type = STDIN;
chomp $type;
$type =~ tr/a-z/A-Z/;
if (($type eq LINUX) || ($type eq L)) {
$type = Linux; }
if (($type eq WINDOWS) || ($type eq W)) {
$type = Windows; }
}
while ( $type ne 'Windows' and $type ne 'Linux' ) {
print Enter TYPE of server to build. Linux or Windoze [linux,
windows]:\n;
chomp( $type = ucfirst lc STDIN );
$type = 'Windows' if $type eq 'W';
$type = 'Linux' if $type eq 'L';
}
John
--
use Perl;
program
fulfillment
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
match count
I use /pattern/g to progressively match a string (who
content is read from a file)
I want the cut the string off after the n-th match (if
there is no n-th match, the string is unaltered)
how can I do this without using a loop?
right now, I am doing this:
while ($string =~ /pattern/g){
$count++;
if ($count $max_count){
$string = substr($string,0,pos($string));
last;
}
}
I know about $', $` (and what's the third one?), but I
just can't figure out how to apply them in this case.
thank you!
__
Do you Yahoo!?
SBC Yahoo! DSL - Now only $29.95 per month!
http://sbc.yahoo.com
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Re: match count
It was Wednesday, July 02, 2003 when Ling F. Zhang took the soap box, saying:
: I use /pattern/g to progressively match a string (who
: content is read from a file)
: I want the cut the string off after the n-th match (if
: there is no n-th match, the string is unaltered)
: how can I do this without using a loop?
: right now, I am doing this:
:
: while ($string =~ /pattern/g){
: $count++;
: if ($count $max_count){
: $string = substr($string,0,pos($string));
: last;
: }
: }
:
: I know about $', $` (and what's the third one?), but I
: just can't figure out how to apply them in this case.
I'd use split in this case.
my @parts = split /(pattern)/, $string, $max_count;
pop @parts while @parts ($max_count)x2;
$string = join '', @parts;
Here, we're split()ing on a captured pattern, but only for the maximum
number of allowed segments. This will store the segments and matched
split strings in @parts sequentially.
Next, we take elements off the end of @parts untill the size of the
list is equal to the twice the max count. the max count is doubled
because we've also stored the delimiters from the split.
Finally, we put the string back together.
Casey West
--
Shooting yourself in the foot with AIX
You can shoot yourself in the foot with either a .38 or a .45.
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Newlines, control characters, etc
I'm trying to copy data from one database field to another. The problem is
that the field contains various newline and other types of control
characters. Whenever the script runs, it processes those as perl code
instead of data like I'd like it to. How can I prevent it from doing this?
Here is an example of what is happening.
$variable = Some data\nSome more data\n\nBlah Blah
This variable was populated from an SQL table. I'm trying to create a valid
SQL scripts file so I do the following.
print FILE INSERT into table (field) VALUES ('$variable');
The file gets created just fine, but when I view the file it looks like
this:
INSERT into table (field) VALUES ('Some Data
Some more data
Blah Blah
Basically, I'd like it to look exactly as it is stored in the
variable...which would be like this:
INSERT into table (field) VALUES ('Some data\nSome more data\n\nBlah
Blah;
What do I need to do?
Thank you very much!!
==
NOTICE - This communication may contain confidential and privileged
information that is for the sole use of the intended recipient. Any viewing,
copying or distribution of, or reliance on this message by unintended
recipients is strictly prohibited. If you have received this message in
error, please notify us immediately by replying to the message and deleting
it from your computer.
==
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
RE: While loop, confused...
while (($type ne Windows) || ($type ne Linux)) {
Right here, you must have the full string Windows or Linux
Yes, correct.
print Enter TYPE of server to build. Linux or Windoze
[linux, windows]:
\n;
$type = STDIN;
chomp $type;
$type =~ tr/a-z/A-Z/;
Here you uppercase the response, so you will have L or
LINUX but never Linux
True, but further processing below (still inside the loop) will set the
type to either Windows or Linux. Since it is set to either Linux or
Windows before the loop is finished, will it not stop the loop? Maybe
not stop it but when loop is run again shouldn't it recompare $type
variable to Linux and to Windows?
if (($type eq LINUX) || ($type eq L)) {
$type = Linux; }
Set var to Linux in the above line.
if (($type eq WINDOWS) || ($type eq W)) {
$type = Windows; }
Set var to Windows in above line.
}
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Re: While loop, confused...
In article [EMAIL PROTECTED], John W. Krahn wrote:
Bill Akins wrote:
Hi all!
Hello,
I have this while loop in my script:
while (($type ne Windows) || ($type ne Linux)) {
Your problem is that you are using or when you should be using and.
print Enter TYPE of server to build. Linux or Windoze [linux, windows]:
\n;
$type = STDIN;
chomp $type;
$type =~ tr/a-z/A-Z/;
if (($type eq LINUX) || ($type eq L)) {
$type = Linux; }
if (($type eq WINDOWS) || ($type eq W)) {
$type = Windows; }
}
while ( $type ne 'Windows' and $type ne 'Linux' ) {
print Enter TYPE of server to build. Linux or Windoze [linux,
windows]:\n;
chomp( $type = ucfirst lc STDIN );
$type = 'Windows' if $type eq 'W';
$type = 'Linux' if $type eq 'L';
}
This has tripped me up before. The difference between while not A AND not
B and while not A OR B I think.
Here's an 'or' version:
my $type1 = '';
while ( $type1 !~ /wisteria|lime/i ) {
print Enter COLOR of server. Lime or Wisteria [lime, wisteria]: ;
chomp( $type1 = ucfirst lc STDIN );
$type1 = 'Wisteria' if $type1 eq 'W';
$type1 = 'Lime' if $type1 eq 'L';
}
--
Kevin Pfeiffer
International University Bremen
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Re: While loop, confused...
In article [EMAIL PROTECTED], Kevin Pfeiffer wrote:
Here's an 'or' version:
my $type1 = '';
while ( $type1 !~ /wisteria|lime/i ) {
print Enter COLOR of server. Lime or Wisteria [lime, wisteria]: ;
chomp( $type1 = ucfirst lc STDIN );
$type1 = 'Wisteria' if $type1 eq 'W';
$type1 = 'Lime' if $type1 eq 'L';
}
Oops - longer than needed:
my $type1 = '';
while ( $type1 !~ /wisteria|lime/i ) {
print Enter COLOR of server. Lime or Wisteria [lime, wisteria]: ;
chomp( $type1 = ucfirst lc STDIN );
}
--
Kevin Pfeiffer
International University Bremen
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Re: While loop, confused...
Sorry...
In article [EMAIL PROTECTED], Kevin Pfeiffer wrote:
In article [EMAIL PROTECTED], Kevin Pfeiffer wrote:
Here's an 'or' version:
my $type1 = '';
while ( $type1 !~ /wisteria|lime/i ) {
print Enter COLOR of server. Lime or Wisteria [lime, wisteria]: ;
chomp( $type1 = ucfirst lc STDIN );
$type1 = 'Wisteria' if $type1 eq 'W';
$type1 = 'Lime' if $type1 eq 'L';
}
Oops - longer than needed:
my $type1 = '';
while ( $type1 !~ /wisteria|lime/i ) {
print Enter COLOR of server. Lime or Wisteria [lime, wisteria]: ;
chomp( $type1 = ucfirst lc STDIN );
}
I was mistaken - I see now that the 2 lines allow for abbreviated input like
W and L. :-(
--
Kevin Pfeiffer
International University Bremen
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
RE: While loop, confused...
Bill Akins [EMAIL PROTECTED] wrote:
:
: while (($type ne Windows) || ($type ne Linux)) {
This will always be true. Try:
while ( $type ne 'Windows' $type ne 'Linux' ) {
^^
HTH,
Charles K. Clarkson
--
Head Bottle Washer,
Clarkson Energy Homes, Inc.
Mobile Home Specialists
254 968-8328
my $server_type = query_server_type()
or die Cannot query server type;
sub query_server_type {
# fail after ten unsuccessful tries
foreach ( 1 .. 10 ) {
print
'Enter TYPE of server to build. ',
'Linux or Windoze ( [L]inux or [W]indows ): ';
chomp( my $type = lc STDIN );
return 'Linux' if $type eq 'linux' or $type eq 'l';
return 'Windows' if $type eq 'windows' or $type eq 'w';
print \nYour answer was invalid\n\n;
}
return;
}
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
RE: create files in multi directories
Hi Rob, The text of the files is short (15 words at the most), so it can be either copy of another file, or a text I would edit inside the file. The names of my directory tree looks like this: dir1 / | \ dir2 dir3 dir4 / | / || \ dir5 dir6 dir5 dir6 dir5 dir6 I want to create a few sets of files. One set goes only to dir5, one set goes only to dir6, etc. the common thing to whole directory tree is the files name. The uncommon thing is the text. In each set, the text stays the same, but only one word- changes. The word, which supposes to be changed, is known- the location in the template, the source destination. Cheers ?Ronen Kfir System Administrator T.A.U Computing Division Tel: 972-3-6407416 Fax: 972-3-6405158 cellular: 972-55-405910 E-mail: [EMAIL PROTECTED] -Original Message- From: Rob Dixon [mailto:[EMAIL PROTECTED] Sent: Wednesday, July 02, 2003 8:17 PM To: [EMAIL PROTECTED] Subject: Re: create files in multi directories Hi Ronen. You need to give us a foothold here. Ronen Kfir wrote: How would I create a bunch of files with the same name These files are to be a copy of an existing file? Or have some other prescribed content? save them under the same root directory but only in part of the subdirectories You have constant values of some sort which are the names of the root directory and of all the subdirectories? change one word in the text inside the files? You know what this word is, where it is to be found (in what is presumably a template file), and what it needs to be changed to? Programming is largely a process of rigorously defining a problem using a programming language. The bulk of the work is describing the problem! Cheers, Rob -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
RE: While loop, confused...
Hi all!
I have this while loop in my script:
while (($type ne Windows) || ($type ne Linux)) {
print Enter TYPE of server to build. Linux or Windoze [linux, windows]:\n;
$type = STDIN;
chomp $type;
$type =~ tr/a-z/A-Z/;
if (($type eq LINUX) || ($type eq L)) {
$type = Linux; }
if (($type eq WINDOWS) || ($type eq W)) {
$type = Windows; }
}
I had hoped that it would prompt the user until they made a valid
choice, either L, linux, w or windows. Instead it loops over and over
even if valid input is received. What am I doing wrong here?
I have another while loop that works just fine:
while ($LUN !~ /\d+.\d+.\d+.\d+/) {
print Enter LUN to build boot partition on. LUN Format is 3.0.0.33
[X.X.X.X]: \n;
$LUN = STDIN;
chomp $LUN; }
Thanx!
Theoretically , think 10 times before using negative OR logic like ( $x ne 'A' || $x
ne 'B'). Practically never use it:).
Reason:
This condition will always be true. Why ??
Suppose $x = 'A'
($x ne 'A' || $x ne 'B') = True
= since $x = 'A', then the condition ($x ne 'A') is false . Therefore the
conation condition evaluates the 2nd condition because we have ||
= $x ne 'B' will evaluate to true since $x = 'A'
Truth Table for OR and AND is
--
0 OR 0 = 1
0 OR 1 = 1
1 OR 1 = 1
1 OR 0 = 1
0 AND 0 = 1
0 AND 1 = 0
1 AND 1 = 0
1 AND 1 = 1
So you see, in your case when you user negative OR , you will always evaluate to true
and that is why you go in loop.
Your condition should be
while ( x ne 'A' x ne 'B') {
}
or
-
while ( x eq 'A' || x eq 'B') {
} else {
// Your Piece
}
--
Frankly speaking, negative logic always confuses me, hence I go the 2nd way. Does not
matter if I have a an empty block. At least the intent of the condition is clearer.
ciao
Shishir
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
