[25808] in Perl-Users-Digest

home help back first fref pref prev next nref lref last post

Perl-Users Digest, Issue: 8047 Volume: 10

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue May 3 18:05:37 2005

Date: Tue, 3 May 2005 15:05:05 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)

Perl-Users Digest           Tue, 3 May 2005     Volume: 10 Number: 8047

Today's topics:
        Exit status from perl script (Adam-the-Kiwi)
    Re: Exit status from perl script <mark.clementsREMOVETHIS@wanadoo.fr>
    Re: Help with perl array <nobull@mail.com>
        HELP! - Source code stripper using perl (Gamja)
    Re: HELP! - Source code stripper using perl <1usa@llenroc.ude.invalid>
    Re: loading values from txt to database <jgibson@mail.arc.nasa.gov>
    Re: pattern matching dynamic strings w/ regex ending in <ed.overton@gmail.com>
        Retrieving User Information - IIS 6.0 CGI Single Sign O (Geoffry Smith)
    Re: Retrieving User Information - IIS 6.0 CGI Single Si <apeiron+usenet@coitusmentis.info>
    Re: Somethign about hashes <abigail@abigail.nl>
    Re: start_table problem <jgibson@mail.arc.nasa.gov>
    Re: start_table problem <hackeras@gmail.com>
    Re: using 2>/dev/null in exec() chris-usenet@roaima.co.uk
    Re: using 2>/dev/null in exec() <tadmc@augustmail.com>
        Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)

----------------------------------------------------------------------

Date: 3 May 2005 10:33:56 -0700
From: adamomitcheney@kiwis.co.uk (Adam-the-Kiwi)
Subject: Exit status from perl script
Message-Id: <83295ac7.0505030933.3a88b573@posting.google.com>

Hi All,

Fairly newbie question - apologies in advance if this is covered in
FAQs, but I can't find it on CPAN or perldoc.

Essentially, I'm writing a perl script to do some ClearCase trigger
processing. This trigger will fire on a variety of ClearCase actions
and execute a perl script - perl because of the ease of writing
functionality that works on UNIX and Windoze platforms.

I've written a little wrapper to simulate the trigger firing to allow
me to test my funtionality on my laptop at home, which doesn't have
ClearCase installed. Essentially, all this does is set the appropriate
environment variables and then calls the perl script, testing for the
returned value. The perl script in question does some stuff, calls a
subroutine and then passes that subroutine's return value (0 for
success) back up using exit. The wrapper simply prints out the
returned value so I can make sure that the processing is working as it
should.

Except that it doesn't. What I suspect is happening is that I'm
testing the return value of 'perl' rather than the script it executes.
Is that right? Can I access the scripts' return value instead?

Note: it doesn't really matter, because, as you can see, I'm printing
out the return anyway - I'm just curious, like...

Cheers - Adam...

Cradle:
#===============================================================================
#
# Name:        trigger_wrapper.pl
# Author:      Adam Cheney
# Description: wrapper for testing triggerware
#
#===============================================================================

use strict;
#use diagnostics;

# Set environment up:

$ENV{'CLEARCASE_OP_KIND'}     = 'checkin';
$ENV{'CLEARCASE_TRTYPE_KIND'} = 'pre-operation';
$ENV{'OS'}                    = undef;
$ENV{'CLEARCASE_ELTYPE_NAME'} = 'file';
$ENV{'CLEARCASE_COMMENT'}     =
'(AWC)8954-GXS;15599-CXM;17273-SDF;S4012-GXT: another good one.\n';
$ENV{'CLEARCASE_USER'}        = undef;

my $system_return = system ("perl IMtrig.pl");

print "\nReturn value is: $system_return";



Perl script:
#===============================================================================
#
# Name:        IMtrig.pl
# Author:      Adam Cheney
# Description: Central entry point for all IM trigger processing
#
#===============================================================================

use strict;
#use diagnostics;
use ETCccutil;
use ETCtrigfunc;

# Define location of exported DID text file
my $DID_file = "cds_28Oct_17h41.txt";

