[22256] in Perl-Users-Digest
Perl-Users Digest, Issue: 4477 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Jan 28 14:06:10 2003
Date: Tue, 28 Jan 2003 11:05:09 -0800 (PST)
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, 28 Jan 2003 Volume: 10 Number: 4477
Today's topics:
adding functionality to microperl <zentara@highstream.net>
Re: array slicing <jvandervloet@hotmail.com>
Re: array slicing <thens@nospam.com>
Re: array slicing <abigail@abigail.nl>
Re: array slicing <thens@nospam.com>
cgi-lib to cgi.pm conversion <todd@mrnoitall.com>
Re: cgi-lib to cgi.pm conversion <uri@stemsystems.com>
Re: Entering backslashed values into variables when rea <nobull@mail.com>
Re: perl code to "fix" VBR mp3s with bogus time informa (Scott Evans)
Re: Problem checking for newline in $_ input line (Ben Morrow)
Re: Problem checking for newline in $_ input line <JCornwall@cox.net>
Re: Question about 64bit Integers in Perl (doug)
question concerning using objects in a module (Mark Wirdnam)
regex to escape special characters <alex@alexbanks.com>
Substituting words in Array with items from a hash? (Mac)
Re: Tainting individual variables <nobull@mail.com>
Re: Tainting individual variables <nobull@mail.com>
test for (non-)interactive program run <michael.kirchner@unibw-muenchen.de>
Re: test for (non-)interactive program run <espenmyr@start.no.cretinfilter>
Re: test for (non-)interactive program run <michael.kirchner@unibw-muenchen.de>
Re: test for (non-)interactive program run (Tad McClellan)
Timestamps to thousandths of a second. (Jeremy Gooch)
Re: unlink() (Ben Morrow)
Re: Very Basic Question on the Use of the __DATA__ Toke <simon.oliver@nospam.umist.ac.uk>
Re: Why doesn't perl -ex 'print 1' work on Windows? <pinyaj@rpi.edu>
Re: Why doesn't perl -ex 'print 1' work on Windows? <pinyaj@rpi.edu>
Re: win32 tieregistry html <nobull@mail.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Tue, 28 Jan 2003 11:19:45 -0500
From: zentara <zentara@highstream.net>
Subject: adding functionality to microperl
Message-Id: <c7bd3vkgfmdq6igjqc06scsclup4ctu3a5@4ax.com>
Hi,
I've recently discovered the Makefile.micro in the
perl5.8 distribution. I've been able to compile it, even statically,
and compress it with upx to 540k. I find it to be very useful
on boot disks where I don't have perl installed.
There is only 1 drawback. I need to use a combination
of `ls` and grep to glob files in directories. For Instance:
#!microperl
@files = `ls`;
my @files = grep /.pl$/,@files;
Has anyone managed to add readdir functionality
to the Makefile.micro for perl on linux?
Or should I just use miniperl with some added libraries?
------------------------------
Date: Tue, 28 Jan 2003 16:25:21 GMT
From: "joeri" <jvandervloet@hotmail.com>
Subject: Re: array slicing
Message-Id: <R9yZ9.13532$Jd.1896@afrodite.telenet-ops.be>
> Hi,
> I want a simplistic solution to a problem that i have in slicing
> array.
> my @numbers = ( 'ONE', 'TWO', 'THREE', 'FOUR', 'FIVE' )
>
> # I want to print numbers greater than or equal to three
> # I expect a magical operation to return me the elements in the list after
THREE.
>
> print join(' ', <your code operating on @numbers>);
Maybe sth like:
use strict;
my @numbers = ( 'ONE', 'TWO', 'THREE', 'FOUR', 'FIVE' );
print join(' ',&del(@numbers));
sub del {
while(@_){
last if shift eq "TWO";
}
@_;
}
Regards,
J
------------------------------
Date: Tue, 28 Jan 2003 22:33:08 +0530
From: Thens <thens@nospam.com>
Subject: Re: array slicing
Message-Id: <20030128223308.3fb92cbd.thens@nospam.com>
On Tue, 28 Jan 2003 15:21:45 +0100
Bernard El-Hagin <bernard.el-hagin@DODGE_THISlido-tech.net> wrote:
> On Tue, 28 Jan 2003 15:20:09 +0100, Bernard El-Hagin
> <bernard.el-hagin@DODGE_THISlido-tech.net> wrote:
>
> >On Tue, 28 Jan 2003 19:31:45 +0530, Thens <thens@nospam.com> wrote:
> >
> >>Hi,
> >> I want a simplistic solution to a problem that i have in slicing
> >>array.
> >>
> >>#! /usr/local/bin/perl -w
> >>
> >>use strict;
> >>
> >># NUMBERS in order
> >>my @numbers = ( 'ONE', 'TWO', 'THREE', 'FOUR', 'FIVE' )
> >
> >
> >Easier to write that like so:
> >
> >
> >my @numbers = qw(ONE TWO THREE FOUR FIVE);
> >
> >
> >># I want to print numbers greater than or equal to three
> >># I expect a magical operation to return me the elements in the list after THREE.
> >>
> >>print join(' ', <your code operating on @numbers>);
> >
> >
> >print join ' ', @numbers[3 .. $#numbers];
>
>
> Sorry, start at 2, not 3.
>
>
> print join ' ', @numbers[2 .. $#numbers];
>
This assumes that the offset (2) is known. But i was looking for
something that will just take the element and find out the offset by
itself.
>
> Cheers,
> Bernard
> --
> echo 42|perl -pe '$#="Just another Perl hacker,"'
------------------------------
Date: 28 Jan 2003 17:54:18 GMT
From: Abigail <abigail@abigail.nl>
Subject: Re: array slicing
Message-Id: <slrnb3dgua.i37.abigail@alexandra.abigail.nl>
Thens (thens@nospam.com) wrote on MMMCDXXXVII September MCMXCIII in
<URL:news:20030128193145.38a3ac7c.thens@nospam.com>:
[] Hi,
[] I want a simplistic solution to a problem that i have in slicing
[] array.
[]
[] #! /usr/local/bin/perl -w
[]
[] use strict;
[]
[] # NUMBERS in order
[] my @numbers = ( 'ONE', 'TWO', 'THREE', 'FOUR', 'FIVE' )
[]
[] # I want to print numbers greater than or equal to three
[] # I expect a magical operation to return me the elements in the list after T
[]
[] print join(' ', <your code operating on @numbers>);
print "@{[do {my $c; grep {$c || $_ eq 'THREE' && ++ $c} @numbers}]}\n";
Abigail
--
perl -wle'print"Κυστ αξοτθες Πεςμ Θαγλες"^"\x80"x24'
------------------------------
Date: Tue, 28 Jan 2003 23:33:28 +0530
From: Thens <thens@nospam.com>
Subject: Re: array slicing
Message-Id: <20030128233328.20ccca4b.thens@nospam.com>
On 28 Jan 2003 17:54:18 GMT
Abigail <abigail@abigail.nl> wrote:
> Thens (thens@nospam.com) wrote on MMMCDXXXVII September MCMXCIII in
> <URL:news:20030128193145.38a3ac7c.thens@nospam.com>:
> [] Hi,
> [] I want a simplistic solution to a problem that i have in slicing
> [] array.
> []
> [] #! /usr/local/bin/perl -w
> []
> [] use strict;
> []
> [] # NUMBERS in order
> [] my @numbers = ( 'ONE', 'TWO', 'THREE', 'FOUR', 'FIVE' )
> []
> [] # I want to print numbers greater than or equal to three
> [] # I expect a magical operation to return me the elements in the list after T
> []
> [] print join(' ', <your code operating on @numbers>);
>
>
> print "@{[do {my $c; grep {$c || $_ eq 'THREE' && ++ $c} @numbers}]}\n";
Looks a little complex. But thanks a lot.
>
>
> Abigail
> --
> perl -wle'print"Κυστ αξοτθες Πεςμ Θαγλες"^"\x80"x24'
------------------------------
Date: Tue, 28 Jan 2003 11:13:07 -0700
From: Todd Anderson <todd@mrnoitall.com>
Subject: cgi-lib to cgi.pm conversion
Message-Id: <3E36C7AF.A4E3E450@mrnoitall.com>
The search routine below was written using cgi-lib.pl. I am trying to
convert it to use cgi.pm. It is not returning any found items as is.
Even with no search parameters.
Any help is appreciated and thanks in advance.
sub search
{
$data_file_path = "$path/members/$session_username/data";
if (!-e $data_file_path){
if(param('new_member_activation')){
&no_hits_message2;
}
else{
&no_hits_message;
}
exit;
}
else{
foreach $criteria (@db_user_definable_field_order) {
param($criteria =>~ s/~p~/\|/g); }
param('keywords' =>~ s/~p~/\|/g);
if (param('boolean') eq "any terms") {
param('keywords' => ~ s/\s+/\|/g); }
if (param('boolean') eq "as a phrase") {
param('as_a_phrase' => "on"); }
local($multi_input);
foreach $multi_input (@db_index_of_multi_inputs)
{
if (param($multi_input))
{
@split_values= CGI::param($multi_input);
param($multi_input => join("\|",@split_values));
}
}
if (param('sort_by'))
{
$index_of_field_to_be_sorted_by = param('sort_by');
}
if (param('max_hits'))
{
$max_rows_returned = param('max_hits');
}
if (param('days_ago'))
{
($today_month,$today_day,$today_year) = split (/\//, &get_date);
$today = &jday($today_month,$today_day,$today_year);
$oldest_day = ($today - param('days_ago'));
($beginmonth, $beginday, $beginyear, $beginweekday) = &jdate($oldest_day);
param('date_begin' => "$beginmonth/$beginday/$beginyear");
}
if (param('previous_hits_button.x'))
{
param('new_hits_seen' => param('old_hits_seen'));
}
for ($i = 1;$i <= 20;$i++)
{
if (param($i.x))
{
$n = $i-1;
param('new_hits_seen' => ($n * $max_rows_returned));
}
}
($total_row_count) = &submit_query(*database_rows);
foreach $number (@number_sort)
{ if ($index_of_field_to_be_sorted_by == $number)
{ $numeric_sort = "yes"; }
}
foreach $number (@date_sort)
{ if ($index_of_field_to_be_sorted_by == $number)
{ $date_sort = "yes"; }
}
foreach $row (@database_rows)
{
@row = split (/\|/, $row);
$sortable_field = $row[$index_of_field_to_be_sorted_by];
if ($numeric_sort eq "yes")
{
$sortable_field =~ s/\$//g;
$sortable_field =~ s/,//g;
$sortable_field =~ s/(\d+)([kK])/${1}000/gi;
$sortable_field =~ s/([^0-9\.]+)/ /g;
$sortable_field =~ s/^([^0-9\.]*)(\d+\.?\d*|\.\d+)(.*)$/$2/g;
unless ( $sortable_field =~ /^(\d+\.?\d*|\.\d+)$/ )
{ $sortable_field = 0; }
}
if ($date_sort eq "yes")
{
($mo, $da, $yr) = split(/\//, $sortable_field);
$mo = "0" . $mo
if (length($mo) < 2);
$da = "0" . $da
if (length($da) < 2);
$yr = ($century + $yr)
if (length($yr) < 3);
$sortable_field = $yr . $mo . $da;
}
unshift (@row, $sortable_field);
$new_row = join ("\|", @row);
push (@new_rows, $new_row);
}
@database_rows = ();
if ($numeric_sort eq "yes")
{
# sub numerically { $a <=> $b; }
if (param('reverse'))
{
@sorted_rows = sort {$b <=> $a} @new_rows;
}
else
{
@sorted_rows = sort {$a <=> $b} @new_rows;
}
}
else {
if (param('reverse')) {
@sorted_rows = sort { lc($b) cmp lc($a) } @new_rows;
}
else {
@sorted_rows = sort { lc($a) cmp lc($b) } @new_rows;
}
}
$i = 1;
foreach $sorted_row (@sorted_rows)
{
@row = split (/\|/, $sorted_row);
$sorted_field = shift (@row);
push (@row, $i);
$old_but_sorted_row = join ("\|", @row);
push (@database_rows, $old_but_sorted_row);
$i++;
}
if ($total_row_count < 1)
{
&no_hits_message;
exit;
}
if (param('display_modification_form_button')) { $hits_seen = 0; }
else { $hits_seen = param('new_hits_seen'); }
for ($i = 1;$i <= $hits_seen;$i++)
{
$seen_row = shift (@database_rows);
}
$length_of_database_rows = @database_rows;
for ($i = $length_of_database_rows-1;$i >= $max_rows_returned;$i--)
{
$extra_row = pop (@database_rows);
}
$new_hits_seen = $hits_seen + $max_rows_returned;
$old_hits_seen = $hits_seen - $max_rows_returned;
&search_results_body;
}#else
}#Search end
sub submit_query
{
local(*database_rows) = @_;
local(@fields);
local($row_count);
local($line);
local($exact_match) = param('exact_match');
local($as_a_phrase) = param('as_a_phrase');
local($case_sensitive) = param('case_sensitive');
local($c_name, $c_fields, $c_op, $c_type);
local(@criteria_fields);
local($form_value);
$row_count = 0;
open(DATAFILE, "$data_file_path") ||
&error("$data_file_path",
"Read Database");
while(($line = <DATAFILE>))
{
chop($line);
@fields = split(/\|/, $line);
$not_found = 0;
foreach $criteria (@db_query_criteria)
{
($c_name, $c_fields, $c_op, $c_type) = split(/\|/, $criteria);
@criteria_fields = split(/,/,$c_fields);
$form_value = param($c_name);
if ($form_value ne "")
{
$not_found += &flatfile_apply_criteria;(
$exact_match,
$as_a_phrase,
$case_sensitive,
*fields,
$criteria,
$c_name,
$c_fields,
$c_op,
$c_type,
@criteria_fields,
$form_value);
if ($not_found != 0) { last; }
}
}
if ($not_found == 0)
{
push(@database_rows, join("\|", @fields));
$row_count++;
}
}
close (DATAFILE);
return($row_count);
} # End of submit query
sub flatfile_apply_criteria
{
local($not_found);
my($db_value);
my($month, $year, $day);
my($db_date, $form_date);
my($db_index);
my(@word_list);
if (($c_type =~ /date/i) ||
($c_type =~ /number/i) ||
($c_op ne "="))
{
$not_found = "yes";
foreach $db_index (@criteria_fields)
{
$db_value = $fields[$db_index];
if ($c_type =~ /date/i)
{
($month, $day, $year) = split(/\//, $db_value);
$month = "0" . $month
if (length($month) < 2);
$day = "0" . $day
if (length($day) < 2);
$year = ($century + $year)
if (length($year) < 3);
$db_date = $year . $month . $day;
($month, $day, $year) = split(/\//, $form_value);
$month = "0" . $month
if (length($month) < 2);
$day = "0" . $day
if (length($day) < 2);
$year = ($century + $year)
if (length($year) < 3);
$form_date = $year . $month . $day;
if ($c_op eq ">")
{
return 0 if ($form_date > $db_date);
}
if ($c_op eq "<")
{
return 0 if ($form_date < $db_date);
}
if ($c_op eq ">=")
{
return 0 if ($form_date >= $db_date);
}
if ($c_op eq "<=")
{
return 0 if ($form_date <= $db_date);
}
if ($c_op eq "!=")
{
return 0 if ($form_date != $db_date);
}
if ($c_op eq "=")
{
return 0 if ($form_date == $db_date);
}
}
elsif ($c_type =~ /number/i)
{
$form_value =~ s/\$//g;
$form_value =~ s/,//g;
$form_value =~ s/[a-zA-Z]//g;
$form_value =~ s/\s//g;
$db_value =~ s/\$//g;
$db_value =~ s/,//g;
$db_value =~ s/[a-zA-Z]//g;
$db_value =~ s/\s//g;
if ($c_op eq ">")
{
return 0 if ($form_value > $db_value);
}
if ($c_op eq "<")
{
return 0 if ($form_value < $db_value);
}
if ($c_op eq ">=")
{
return 0 if ($form_value >= $db_value);
}
if ($c_op eq "<=")
{
return 0 if ($form_value <= $db_value);
}
if ($c_op eq "!=")
{
return 0 if ($form_value != $db_value);
}
if ($c_op eq "=")
{
return 0 if ($form_value == $db_value);
}
} # End of elsif ($c_type =~ /number/i)
else
{
if ($c_op eq ">")
{
return 0 if ($form_value gt $db_value);
}
if ($c_op eq "<")
{
return 0 if ($form_value lt $db_value);
}
if ($c_op eq ">=")
{
return 0 if ($form_value ge $db_value);
}
if ($c_op eq "<=")
{
return 0 if ($form_value le $db_value);
}
if ($c_op eq "!=")
{
return 0 if ($form_value ne $db_value);
}
}
}
}
else
{
if ($as_a_phrase eq "on") { @word_list = $form_value; }
else { @word_list = split(/\s+/,$form_value); }
foreach $word (@word_list) {
$word =~ s/\+/\plus/g;
$word =~ s/[\+]+/\\\+/;
$word =~ s/\*/\star/g;
$word =~ s/\?/\question/g;
$word =~ s/\[/\lb/g;
$word =~ s/\(/parenthesis/g;
$word =~ s/\)/parenthesis/g;
$word =~ s/\$/dollarsign/g;
}
foreach $db_index (@criteria_fields)
{
$db_value = $fields[$db_index];
$db_value =~ s/\+/\plus/g;
$db_value =~ s/\*/\star/g;
$db_value =~ s/\?/\question/g;
$db_value =~ s/\[/\lb/g;
$db_value =~ s/\(/parenthesis/g;
$db_value =~ s/\)/parenthesis/g;
$db_value =~ s/\$/dollarsign/g;
$not_found = "yes";
my($match_word) = "";
my($x) = "";
if ($case_sensitive eq "on")
{
if ($exact_match eq "on")
{
for ($x = @word_list; $x > 0; $x--)
{
$match_word = $word_list[$x - 1];
if ($db_value =~ /\b$match_word\b/)
{
splice(@word_list,$x - 1, 1);
}
}
}
else
{
for ($x = @word_list; $x > 0; $x--)
{
$match_word = $word_list[$x - 1];
if ($db_value =~ /$match_word/)
{
splice(@word_list,$x - 1, 1);
}
}
}
}
else
{
if ($exact_match eq "on")
{
for ($x = @word_list; $x > 0; $x--)
{
$match_word = $word_list[$x - 1];
if ($db_value =~ /\b$match_word\b/i)
{
splice(@word_list,$x - 1, 1);
}
}
}
else
{
for ($x = @word_list; $x > 0; $x--)
{
$match_word = $word_list[$x - 1];
if ($db_value =~ /$match_word/i)
{
splice(@word_list,$x - 1, 1);
}
}
}
}
}
if (@word_list < 1)
{
$not_found = "no";
}
}
if ($not_found eq "yes")
{
return 1;
}
else
{
return 0;
}
}
------------------------------
Date: Tue, 28 Jan 2003 18:27:30 GMT
From: Uri Guttman <uri@stemsystems.com>
Subject: Re: cgi-lib to cgi.pm conversion
Message-Id: <x7d6mhf7u6.fsf@mail.sysarch.com>
OMG! i can't even begin to comment on how bad that code is. poorly
formatted, perl4ish, no comments, redundant code all over the place,
etc.
i would scrap the whole thing and redo it from scratch.
uri
--
Uri Guttman ------ uri@stemsystems.com -------- http://www.stemsystems.com
----- Stem and Perl Development, Systems Architecture, Design and Coding ----
Search or Offer Perl Jobs ---------------------------- http://jobs.perl.org
Damian Conway Perl Classes - January 2003 -- http://www.stemsystems.com/class
------------------------------
Date: 28 Jan 2003 17:53:29 +0000
From: Brian McCauley <nobull@mail.com>
Subject: Re: Entering backslashed values into variables when read in from files
Message-Id: <u9el6xw486.fsf@wcl-l.bham.ac.uk>
Hal Vaughan <hal@thresholddigital.com> writes:
> Brian McCauley wrote:
>
> > You need to decide on the grammar of your input file, then write some
> > code to implement that grammar. For examples see the results of the
> > aforementioned google search.
>
> I guess, in a way, that's what I'm trying to do. But even if I have a
> config file with as simple a line as:
>
> lf=\012
>
> then, according to what you say above (that Perl is interperting a line of
> code differently than a line imported from a file), how can I tell Perl to
> read \012 from a file as a control character?
Like I said before, see the results of the aforementioned google
search.
> > However, if you like the idea that your configuration file should be
> > parsed like Perl, then there's another solution you should consider,
> > that is turning your problem inside-out...
>
> Good point. I'm not trying to make a new language
Yes you are, you are just in denial. Don't worry this is normal. I
think I had been programming 20 years before I really came to terms
with this.
> -- I am "subroutining out" a bunch of calls and trying to let one
> module handle interaction with different systems, but I still need a
> way to read a line w/ \012 (or something like \n) and convert it to
> the corresponding perl control codes.
>
> Is there a simple way to do this?
Yes, don't invent you own small lanuage, write the config file Perl.
If you don't want to go the full way and make the config file actually
be the main script then just make your module require() the config
file.
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: 28 Jan 2003 10:19:43 -0800
From: gse@antisleep.com (Scott Evans)
Subject: Re: perl code to "fix" VBR mp3s with bogus time information?
Message-Id: <ac991c1.0301281019.3f335c7@posting.google.com>
anno4000@lublin.zrz.tu-berlin.de (Anno Siegel) wrote in message news:<b15mtp$5hv$5@mamenchi.zrz.TU-Berlin.DE>...
> Scott Evans <gse@antisleep.com> wrote in comp.lang.perl.misc:
> > (I always wonder why people follow up when they don't have an answer...)
>
> It's how Usenet works. You post something, people comment on *any*
> aspect of your posting. They are by no means obliged to answer your
> questions. If you want that, use a help desk.
Thanks for proving the point. :)
scott (on usenet since 1991-ish)
------------------------------
Date: Tue, 28 Jan 2003 16:09:37 +0000 (UTC)
From: mauzo@mimosa.csv.warwick.ac.uk (Ben Morrow)
Subject: Re: Problem checking for newline in $_ input line
Message-Id: <b16a01$ijb$1@wisteria.csv.warwick.ac.uk>
"J. F. Cornwall" <JCornwall@cox.net> wrote:
>Hi, I am working out the last problem in my script to parse Fortran
>comments (header blocks) and put the information into HTML pages. I am
>having problems checking for the newline in some of the llines of text
>being parsed though.
>
>Fortran comment line:
>
>"C *(\n)"
>
>C in column 1, variable number of spaces, variable number of "*" chars.
>
>If I get a line like this in the header block, I want to skip over it,
>so I try this:
>
># check for blank line after "c *", else strip "c *" and print comment
>if (s/^C\s+\*+\n//i)
> { $ignore_fg = 1; $purpose_fg = 0; print "</I> <BR>\n"; }
>else
> { s/^C\s+\*+\s+/ /i; print $_; }
>}
>
>The "^C\s+\*+" part is working as far as I can tell, but it isn't
>recognizing the newline "\n" part of the pattern matching. Any
>suggestions?
If you're reading a line at a time then you should have chomped it so the \n
isn't even there any more. What you are looking for is C<$>, viz.
end-of-string, thus:
/^C\s+\*+$/
.
Ben
------------------------------
Date: Tue, 28 Jan 2003 16:45:25 GMT
From: "J. F. Cornwall" <JCornwall@cox.net>
Subject: Re: Problem checking for newline in $_ input line
Message-Id: <FsyZ9.32684$Vh.21698@news2.central.cox.net>
Ben Morrow wrote:
> "J. F. Cornwall" <JCornwall@cox.net> wrote:
>
>>Hi, I am working out the last problem in my script to parse Fortran
>>comments (header blocks) and put the information into HTML pages. I am
>>having problems checking for the newline in some of the llines of text
>>being parsed though.
>>
>>Fortran comment line:
>>
>>"C *(\n)"
>>
>>C in column 1, variable number of spaces, variable number of "*" chars.
>>
>>If I get a line like this in the header block, I want to skip over it,
>>so I try this:
>>
>># check for blank line after "c *", else strip "c *" and print comment
>>if (s/^C\s+\*+\n//i)
>> { $ignore_fg = 1; $purpose_fg = 0; print "</I> <BR>\n"; }
>>else
>> { s/^C\s+\*+\s+/ /i; print $_; }
>>}
>>
>>The "^C\s+\*+" part is working as far as I can tell, but it isn't
>>recognizing the newline "\n" part of the pattern matching. Any
>>suggestions?
>
>
> If you're reading a line at a time then you should have chomped it so the \n
> isn't even there any more. What you are looking for is C<$>, viz.
> end-of-string, thus:
>
> /^C\s+\*+$/
>
> .
>
> Ben
Argh... (or is D'OH!! more appropriate?) Thank you, I will change
that. I did have a chomp at the top of the loop.
Jim
------------------------------
Date: 28 Jan 2003 09:06:33 -0800
From: doug.portz@mts.mb.ca (doug)
Subject: Re: Question about 64bit Integers in Perl
Message-Id: <bff1479d.0301280906.438ea82d@posting.google.com>
After running the script you provided, it appears that the perl
compiled on the server does not support 64 bit, but does work with
BigInt.
Now maybe I am showing my ignorance here, but if we have a
non-compiled version of the perl code that was originally written (I
am assuming that there is a copy around) can it not be just recompiled
with 64bit support without any changes?
If so, is there a particular version of Perl that is required to
compile with 64 bit support?
Thanks again for all your help
Doug
> Yes, perl can handle integers of any size, but unless perl has been
> compiled with 64-bit integer support, then you'll need to 'use
> Math::BigInt;' to handle integers bigger than 53 bits.
>
> Try:
> my $x = 2 ** 63 + 25;
> my $y = 2 ** 63 + 30;
> if($x == $y) {print "64 bits not supported"}
> else {print "64 bits supported"}
>
> See what that tells you.
>
> Then try:
> use Math::BigInt;
> my $two = Math::BigInt->new(2);
> my $x = $two ** 63 + 25;
> my $y = $two ** 63 + 30;
> if($x == $y) {print "64 bits not supported"}
> else {print "64 bits supported"}
>
> Better news ..... hopefully :-)
>
> Cheers,
> Rob
------------------------------
Date: 28 Jan 2003 10:50:00 -0800
From: mark.wirdnam@stud.unibas.ch (Mark Wirdnam)
Subject: question concerning using objects in a module
Message-Id: <3c6df95c.0301281050.68879695@posting.google.com>
Hello!
I have tried to understand as much of perltoot as I could (for the
moment). As you will notice immediately I am an inexperienced amateur
trying to program a rather large project. In an attempt to keep things
clear for myself I am seperating the program's tasks into modules.
Here is how I am writing code at the moment:
package Example;
use Package1;
...
sub new {
my $self .... # will be blessed
$self->{var1} = ....
$self->{var2} = ....
# here comes the bit i'm aiming at: i introduce an object of Package1
i'll be using
$self->{ref_pac_1} = Package1->new(....
...
...
} # end new
sub does_something {
my $self = shift;
# and here i use it
($self->{ref_pac_1})->do_what_i_want();
...
...
}
I hope I have understood correctly that this has nothing to do with
inheritance, right? I'm just using packages within a package.
But the way I'm doing it is a lot of typing and not very easy to read.
So is there something wrong with this way? What would be a more
maintainable way?
I read this newsgroup with great pleasure, finding helpful advice here
everyday. I would be very grateful to get advice also for this
specific question.
Mark Wirdnam
------------------------------
Date: Tue, 28 Jan 2003 18:38:51 -0000
From: "Alex Banks" <alex@alexbanks.com>
Subject: regex to escape special characters
Message-Id: <3e36ce3c$0$219$cc9e4d1f@news.dial.pipex.com>
is there a regular expression to escape all non alphanumeric characters in a
string?
at the moment, i'm using s/\W//g to delete them, and s/\"/\\\"/g for
individual characters that i need to escape, but it all looks a bit pete
tong.
alex
(couldn't find a regex-dedicated group. is there one?)
------------------------------
Date: 28 Jan 2003 09:40:55 -0800
From: 4.spam@cox.net (Mac)
Subject: Substituting words in Array with items from a hash?
Message-Id: <37da63be.0301280940.db246fa@posting.google.com>
I have read a file (a template for a webpage) into an array.
I am now trying to scan this array and substitute words that mach the
keys in the hash %in and replace the words with the values in the hash
%in. The goal is to take a web form and using the values replace the
field names with the field values in a template file.
I guess you could say that I am a newbie so be gentle.
Here is my script so far:
#!/usr/bin/perl
# Process Form data if present
###############################################################
( ! &ReadParse );
$template = $in{'template'}; # Sets the Template file to be used
# from hidden form field
template
open WEBFILE, $template or die $!; # Opens the file if exists
@lines = <WEBFILE>; # Read it into an Array
close(WEBFILE); # Close the file
# Return the basic response page. (this works)
###############################################################
print "Content-type: text/html\n\n";
print "<title>The Response</title><h1>The Response</h1><hr>";
print "Here is the form data:<ul>";
# Print list items of the form data in %in
foreach $key (keys %in) {
print "<li>$key: $in{$key}";
}
print "</ul>";
# Substitute keys with values from the hash in the array and return
# response page(this does not work)
###############################################################
foreach $key (@lines) {
$key =~ s/$key/$in{$key}/g;
}
print "<br>--------------Array with subsitution------------<br>";
print "@lines";
# Read input and parse data
###############################################################
sub ReadParse {
local (*in) = @_ if @_;
local ($i, $key, $val);
($ENV{'REQUEST_METHOD'} eq "POST");
read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
@in = split(/&/,$in);
foreach $i (0 .. $#in) {
# Convert plus's to spaces
$in[$i] =~ s/\+/ /g;
# Split into key and value.
($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
# Convert %XX from hex numbers to alphanumeric
$key =~ s/%(..)/pack("c",hex($1))/ge;
$val =~ s/%(..)/pack("c",hex($1))/ge;
# Associate key and value
$in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple
separator
$in{$key} .= $val;
}
return length($in);
}
------------------------------
Date: 28 Jan 2003 18:05:55 +0000
From: Brian McCauley <nobull@mail.com>
Subject: Re: Tainting individual variables
Message-Id: <u9adhlw3ng.fsf@wcl-l.bham.ac.uk>
mauzo@ux-ma160-16.csv.warwick.ac.uk (Ben Morrow) writes:
> john_ramsden@sagitta-ps.com (John Ramsden) wrote:
> >I have an app in which the user can specify a 'boiler plate' text string
> >to appear in an alert email, and this string can contain any of a dozen
> >or so variables, such as $msg_severity, $device_name, etc, which means
> >I must eval() the text with variables of the valid names all in scope
> >in order to plug in the values of any referred to in the text.
> >
> <snip>
> >
> >(I'd rather eval than simply substitute values via su///, as this allows
> >the string to include logical constructs such as '? :'.)
>
> You might want to look at the Safe module.
Actually it's a lot of work to use Safe to contain the interpolation
engine safely. That's largely why I wrote String::Interpolate.
The safe mode of String::Interpolate plugs some of the gaps that
simply using Safe without additional precuations would leave open
(e.g. making $_ a reference to a blessed thingy with an
intruder-supplied DESTROY method).
However I can't be sure it gets them all.
I know for example one security flaw has been found in Safe since I
wrote String::Interpolate.
Message-ID: <HH4n9.134682$142.1788540@news.chello.at>
http://groups.google.com/groups?selm=HH4n9.134682%24142.1788540%40news.chello.at
Unless you have a version of Safe in which this has been fixed then
String::Interpolate would be vulnerable to this attack.
> OTOH it is always safer to parse something yourself: a parser that understands
> +, -, ., ?:, &&, || wouldn't be that hard to write.
Agghhh! Another "small language". Perl has a very good interpolation
engine. I think you should use it rather than re-invent the wheel.
If you want a re-invented wheel then look at the modules on CPAN with
Template in their names.
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: 28 Jan 2003 18:19:17 +0000
From: Brian McCauley <nobull@mail.com>
Subject: Re: Tainting individual variables
Message-Id: <u965s9w316.fsf@wcl-l.bham.ac.uk>
"Tassilo v. Parseval" <tassilo.parseval@localhost.localhost> writes:
> Also sprach John Ramsden:
>
> > I have an app in which the user can specify a 'boiler plate' text string
> > to appear in an alert email, and this string can contain any of a dozen
> > or so variables, such as $msg_severity, $device_name, etc, which means
> > I must eval() the text with variables of the valid names all in scope
> > in order to plug in the values of any referred to in the text.
> You might have a look at the String::Interpolate module.
> I haven't ever used it myself but I remember that Brian wrote it for
> that very purpose:
use String::Interpolate;
my $i = safe String::Interpolate {
msg_severity => \$msg_severity,
device_name => \$device_name,
};
my $alert = $i->($boiler_plate);
> ... a safe interpolation without involving any possibly harmful
> eval().
I should point out that at its heart String::Interpolate simply calls
eval inside a very restrictive sandbox (made up using a 'Safe'
compartment and variables tied to blessed closures). Security flaws
in the Safe module _have_ been discovered - see my other response in
this thread.
> > Although the users will all be internal, so it can be assumed they are
> > cooperative from the standpoint of the app, and certainly not malicious,
> > I'd like to avoid even the theoretical possibility of some joker setting
> > up a string such as `rm -rf /` or something.
Well, String::Interpolate will defeat all but the most determined joker.
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: Tue, 28 Jan 2003 18:24:03 +0100
From: Michael Kirchner <michael.kirchner@unibw-muenchen.de>
Subject: test for (non-)interactive program run
Message-Id: <3E36BCB3.2090708@unibw-muenchen.de>
Hi
Does anyone know how to check whether my program has been started from
an interactive shell or non-interactively by the cron-daemon? In the
interactive mode I want to have warning messages printed on the screen
and in the non-interactive case I want to write them to a specific file.
Thanks for your help.
Michael
------------------------------
Date: 28 Jan 2003 18:28:00 +0100
From: Espen Myrland <espenmyr@start.no.cretinfilter>
Subject: Re: test for (non-)interactive program run
Message-Id: <87d6mh421r.fsf@chello.no>
Michael Kirchner <michael.kirchner@unibw-muenchen.de> writes:
> Hi
>
> Does anyone know how to check whether my program has been started from
> an interactive shell or non-interactively by the cron-daemon? In the
> interactive mode I want to have warning messages printed on the screen
> and in the non-interactive case I want to write them to a specific file.
>
isatty(). But I think it's better to redirect the output from
cron to /dev/null. just append > /dev/null 2>&1 in crontab.
--
espen
------------------------------
Date: Tue, 28 Jan 2003 19:23:38 +0100
From: Michael Kirchner <michael.kirchner@unibw-muenchen.de>
Subject: Re: test for (non-)interactive program run
Message-Id: <3E36CAAA.1060805@unibw-muenchen.de>
Espen Myrland schrieb:
> Michael Kirchner <michael.kirchner@unibw-muenchen.de> writes:
>
>
>>Hi
>>
>>Does anyone know how to check whether my program has been started from
>>an interactive shell or non-interactively by the cron-daemon? In the
>>interactive mode I want to have warning messages printed on the screen
>>and in the non-interactive case I want to write them to a specific file.
>>
>
>
>
> isatty().
which module belongs it to?
> But I think it's better to redirect the output from
> cron to /dev/null. just append > /dev/null 2>&1 in crontab.
I do so... with the normal output. But I want to keep error and warning
messages to see where problems may occur...
Best regards
Michael
------------------------------
Date: Tue, 28 Jan 2003 12:43:55 -0600
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: test for (non-)interactive program run
Message-Id: <slrnb3djrb.6e1.tadmc@magna.augustmail.com>
Michael Kirchner <michael.kirchner@unibw-muenchen.de> wrote:
> Does anyone know how to check whether my program has been started from
> an interactive shell or non-interactively
perldoc -f -t
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: 28 Jan 2003 08:44:09 -0800
From: jeremy.gooch@axa-im.com (Jeremy Gooch)
Subject: Timestamps to thousandths of a second.
Message-Id: <723f1c02.0301280844.3e8918e3@posting.google.com>
I need to generate a current date/timestamp in the format
yyyymmddhhmmssxxx where xxx are the thousandths of a second. The code
must be portable across Solaris and NT.
Up until now, we've always used Date::Calc Today_and_Now because we've
only needed stamps down to a second. The docs imply that Date::Calc
cannot go to any lower level of accuracy.
Time::HiRes can give me milliseconds since the epoch, but then I'd
have to format it to pull out the date etc.
I'm sure I'm missing an obvious solution. Can anyone point it out?
Thanks.
------------------------------
Date: Tue, 28 Jan 2003 16:07:07 +0000 (UTC)
From: mauzo@mimosa.csv.warwick.ac.uk (Ben Morrow)
Subject: Re: unlink()
Message-Id: <b169rb$ihi$1@wisteria.csv.warwick.ac.uk>
"Jόrgen Exner" <jurgenex@hotmail.com> wrote:
>David wrote:
>> "Joel Konkle-Parker" <joeljkp@tabdemo.larc.nasa.gov> wrote in message
>> news:3E2FFC7E.1060906@tabdemo.larc.nasa.gov...
>>> I have the following lines at the end of my script:
>>>
>>> unlink ("./temp_trail.txt") || die $!;
>>> unlink ("./prt0001__out.log.1") || die $!;
>>>
>>> But when my script ends each time, the files are still there. The
>>> 'die' doesn't produce any output. This is Perl 5.004. What's wrong
>>> here?
>>
>> The "./" preceding each file name. Omit that, and I bet it will work
>> for you (assuming you have the file names entered correctly).
>
>If this really helps then I would very much like to learn why.
>Is this for some odd file system where "." does not denote the CWD or "/" is
>not used as path separator? Or a file system which does not have a
>hierarchal tree structure?
>For all file system I know "foo" and "./foo" denote the same file.
MacOS?
RISCOS?
Ben
------------------------------
Date: Tue, 28 Jan 2003 16:21:05 +0000
From: Simon Oliver <simon.oliver@nospam.umist.ac.uk>
Subject: Re: Very Basic Question on the Use of the __DATA__ Token
Message-Id: <3E36ADF1.6090501@nospam.umist.ac.uk>
> while (<main::DATA>) {
> find (\&sav_fd, @_);
I think that should be:
find (\&sav_fd, $_);
or even
while (my $dir = <main::DATA>) {
find (\&sav_fd, $dir);
--
Simon Oliver
------------------------------
Date: Tue, 28 Jan 2003 13:20:49 -0500
From: Jeff 'japhy' Pinyan <pinyaj@rpi.edu>
To: Simon Oliver <simon.oliver@umist.ac.uk>
Subject: Re: Why doesn't perl -ex 'print 1' work on Windows?
Message-Id: <Pine.SGI.3.96.1030128131935.34001A-100000@vcmr-64.server.rpi.edu>
[posted & mailed]
On Tue, 28 Jan 2003, Simon Oliver wrote:
>John Ramsden wrote:
>> Why do all the following commands, and several other variations,
>> print just a blank line in a Windows 2K DOS window, whereas the
>> equivalent single-line Perl scripts print what is asked for?
>>
>> perl -ex "print 1"
>> perl -ex 'print 1'
>> perl -ex "print \"\n\""perldoc perlrun
>> perl -ex "print time"
>> perl -ex "print time();"
>> ::::
>
>Are you sure? On my Linux box they print a balnk line too - as they
>shouls. See perldoc perlrun form an explanation of the -x option.
The -x option doesn't enter into it.
perl -efoobar 'print 1'
is the same as
perl -e 'foobar' 'print 1'
which executes the code 'foobar', and puts 'print 1' in @ARGV. So the
original code executes 'x' (which does nothing) and puts 'print 1' in
@ARGV.
--
Jeff Pinyan RPI Acacia Brother #734 2003 Rush Chairman
"And I vos head of Gestapo for ten | Michael Palin (as Heinrich Bimmler)
years. Ah! Five years! Nein! No! | in: The North Minehead Bye-Election
Oh. Was NOT head of Gestapo AT ALL!" | (Monty Python's Flying Circus)
------------------------------
Date: Tue, 28 Jan 2003 13:21:17 -0500
From: Jeff 'japhy' Pinyan <pinyaj@rpi.edu>
To: Bernard El-Hagin <bernard.el-hagin@lido-tech.net>
Subject: Re: Why doesn't perl -ex 'print 1' work on Windows?
Message-Id: <Pine.SGI.3.96.1030128132055.34001C-100000@vcmr-64.server.rpi.edu>
[posted & mailed]
On Tue, 28 Jan 2003, Bernard El-Hagin wrote:
>On 28 Jan 2003 01:14:38 -0800, john_ramsden@sagitta-ps.com (John
>Ramsden) wrote:
>
>>Why do all the following commands, and several other variations,
>>print just a blank line in a Windows 2K DOS window, whereas the
>>equivalent single-line Perl scripts print what is asked for?
>>
>> perl -ex "print 1"
>> perl -ex 'print 1'
>> perl -ex "print \"\n\""
>> perl -ex "print time"
>> perl -ex "print time();"
>
>Are you aware of what the -x switch does? If not try:
The -x option doesn't enter into it.
perl -efoobar 'print 1'
is the same as
perl -e 'foobar' 'print 1'
which executes the code 'foobar', and puts 'print 1' in @ARGV. So the
original code executes 'x' (which does nothing) and puts 'print 1' in
@ARGV.
--
Jeff Pinyan RPI Acacia Brother #734 2003 Rush Chairman
"And I vos head of Gestapo for ten | Michael Palin (as Heinrich Bimmler)
years. Ah! Five years! Nein! No! | in: The North Minehead Bye-Election
Oh. Was NOT head of Gestapo AT ALL!" | (Monty Python's Flying Circus)
------------------------------
Date: 28 Jan 2003 17:40:00 +0000
From: Brian McCauley <nobull@mail.com>
Subject: Re: win32 tieregistry html
Message-Id: <u9isw9w4un.fsf@wcl-l.bham.ac.uk>
nac@advancecare.com (Nuno Cancelo) writes:
> the reason that i don't use the getlogin function is when i run on a
> web server, using ie as a cliente, insted of giving me the username of
> the person logged in the machine shows me "SYSTEM".
That is correct. Get login referes to the current user. The concept
of _the_ person logged in the machine is not one that has much meaning
at the OS level.
> I'm kind a new is this perl "thing",
Your problem has nothing whatever to do with Perl.
> but i thougt that by using TieRegistry, my problem whould be bypass
> but doesn't seem so. Any ideas??
You appear to be saying that you are not content with the the normal
web authentication mechanisms and want a web server to have cognizance
of the OS-level user id of a user using the web browser.
In Apache I've done this using the IdentityCheck directive. Of this
requires the client OS to be RFC1413-compliant and requires that there
are no proxies involved (unlikely if client and server are on the same
box anyhow!). You can find an IDENTD.EXE for windows on the Internet.
Note that this is not a secure authentication mechanism and should not
be treated as such.
Like I said before, if you are using IIS and IE I think there's some
M$ proprietory (and maybe even secure) trick.
I think you'd be better off just using the normal web authentication
methods.
None of this, of course, has anything to do with Perl.
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
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.
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 4477
***************************************