# Define reference to anonymous hash laying out actions matrix
my $matrix = {'checkout'   => {'preop'  => \&ETCtrigfunc::noaction,
                               'postop' => \&ETCtrigfunc::noaction},
              'checkin'    => {'preop'  => \&ETCtrigfunc::precheckin,
                               'postop' => \&ETCtrigfunc::noaction},
              'mkelem'     => {'preop'  => \&ETCtrigfunc::noaction,
                               'postop' => \&ETCtrigfunc::noaction},
              'uncheckout' => {'preop'  => \&ETCtrigfunc::noaction,
                               'postop' => \&ETCtrigfunc::noaction},
              'reserve'    => {'preop'  => \&ETCtrigfunc::noaction,
                               'postop' => \&ETCtrigfunc::noaction},
              'unreserve'  => {'preop'  => \&ETCtrigfunc::noaction,
                               'postop' => \&ETCtrigfunc::noaction},
              'chevent'    => {'preop'  => \&ETCtrigfunc::noaction,
                               'postop' => \&ETCtrigfunc::noaction},
              'rmelem'     => {'preop'  => \&ETCtrigfunc::prermelem,
                               'postop' => \&ETCtrigfunc::noaction},
              'rmver'      => {'preop'  => \&ETCtrigfunc::prermver,
                               'postop' => \&ETCtrigfunc::noaction},
              'rmbrnach'   => {'preop'  => \&ETCtrigfunc::prermbranch,
                               'postop' => \&ETCtrigfunc::noaction}};


my $action = ""; # The action that invoked the trigger
my $sequence = ""; # preop or postop

($action, $sequence) = &ETCccutil::gettrigger;

# Call the appropriate function
my $trigreturn = &{$matrix->{$action}->{$sequence}} ($DID_file);

print "...and the return value is $trigreturn\n";
exit ($trigreturn);


------------------------------

Date: 03 May 2005 17:55:18 GMT
From: "Mark Clements" <mark.clementsREMOVETHIS@wanadoo.fr>
Subject: Re: Exit status from perl script
Message-Id: <4277bb04$0$802$8fcfb975@news.wanadoo.fr>

Adam-the-Kiwi wrote:

<snip>
> 
> I've written a little wrapper to simulate the trigger firing to allow
> me to test my funtionality on my laptop at home, which doesn't have
> ClearCase installed. Essentially, all this does is set the appropriate
> environment variables and then calls the perl script, testing for the
> returned value. The perl script in question does some stuff, calls a
> subroutine and then passes that subroutine's return value (0 for
> success) back up using exit. The wrapper simply prints out the
> returned value so I can make sure that the processing is working as it
> should.
> 
> Except that it doesn't. What I suspect is happening is that I'm
> testing the return value of 'perl' rather than the script it executes.
> Is that right? Can I access the scripts' return value instead?
<snip>

> my $system_return = system ("perl IMtrig.pl");
> 
> print "\nReturn value is: $system_return";
> 
> 
> 
> Perl script:
<snip>
> 
> # Call the appropriate function
> my $trigreturn = &{$matrix->{$action}->{$sequence}} ($DID_file);
> 
> print "...and the return value is $trigreturn\n";
> exit ($trigreturn);

You need to (carefully(!)) read the documentation for system:

 The return value is the exit status of the program
             as returned by the "wait" call.  To get the actual
             exit value shift right by eight (see below).  See
             also "exec".  

eg

bob 761 $ perl -l
$ret=system("perl", "-le","exit(123)");print $ret>>8
123
bob 762 $

regards,

Mark


------------------------------

Date: Tue, 03 May 2005 20:06:20 +0100
From: Brian McCauley <nobull@mail.com>
Subject: Re: Help with perl array
Message-Id: <d58i3c$pp5$1@slavica.ukpost.com>



Vorxion wrote:
> You bother to include CGI, but then write your own broken version?  Why?
> 
> Your methodology -can- break--quite easily.  If the input is large enough
> and chunked or split by packet sizes, you won't get CONTENT_LENGTH all at
> once, and you're not bothering to retry and append until you do.

While there are many ligitimate reasons to avoid broken hand-rolled CGI 
decoders, that isn't one.  Perl's read() is like C's fread(), in Perl 
C's read() is called sysread().



------------------------------

Date: 3 May 2005 08:52:42 -0700
From: assert@gmail.com (Gamja)
Subject: HELP! - Source code stripper using perl
Message-Id: <41c41b7.0505030752.4d3b8c57@posting.google.com>

Hi all.

I need a source code stripper that removes some patterns from C or C++
files. A file contains the patterns should be loaded on runtime. I
want to remove all comments following "//" and my own decoration.
Please recommend a proper regular expression to match the these
patterns.

What I want to do is as following.

--BEFORE--
AAA
// debug begin
my_own_debug_function(blah, blah, blah);
 ...
// debug end
BBB
this_function_should_be_removed(a,
                                b,
                                c);
CCC
// debug begin
DDD
// debug end
EEE
--AFTER (line count of each line should be leaved as it is)--
AAA




BBB



CCC



EEE
---------

Thanks in advance.

Best regards,
Gamja


------------------------------

Date: Tue, 3 May 2005 16:11:48 +0000 (UTC)
From: "A. Sinan Unur" <1usa@llenroc.ude.invalid>
Subject: Re: HELP! - Source code stripper using perl
Message-Id: <Xns964B7C128455Easu1cornelledu@132.236.56.8>

assert@gmail.com (Gamja) wrote in news:41c41b7.0505030752.4d3b8c57
@posting.google.com:

> What I want to do is as following.
> 
> --BEFORE--
> AAA
> // debug begin
> my_own_debug_function(blah, blah, blah);
> ...
> // debug end
> BBB
> this_function_should_be_removed(a,
>                                 b,
>                                 c);
> CCC
> // debug begin
> DDD
> // debug end
> EEE
> --AFTER (line count of each line should be leaved as it is)--
> AAA
> 
> 
> 
> 
> BBB
> 
> 
> 
> CCC
> 
> 
> 
> EEE

use strict;
use warnings;

while(<DATA>) {
    if( m#^// debug begin# .. m#^// debug end# ) {
        print "\n";
        next;
    }

    if( /^this_function_should_be_removed\(/ ... /\);$/ ) {
        print "\n";
        next;
    }

    print;
}

__END__
AAA
// debug begin
my_own_debug_function(blah, blah, blah);
 ...
// debug end
BBB
this_function_should_be_removed(a,
                                b,
                                c);
CCC
// debug begin
DDD
// debug end
EEE





------------------------------

Date: Tue, 03 May 2005 10:04:13 -0700
From: Jim Gibson <jgibson@mail.arc.nasa.gov>
Subject: Re: loading values from txt to database
Message-Id: <030520051004137508%jgibson@mail.arc.nasa.gov>

In article <d581c6$56q$1@nic.grnet.gr>, Nikos <hackeras@gmail.com>
wrote:

> This is what i manges to do to load the the already existing gamename 
> and descriptions from the .txt to the database and update the if the 
> game is already there or inserting a new database entry if new game is 
> added to descriptions.txt
> 
> But still it isnt working. I cant see why.

"isnt working" (sic) isn't a very good description of what is wrong.
What is it doing that you think it shouldn't be doing? What is it not
doing that you think it should be doing?

> my @row;
> my $select = $dbh->prepare( "SELECT * FROM games WHERE gamename=?" );

You are selecting all fields in the order they are defined (keep that
in mind below.)

> my $insert = $dbh->prepare( "INSERT INTO games (gamename, gamedesc, 
> gamecounter) VALUES (?, ?, ?)" );
> my $update = $dbh->prepare( "UPDATE games SET gamedesc=? where 
> gamename=?" );
> 
> open (FILE, "<../data/games/descriptions.txt") or die $!;
>      while (<FILE>) {
>          chomp;
> 
>          my ($gamename, $gamedesc) = split /\t/;
>          $select->execute( $gamename );

You do not check for errors. Why not?

> 
>          my $count;
>          while( my $row = $select->fetchrow_arrayref ) {
>              $count = $row->[0];

fetchrow_array returns a reference to an array containing the values of
the fields (in the order as defined when the table was created).
$row->[0] will contain the value of the first field, probably your game
name (keep that in mind below when you test $count). You probably want
to change this line to 

               $count++;

>          }
> 
>          if( $count == 0 ) {                                    #a new game

$count most likely contains the name of a game. Since this string
probably does not start with a digit, it will be evaluated numerically
as zero. Therefore, the following insert statement will be executed.
Probably not what you want.

>              $insert->execute( $gamename, $gamedesc, 0 );
>          }
>          else {
>              $update->execute( $gamedesc, $gamename );
>          }
>      }
> close (FILE);

HTH.


----== Posted via Newsfeeds.Com - Unlimited-Uncensored-Secure Usenet News==----
http://www.newsfeeds.com The #1 Newsgroup Service in the World! >100,000 Newsgroups
---= East/West-Coast Server Farms - Total Privacy via Encryption =---


------------------------------

Date: Tue, 03 May 2005 21:55:52 GMT
From: Ed <ed.overton@gmail.com>
Subject: Re: pattern matching dynamic strings w/ regex ending in $ problem
Message-Id: <IrSde.3979$yl6.2771313@twister.nyc.rr.com>

Paul Arthur wrote:

> rader <rader@hep.wisc.edu> wrote:

>>I'm seeing a simple, ah, problem with perl 5.8.0...
>>Anybody know of a workaround?  The code above behaves as expected
>>with 5.6.x.  Could this actually be a bug?

> If it is a bug, it's been fixed.

(Paul had used 5.8.5, where the problem did not appear.)

I did some further poking at the problem with 5.8.0 (below).  From what 
I see there, there may still be a bug with 5.8.5.  I'm not that familiar 
with perl's UTF-8 handling, so bear with me if I misstate something 
here...  The regex debug information indicates that UTF-8 came into play 
(for the problem case).  I believe UTF-8 was enabled by default for 
5.8.0 and backed out with 5.8.1.  So 5.8.5 may have the bug, but it 
could be masked since UTF-8 isn't enabled.

Ed


$ cat crud
#!/usr/local/bin/perl
use strict;
use warnings;

use re 'debug';

my $a = 'fuBar';  my $a_new = qx(echo -n $a);
my $b = 'Bar$';

if ( $a eq $a_new ) {
   print "===> \$a eq \$a_new is true\n";
}

print "===> (\$a     vs. \$b  ) $a =~ /$b/ ...\n";
if ( $a =~ /$b/ ) {
   print "===> match\n";
} else {
   print "===> no match?!\n";
}

print "===> (\$a_new vs. \$b  ) $a_new =~ /$b/ ...\n";
if ( $a_new =~ /$b/ ) {
   print "===> match\n";
} else {
   print "===> no match?!\n";
}

print "===> (\$a_new vs. Bar\$) $a_new =~ /Bar\$/ ...\n";
if ( $a_new =~ /Bar$/ ) {
   print "===> match\n";
} else {
   print "===> no match?!\n";
}
$ ./crud
Compiling REx `Bar$'
size 4 Got 36 bytes for offset annotations.
first at 1
rarest char B at 0
    1: EXACT <Bar>(3)
    3: EOL(4)
    4: END(0)
anchored `Bar'$ at 0 (checking anchored isall) minlen 3
Offsets: [4]
         1[3] 0[0] 4[1] 5[0]
Omitting $` $& $' support.

EXECUTING...

===> $a eq $a_new is true
===> ($a     vs. $b  ) fuBar =~ /Bar$/ ...
Compiling REx `Bar$'
size 4 Got 36 bytes for offset annotations.
first at 1
rarest char B at 0
    1: EXACT <Bar>(3)
    3: EOL(4)
    4: END(0)
anchored `Bar'$ at 0 (checking anchored isall) minlen 3
Offsets: [4]
         1[3] 0[0] 4[1] 5[0]
Guessing start of match, REx `Bar$' against `fuBar'...
Found anchored substr `Bar'$ at offset 2...
Starting position does not contradict /^/m...
Guessed: match at offset 2
===> match
===> ($a_new vs. $b  ) fuBar =~ /Bar$/ ...
Compiling REx `Bar$'
size 4 Got 36 bytes for offset annotations.
first at 1
rarest char B at 0
    1: EXACT <Bar>(3)
    3: EOL(4)
    4: END(0)
anchored utf8 `Bar'$ at 0 (checking anchored isall) minlen 3
Offsets: [4]
         1[3] 0[0] 4[1] 5[0]
UTF-8 regex...
UTF-8 target...
Guessing start of match, REx `Bar$' against `fuBar'...
Did not find anchored substr `Bar'$...
Match rejected by optimizer
===> no match?!
===> ($a_new vs. Bar$) fuBar =~ /Bar$/ ...
Matching REx `Bar$' against `fuBar'
   Setting an EVAL scope, savestack=9
    2 <fu> <Bar>           |  1:  EXACT <Bar>
    5 <fuBar> <>           |  3:  EOL
    5 <fuBar> <>           |  4:  END
Match successful!
===> match
Freeing REx: `"Bar$"'
Freeing REx: `Bar$'
Freeing REx: `"Bar$"'
$


------------------------------

Date: 3 May 2005 08:11:56 -0700
From: martianalien@gmail.com (Geoffry Smith)
Subject: Retrieving User Information - IIS 6.0 CGI Single Sign On
Message-Id: <670f2838.0505030711.254608d6@posting.google.com>

I have a cgi application that runs on IIS 6.0 with windows integrated
authentication (single sign on) in an Active Directory context.

I know that can get the logged in user name from environment.

My question is, what is the (most efficient) way to get hold of other
information available from the Active Directory database (e.g. user's
full name, phone number etc.)

Does windows make that information available through some direct API?
If so, could  someone please post example code?

If I have to make an LDAP call, could you post show example code?

Thanks in advance
Geoffry


------------------------------

Date: 03 May 2005 15:21:31 GMT
From: Christopher Nehren <apeiron+usenet@coitusmentis.info>
Subject: Re: Retrieving User Information - IIS 6.0 CGI Single Sign On
Message-Id: <slrnd7f5nr.1aa.apeiron+usenet@prophecy.dyndns.org>

On 2005-05-03, Geoffry Smith scribbled a series of words having
absolutely nothing to do with Perl.

You'd probably stand a better chance of getting an answer if you posted
this to a newsgroup in the microsoft.* hierarchy (though put on your
top-posting resistant armour; they have no sense of etiquette over
there).

Best Regards,
Christopher Nehren
-- 
I abhor a system designed for the "user", if that word is a coded
pejorative meaning "stupid and unsophisticated". -- Ken Thompson
If you ask the wrong questions, you get answers like "42" and "God".
Unix is user friendly. However, it isn't idiot friendly.


------------------------------

Date: 03 May 2005 18:29:29 GMT
From: Abigail <abigail@abigail.nl>
Subject: Re: Somethign about hashes
Message-Id: <slrnd7fgo8.2uj.abigail@alexandra.abigail.nl>

Nikos (hackeras@gmail.com) wrote on MMMMCCLXII September MCMXCIII in
<URL:news:d55tfj$uh$1@nic.grnet.gr>:
`'  
`'  ok, but it wouldnt be much of a trouble if you helped me a little on the 
`'  styling since little details are confusing me, would it?


No. You're too stupid to take a hint anyway, so why bother?


*PLONK*



Abigail
-- 
# Count the number of lines; code doesn't match \w. Linux specific.
()=<>;$!=$=;($:,$,,$;,$")=$!=~/.(.)..(.)(.)..(.)/;
$;++;$*++;$;++;$*++;$;++;`$:$,$;$" $. >&$*`; 


------------------------------

Date: Tue, 03 May 2005 10:21:40 -0700
From: Jim Gibson <jgibson@mail.arc.nasa.gov>
Subject: Re: start_table problem
Message-Id: <030520051021400341%jgibson@mail.arc.nasa.gov>

In article <d57n6r$q17$1@nic.grnet.gr>, Nikos <hackeras@gmail.com>
wrote:

> Nikos wrote:
> > Why when i run this i get an eroor saying start_table is undef(i dont 
> > remmber the error exactly but its something abou the line with start_table

[program using start_table snipped]

> 
> it worked!
> i just changed print start_table( {class=>'games'} );
> with print table( {class=>'games'} ); and it worked!

You may want to consider using the object-oriented method of calling
CGI module routines. Instead of

   use CGI qw/:standard/;

   print header(...)

etc., do the following:

   use CGI:

   my $cgi = CGI->new;
   print $cgi->header(...);

etc.

Then your form-with-table generating code will become (untested):

print $cgi->start_form(-action=>'games.pl');
  print $cgi->start_table( {class=>'games'} );
  while( $row = $sth->fetchrow_hashref )
  {
    print $cgi->Tr(
      $cgi->td( {-width=>'20%'},  $cgi->submit( $row->{gamename} )),
      $cgi->td( {-width=>'75%'},  $row->{gamedesc}         ),
      $cgi->td( {-width=>'5%'},   $row->{gamecounter}      )
    );
  }
  print $cgi->end_table;
print $cgi->end_form, $cgi->br;

That might solve your undefined methods problems. Otherwise, you may
have to list every method you use in the 'use CGI qw/:standard ... /'
line.


----== Posted via Newsfeeds.Com - Unlimited-Uncensored-Secure Usenet News==----
http://www.newsfeeds.com The #1 Newsgroup Service in the World! >100,000 Newsgroups
---= East/West-Coast Server Farms - Total Privacy via Encryption =---


------------------------------

Date: Tue, 03 May 2005 20:23:45 +0300
From: Nikos <hackeras@gmail.com>
Subject: Re: start_table problem
Message-Id: <d58c2v$ebo$1@nic.grnet.gr>

Jim Gibson wrote:

{snip}

Thanks Jim but since it worked that way iam ok.


-- 
"Of course I cant stop you. And that would really bum me out
if that were my job. But my job isnt to stop you, its to
make it as difficult as possible, for as many as possible,
for as long as possible ."


------------------------------

Date: Tue, 3 May 2005 17:15:54 +0100
From: chris-usenet@roaima.co.uk
Subject: Re: using 2>/dev/null in exec()
Message-Id: <qmkkk2-ea8.ln1@news.roaima.co.uk>

In comp.lang.perl.misc Russ Jones <russ.jones2@boeing.com> wrote:
> Is there a way I can make STDERR go to /dev/null [...]

perldoc -f open

Separate the redirection from the exec and it all falls into place :-)
Chris


------------------------------

Date: Tue, 3 May 2005 12:53:07 -0500
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: using 2>/dev/null in exec()
Message-Id: <slrnd7fek3.3gg.tadmc@magna.augustmail.com>


[ No modules here, F'ups trimmed ]


Russ Jones <russ.jones2@boeing.com> wrote:

> STDERR goes to /dev/null just like I want it to, 


> But I prefer to use the list method of calling exec() 


> push(@parms,'-parm','parm','2>/dev/null');
> exec("/some/pgm",@parms);

> Is there a way I can make STDERR go to /dev/null and still use the list 
> method of the call?


Let it inherit STDERR from the perl process:

    open STDERR, '>', '/dev/null' or die ...
    push(@parms,'-parm','parm');
    exec("/some/pgm",@parms);


-- 
    Tad McClellan                          SGML consulting
    tadmc@augustmail.com                   Perl programming
    Fort Worth, Texas


------------------------------

Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin) 
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>


Administrivia:

#The Perl-Users Digest is a retransmission of the USENET newsgroup
#comp.lang.perl.misc.  For subscription or unsubscription requests, send
#the single line:
#
#	subscribe perl-users
#or:
#	unsubscribe perl-users
#
#to almanac@ruby.oce.orst.edu.  

NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice. 

To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.

#To request back copies (available for a week or so), send your request
#to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
#where x is the volume number and y is the issue number.

#For other requests pertaining to the digest, send mail to
#perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
#sending perl questions to the -request address, I don't have time to
#answer them even if I did know the answer.


------------------------------
End of Perl-Users Digest V10 Issue 8047
***************************************


home help back first fref pref prev next nref lref last post