[13075] in Perl-Users-Digest
Perl-Users Digest, Issue: 484 Volume: 9
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu Aug 12 14:17:19 1999
Date: Thu, 12 Aug 1999 11:10:21 -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 Thu, 12 Aug 1999 Volume: 9 Number: 484
Today's topics:
Re: s/// and interpolation <tchrist@mox.perl.com>
Re: s/// and interpolation (Steve Linberg)
Re: s/// and interpolation <tchrist@mox.perl.com>
Re: searching complex data structure (John Porter)
Re: searching complex data structure (John Porter)
Re: Sesssion ID (I R A Darth Aggie)
Re: Sesssion ID <tchrist@mox.perl.com>
Starnge DBI behavior <raison@mc.net>
Re: Starnge DBI behavior (Steve Linberg)
String Matching html with indents <v0xman@yahoo.com>
Re: String Matching html with indents (Steve Linberg)
Re: String Matching html with indents <rootbeer@redcat.com>
Re: Upload files with Perl for Win32 ? <vkoslak@my-deja.com>
Re: while loop teminates too early (Bart Lateur)
Re: while loop teminates too early <tchrist@mox.perl.com>
Re: while loop teminates too early <tchrist@mox.perl.com>
Re: while loop teminates too early <tchrist@mox.perl.com>
Digest Administrivia (Last modified: 1 Jul 99) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 12 Aug 1999 11:33:39 -0700
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: s/// and interpolation
Message-Id: <37b30573@cs.colorado.edu>
[courtesy cc of this posting mailed to cited author]
In comp.lang.perl.misc,
linberg@literacy.upenn.edu (Steve Linberg) writes:
:You should NEVER eval a string from user input.
The Safe->reval() method, however, is admissible.
--tom
--
If the code and the comments disagree, then both are probably wrong.
--Norm Schryer
------------------------------
Date: Thu, 12 Aug 1999 13:42:06 -0400
From: linberg@literacy.upenn.edu (Steve Linberg)
Subject: Re: s/// and interpolation
Message-Id: <linberg-1208991342060001@ltl1.literacy.upenn.edu>
In article <37b30573@cs.colorado.edu>, tchrist@mox.perl.com (Tom
Christiansen) wrote:
> In comp.lang.perl.misc,
> linberg@literacy.upenn.edu (Steve Linberg) writes:
> :You should NEVER eval a string from user input.
>
> The Safe->reval() method, however, is admissible.
Something new to learn about! Thanks, Tom.
--
Steve Linberg, Systems Programmer &c.
National Center on Adult Literacy, University of Pennsylvania
Be kind. Remember, everyone you meet is fighting a hard battle.
print 'Just Another Perl ' . $perl_hierarchy[(USER+EXPERT)/2];
------------------------------
Date: 12 Aug 1999 12:00:53 -0700
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: s/// and interpolation
Message-Id: <37b30bd5@cs.colorado.edu>
[courtesy cc of this posting mailed to cited author]
In comp.lang.perl.misc,
linberg@literacy.upenn.edu (Steve Linberg) writes:
:> The Safe->reval() method, however, is admissible.
:Something new to learn about! Thanks, Tom.
You might look at this.
--tom
#!/usr/bin/perl
# qcpan - Query CPAN Module Database, CLI version
# tchrist@perl.com
use strict;
use 5.005;
use Safe 1.000;
use vars qw($Rec);
my(
$DEF_FIELDS,
$FIELD_MAX,
$TITLE,
$VERSION,
$Interactive,
$Interrupted,
$Pager,
$Sort_Field,
@Output_Fields,
);
BEGIN {
$Interactive = -t STDIN;
$| = 1; # autoflush stdout
}
$VERSION = "0.1beta";
$TITLE = "CPAN Module Database Interactive Shell";
if (!@ARGV and $Interactive) {
print "$TITLE, version $VERSION\n";
print "Type h for help.\n\n";
print "[loading database]...";
}
require CPAN::Modulelist;
print "done\n" if !@ARGV and $Interactive;
my @Field_Names = @$CPAN::Modulelist::cols;
my %f2i;
for (my $i = 0; $i < @Field_Names; $i++) {
$f2i{$Field_Names[$i]} = $i;
}
use vars qw(@Cards);
$FIELD_MAX = 300; # no more than this gets printed
$Interrupted = 0;
$SIG{INT} = sub { $Interrupted++ };
$DEF_FIELDS = "modid userid description statd statl stats stati";
set_print($DEF_FIELDS);
$Sort_Field = '';
$Pager = '';
for my $name (@Field_Names) {
no strict 'refs';
local $^W = 0;
my $n = $f2i{$name};
package Query;
*$name = *{ucfirst lc $name} = *{uc $name} = sub () { $::Rec->[$n] }
}
if (@ARGV) {
*OUTPUT = *STDOUT;
run_form("@ARGV");
exit;
} else {
interactive();
}
{ my $term;
sub promptline {
my $prompt = $_[0];
if ($Interactive && !defined($term)) {
eval { require Term::ReadLine };
unless ($@) {
$term = eval { Term::ReadLine->new("Cpan Mods") };
$term = '' unless $term;
} else {
$term = '';
}
}
if ($term) {
return $term->readline($prompt);
}
print STDOUT $prompt if $Interactive;
return scalar <STDIN>;
}
}
sub interactive {
my $input;
my $output_file = '';
my ($term, $OUT);
$SIG{PIPE} = 'IGNORE';
PROMPT:
while (defined($input = promptline("Cpan Mods> "))) {
$Interrupted = 0;
exit unless defined $input;
$input = trim($input);
next unless length $input;
my $cmd;
($cmd) = $input =~ /(\S+)/;
$cmd = quotemeta uc $cmd;
exit if "QUIT" =~ /^$cmd/;
if ("FUNCTIONS" =~ /^$cmd/) {
show_functions();
next;
}
if ("HELP" =~ /^$cmd/) {
print <<EO_HELP;
Valid fields for output and sort commands:
@Field_Names
Commands are:
quit exit
help this screen
functions list valid query functions
query enter a multiline query, terminating with "." or EOF
set sort set sort field (one only)
set pager send unredirected queries through pager
set output set output fields
Any other command is interpreted as a query. Queries may have
a trailing file or pipe redirection.
Current output fields are: @Output_Fields
Current sort field is: $Sort_Field
Current pager is: $Pager
EO_HELP
next;
}
if ("SET" =~ /^$cmd/) {
set_variable($input);
next;
}
if ("QUERY" =~ /^$cmd/) {{ # double brace for last()ing out of if
$input =~ s/\S+\s*//;
last if length $input;
print qq(Enter query, end with "." on a line by itself.\n) if $Interactive;
my $more;
while (defined($more = promptline("query: "))) {
if ($Interrupted) {
warn "Interrupted!\n";
next PROMPT;
}
last if $more =~ /^\s*\.\s*$/;
$input .= $more;
}
}}
while ($input =~ s/\\\s*$//) {
$input .= promptline("continue: ");
if ($Interrupted) {
warn "Interrupted!\n";
next PROMPT;
}
}
if ($input =~ s/(>{1,2}\s*(?=\D)\S+)$// ||
$input =~ s/\s*((?:\|\s*\w+(?:\s*-?\w*\s*)*)+)$//)
{
$output_file = $1;
unless (open (OUTPUT, $output_file)) {
warn "Can't open $output_file: $!";
}
}
run_form($input);
if (my $whither = $output_file || $Pager) {
unless (close(OUTPUT)) {
warn "can't close $whither: $!";
}
$output_file = '';
}
}
}
sub run_form {
my $search = $_[0];
my $sandbox = "Safe"->new("Query");
$sandbox->permit_only(qw(:base_core));
$sandbox->permit("require"); # for use strict
$sandbox->permit("gv"); # so they can say "field > 1" not "field() > 1"
# these are only needed for very fancy queries
#$sandbox->permit_only(qw(:base_loop :base_mem));
#$sandbox->permit(qw(padsv padav padhv padany)); # for temp variables
#$sandbox->permit("regcreset"); # for regex interp
# talk about doing things the hard way!
*Query::strict::unimport = \&strict::unimport;
*Query::strict::import = \&strict::import;
*Query::strict::bits = \&strict::bits;
if ($search) {
undef &Query::is_desirable;
my $code = "sub is_desirable { $search }";
my $ok;
{
local $^W = 0;
$ok = $sandbox->reval("use strict 'subs'; $code; 1", 0);
}
unless ($ok && !$@) {
my $error = $@;
$error =~ s/\(eval \d+\)/user code/;
$error =~ s/by operation mask //;
$error =~ s/, <.*?> chunk \d+//;
$error ||= "Compilation failure";
warn("Illegal Operation: $error\n");
return;
}
} else {
eval 'sub Query::is_desirable {1}';
}
my @recs = ();
{
local $^W = 0;
#@recs = eval { grep &Query::is_desirable, @$CPAN::Modulelist::data };
for $Rec ( @$CPAN::Modulelist::data ) {
$_ = "@$Rec";
push @recs, $Rec if &Query::is_desirable;
}
#@recs = eval { grep &Query::is_desirable, @$CPAN::Modulelist::data };
}
my $sort_on = $Sort_Field;
my $namefield = $f2i{'modid'};
if (@recs && $sort_on) { # XXX: sorting disabled
my $sf = $f2i{$sort_on};
die "no sort field $sort_on" unless defined $sf;
@recs = sort {
$a->[$sf] <=> $b->[$sf]
||
$a->[$sf] cmp $b->[$sf]
||
uc($a->[$namefield]) cmp uc($b->[$namefield])
} @recs;
}
if ($Interrupted) {
warn "Interrupted!\n";
return;
}
printf("%d records matched.\n", scalar @recs);
return unless @recs;
my $fd = fileno(OUTPUT);
if (!defined $fd || $fd == 1) {
if ($Pager) {
open(OUTPUT, "| $Pager") || warn "Can't open | $Pager: $!";
} else {
open(OUTPUT, "> -") || die "can't reopen STDOUT: $!";
}
}
my @widths = (0) x @{$recs[0]};
for my $row (@recs) {
local $^W = 0; # last line of this block has bug
for (my $i = 0; $i <= $#$row; $i++) {
my $wid = defined($row->[$i]) ? length($row->[$i]) : 0;
my $min = length($Field_Names[$i]);
$wid = $FIELD_MAX if $wid > $FIELD_MAX;
$wid = $min if $wid < $min;
$widths[$i] = $wid if $widths[$i] < $wid;
}
}
my @seqnos = map { $f2i{$_} } @Output_Fields;
make_format([ @Field_Names[@seqnos] ], [ @widths[@seqnos] ]);
for (@recs) {
last unless write_row(@$_[@seqnos]);
if ($Interrupted) {
warn "Interrupted!\n";
last;
}
}
}
sub set_print {
my @fields = split ' ', "@_";
my @new_names = ();
my $errors = 0;
for my $name ( @fields ) {
my $number = $f2i{$name};
if (defined($number)) {
push @new_names, lc $name;
} else {
print "Unknown field: $name\n" unless
$errors++;
}
}
unless ($errors) {
@Output_Fields = @new_names;
}
}
sub show_functions {
print "Extended Query Functions:\n";
my @funcs = ();
while (my($name, $stab) = each %Query::) {
push @funcs, $name if defined &$stab;
}
my $funclist = join (" ", sort {uc $a cmp uc $b} @funcs);
local $~ = "Functions";
write;
format Functions =
Valid functions are:
~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$funclist
.
}
sub write_row { write OUTPUT }
sub make_format {
my($fldref, $widref) = @_;
my $i;
my $header = '';
for ($i = 0; $i <= $#$fldref; $i++) {
$header .= '@' . '|' x $widref->[$i] . ' ';
}
my $code;
eval ($code=<<EO_HDR);
format OUTPUT_TOP =
$header
map { uc } \@\$fldref
.
EO_HDR
die "BAD HEADER CODE: $@\n$code" if $@;
$header =~ s/\|/</g;
eval ($code=<<EO_RECORD);
format OUTPUT =
$header
\@_
.
EO_RECORD
die "BAD RECORD CODE: $@\n$code" if $@;
select(OUTPUT);
$| = 1;
$- = 0;
$= = ($ENV{ROWS} || $ENV{LINES} || 24) - 1;
$^L = '';
select(STDOUT);
}
sub trim {
my @out = @_;
for (@out) {
s/^\s+//;
s/\s+$//;
}
return @out if wantarray;
return '' if @out == 0;
return $out[0];
}
sub set_variable {
my $line = $_[0];
my($varname, $values);
(undef, $varname, $values) = split(' ', $line, 3);
unless(length($varname)) {
print "Valid fields are: output pager sort\n";
return;
}
$varname = lc($varname);
$values =~ s/^\s*=\s*//;
if ($varname eq 'output') {
set_output($values);
}
elsif ($varname eq 'pager') {
set_pager($values);
}
elsif ($varname eq 'sort') {
set_sort($values);
}
else {
warn "Unrecognized variable: $varname\n";
return;
}
}
sub set_output {
my $value = lc $_[0];
if (!length($value)) {
print "Possible output fields are: @Field_Names\n";
print "Current output fields are: @Output_Fields\n";
return;
}
if ($value eq 'all') {
set_print(@Field_Names);
return;
}
if ($value eq 'default') {
set_print($DEF_FIELDS);
return;
}
set_print($value);
}
sub set_sort {
my $value = lc $_[0];
if (!length $value) {
print "Current sort field is: ",
$Sort_Field || "<DATABASE ORDER>", "\n";
return;
}
if (defined $f2i{$value}) {
$Sort_Field = $value;
} else {
warn "Invalid sort field: $value\n";
}
}
sub set_pager {
my $value = $_[0];
unless (length $value) {
print "Current pager value is: ", $Pager || "<UNSET>", "\n";
return;
}
if ($value eq 'none') {
$Pager = '';
return;
}
if ($value eq 'mine') {
if (!$ENV{PAGER}) {
warn "You have no pager in your environment.\n";
return;
}
$Pager = $ENV{PAGER};
return;
}
$Pager = $value;
}
package Query;
sub stage() { &statd }
sub idea { ( @_ ? $_[0] : 1 ) and stage =~ /i/ || 0 }
sub construction { ( @_ ? $_[0] : 1 ) and stage =~ /c/ || 0 }
sub alpha { ( @_ ? $_[0] : 1 ) and stage =~ /a/ || 0 }
sub beta { ( @_ ? $_[0] : 1 ) and stage =~ /b/ || 0 }
sub released { ( @_ ? $_[0] : 1 ) and stage =~ /R/ || 0 }
sub mature { ( @_ ? $_[0] : 1 ) and stage =~ /m/ || 0 }
sub standard { ( @_ ? $_[0] : 1 ) and stage =~ /S/ || 0 }
sub support() { &stats }
sub mailing_list { ( @_ ? $_[0] : 1 ) and support =~ /m/ || 0 }
sub developer { ( @_ ? $_[0] : 1 ) and support =~ /d/ || 0 }
sub usenet { ( @_ ? $_[0] : 1 ) and support =~ /u/ || 0 }
sub none { ( @_ ? $_[0] : 1 ) and support =~ /n/ || 0 }
BEGIN {
*mailinglist = \*mailing_list;
*list = \*mailing_list;
}
sub language() { &statl }
sub perl_only { ( @_ ? $_[0] : 1 ) and language =~ /p/ || 0 }
sub compiler { ( @_ ? $_[0] : 1 ) and language =~ /c/ || 0 }
sub mixed_language { ( @_ ? $_[0] : 1 ) and language =~ /h/ || 0 }
sub cplusplus { ( @_ ? $_[0] : 1 ) and language =~ /\+/ || 0 }
sub other { ( @_ ? $_[0] : 1 ) and language =~ /o/ || 0 }
BEGIN {
*only_perl = \&perl_only;
*perl = \&perl_only;
*C = \&compiler;
}
sub interface() { &stati }
sub functional { ( @_ ? $_[0] : 1 ) and interface =~ /f/ || 0 }
sub dual_interface { ( @_ ? $_[0] : 1 ) and interface =~ /h/ || 0 }
sub references { ( @_ ? $_[0] : 1 ) and interface =~ /r/ || 0 }
sub object_oriented { ( @_ ? $_[0] : 1 ) and interface =~ /O/ || 0 }
BEGIN {
*oo = \&object_oriented;
*OO = \&object_oriented;
*desc = \&description;
*text = \&description;
*author = \&userid;
*name = \&modid;
}
sub pragma { name =~ /^[a-z_]+$/ }
__END__
=head1 NAME
qcpan - interactive interface to the CPAN module database
=head1 SYNOPSIS
B<qcpan> [ I<query> ]
=head1 DESCRIPTION
The B<qcpan> program provides a CLI (command-line interface) to the
Perl Modules
Database. If called with query arguments, that
query is run and B<qcpan> exits. However, when called without query
arguments, the program goes into interactive mode, repeatedly reading
and executing queries and other commands until end-of-file is reached.
In interactive mode, the following commands are recognized:
=over
=item B<quit>
Exit the B<qcpan> program.
=item B<help>
Print out the list of valid fields for the output and sort commands,
the currently recognized interactive commands, and the current values
of the selected output fields, the sort field, and the pager.
=item B<query>
If arguments are given, run the given query. Otherwise,
go into multiline mode, where all lines given will be
part of the query. Multiline mode is terminated by
a line
=item B<set output>
Select which fields to output, and in what order. If no arguments are
given, list the current output fields. The special value "all" will
cause all possible output fields to be generated. This is usually too
wide for a typical screen. The special value "default" will restore
the output fields to the program default. Column headers wide enough to
fit the widest output field will be generated every screen or so.
=item B<set pager>
Set the pager command that query results should be set to, such as
B<more> or B<less>. The special value "mine" will use your B<$PAGER>
environment pager. The special value "none" clears your pager. If no
arguments are given, the current pager setting is shown.
=item B<set sort>
You may choose one of the valid output fields to sort on. The sort
is an ascending one, with values compared numerically if possible;
otherwise their ASCII values are compared case-insensitively. No further
intelligence is provided.
=back
Any unrecognized command will be compiled into a query and run against
the database. If the query ends in a backslash, you will be prompted to
enter more data until you provide a line that does not end in a backslash.
Standard output redirection is recognized: C<"E<gt> file"> will overwrite
a file, C<"E<gt>E<gt> file"> will append to a file, and C<"| program"> will
direct output to the given pager command. If no redirection is given,
but the user has previosly selected a pager via the B<set pager> command,
output is sent to that program.
=head1 EXAMPLES
The queries you type in must be legal Perl code. Each possible
output field name can be used for comparison purposes.
Here are some reasonably simple queries:
description =~ /lock/i
userid eq 'TIMB'
statd ne 'i'
modid =~ /\bdb|db\b/i
cplusplus
released cplusplus
name =~ /^[a-z_]+$/
=head1 HELPER FUNCTIONS
There are a whole lot of these. You'll have to check the source
see exactly what each does. Many are just aliases of each other for
convenient entry.
alpha beta C compiler construction cplusplus Description description
DESCRIPTION developer dual_interface functional idea interface
language list mailinglist mailing_list mature mixed_language Modid
modid MODID none object_oriented only_perl OO oo other perl perl_only
pragma references released stage standard Statd STATD statd stati Stati
STATI Statl statl STATL STATS Stats stats support usenet Userid
USERID userid
=head1 MODULES
Besides running at least version 5.005 of Perl, you will also need the
non-standard CPAN::Modulelist module, which you can extract from
the I<03modlist.data.gz> file.
If the standard input is a terminal, the Term::ReadLine module will be
used if available to provide for history and editing.
Extensive use of the Safe module is made to help you not shoot yourself,
or so that this program can be run by those you don't trust.
=head1 COPYRIGHT and LICENSE
This program is copyright (c) Tom Christiansen 1999.
This program is free and open software. You may use, modify, distribute,
and copy this program (and any modified variants) in any way you wish,
provided you do not restrict others from doing the same. Modifications
must be clearly documented as changed versions, and those modifications
must be freely provided to all.
=head1 REVISION HISTORY
Initial release (v0.1-beta): 27 March 1999.
Release v0.2-beta: 27 March 1999. Added helper functions for CLI,
added links for CGI.
--
"A momentary lapse of stupidity" -- Dean Roehrich
------------------------------
Date: Thu, 12 Aug 1999 16:39:08 GMT
From: jdporter@min.net (John Porter)
Subject: Re: searching complex data structure
Message-Id: <slrn7r5u5c.ggv.jdporter@min.net>
In article <slrn7r4q0b.d88.abigail@alexandra.delanet.com>, Abigail wrote:
>
>sub find;
>sub find {
> my ($dst, $criteria) = @_;
Uh, why did you predeclare the sub, if not to spec its prototype?
> my ($this_criterium, @other_criteria) = @$criteria;
Just FYI: the singular of "criteria" is "criterion".
--
John Porter
------------------------------
Date: Thu, 12 Aug 1999 16:56:23 GMT
From: jdporter@min.net (John Porter)
Subject: Re: searching complex data structure
Message-Id: <slrn7r5v5n.ggv.jdporter@min.net>
In article <37B12BEB.C8262476@sdrc.com>, Joe Kline wrote:
>I am searching a complex data structure (hohohohol).
>
>The key structure that I've pared down my search looks something like
>this.
>
>/ \ / \
>| alpha | | apples |
>| beta | / \ / \ | oranges |
>| gamma |-> | A | -> | dog | -> | bananas |-> [list of stuff]
>| . | | B | \ / | . |
>| . | \ / | . |
>\ / \ /
>
> V W X Y Z
>
>
>Where V is all possible keys at that level.
> W only 2 possible keys
> X only 1 possible key
> Y is all possible keys at that level
> Z all elements of the list
>
> call the structure %stuff
>
>I am looking for a specific Y and Z (my search criteria).
>
>I can only think of 2 ways to search this.
>
>2) Loop through the keys thusly:
>
>$k4 = 'criterium1';
>$v = 'criterium2';
>$k3 = 'dog';
Those variables confuse me. Where is $v used?
>K1:foreach $k1 ( keys %stuff )
>{
> K2:foreach $k2 ( qw/A B/ )
> {
> if ( exists ( $stuff{$k1}{$k2}{$k3}{$k4} ) )
> {
> push(@matches, grep( @{$stuff{$k1}{$k2}{$k3}{$k4}}) )
That grep is wrong. You better read up on grep.
> next K2;
And you surely don't need that next.
Since the key set at level 2 is fixed, and small, you could
do with just one loop:
for ( keys %stuff ) {
$stuff{$_}{'A'}{$k3}{$k4}
and push @matches, @{$stuff{$_}{'A'}{$k3}{$k4}};
$stuff{$_}{'B'}{$k3}{$k4}
and push @matches, @{$stuff{$_}{'B'}{$k3}{$k4}};
}
You may wish to avoid the autovivification of ...{$k3}
for ( keys %stuff ) {
$stuff{$_}{'A'}{$k3} && $stuff{$_}{'A'}{$k3}{$k4}
and push @matches, @{$stuff{$_}{'A'}{$k3}{$k4}};
$stuff{$_}{'B'}{$k3} && $stuff{$_}{'B'}{$k3}{$k4}
and push @matches, @{$stuff{$_}{'B'}{$k3}{$k4}};
}
You can save yourself the overhead of a few hash lookups, this way:
for ( values %stuff ) {
$_->{'A'}{$k3} && $_->{'A'}{$k3}{$k4}
and push @matches, @{$_->{'A'}{$k3}{$k4}};
$_->{'B'}{$k3} && $_->{'B'}{$k3}{$k4}
and push @matches, @{$_->{'B'}{$k3}{$k4}};
}
Now maybe you want to turn it into a map:
my @matches = map {
( $_->{'A'}{$k3} && $_->{'A'}{$k3}{$k4} ? @{$_->{'A'}{$k3}{$k4}} : () ),
( $_->{'B'}{$k3} && $_->{'B'}{$k3}{$k4} ? @{$_->{'B'}{$k3}{$k4}} : () )
} values %stuff;
--
John Porter
------------------------------
Date: 12 Aug 1999 17:26:48 GMT
From: fl_aggie@thepentagon.com (I R A Darth Aggie)
Subject: Re: Sesssion ID
Message-Id: <slrn7r612r.ht0.fl_aggie@thepentagon.com>
On Thu, 12 Aug 1999 15:58:08 GMT, Benjamin Franz
<snowhare@long-lake.nihongo.org>, in
<kaCs3.10$DI3.1923@typhoon01.swbell.net> wrote:
[just a nit, nothing serious]
+ $sec = "0$sec" if (length($sec) < 2);
+ $min = "0$min" if (length($min) < 2);
+ $hour = "0$hour" if (length($hour) < 2);
+ $mday = "0$mday" if (length($mday) < 2);
Methinks this would be more efficient (for some value of efficiency):
$sec = sprintf("%02d",$sec);
$min = sprintf("%02d",$min);
$hour = sprintf("%02d",$hour);
$mday = sprintf("%02d",$mday);
James
--
Consulting Minister for Consultants, DNRC
The Bill of Rights is paid in Responsibilities - Jean McGuire
To cure your perl CGI problems, please look at:
<url:http://www.perl.com/CPAN/doc/FAQs/cgi/idiots-guide.html>
------------------------------
Date: 12 Aug 1999 11:48:20 -0700
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: Sesssion ID
Message-Id: <37b308e4@cs.colorado.edu>
[courtesy cc of this posting mailed to cited author]
In comp.lang.perl.misc,
fl_aggie@thepentagon.com (I R A Darth Aggie) writes:
:Methinks this would be more efficient (for some value of efficiency):
:
: $sec = sprintf("%02d",$sec);
: $min = sprintf("%02d",$min);
: $hour = sprintf("%02d",$hour);
: $mday = sprintf("%02d",$mday);
for $value ($sec, $min, $hour, $mday) {
$value = sprintf "%02d", $value;
}
--tom
--
I took you for a shallow lazy misguided opportunist who could be bought for a
cheap token gift
------------------------------
Date: Thu, 12 Aug 1999 12:18:34 -0500
From: Kevin Raison <raison@mc.net>
Subject: Starnge DBI behavior
Message-Id: <37B301EA.E7F1282F@mc.net>
Have I discovered a bug? Here is the original code, which had the odd
behavior of of reusing the same memory address for each iteration of my
loop. (I am using Oracle8 on linux with DBI-1.06 and Oracle DBD most
recent version)
my @array;
my $sth = $dbh->prepare("select * from table");
$sth->execute;
my $aref;
while($aref = $sth->fetchrow_arrayref) {
push(@array,$aref);
}
foreach(@array) {
print "$_->{column1} : $_->{column2}\n";
}
$sth = {};
What happens is this:
the foreach loop prints the same info each time, even when I know that
there are three different rows being fetched (and it is always the last
row fetched). printing the ref as a scalar reveals that the DBI or DBD
module is reusing the same memory address. if I print the fetched data
within the while loop, I see each row in turn, as expected.
I switch to using $sth->fetchall_arrayref and all is OK.
--
Kevin Raison (raison@mc.net)
Senior Systems Administrator
MCnet
http://www.mc.net
------------------------------
Date: Thu, 12 Aug 1999 13:58:30 -0400
From: linberg@literacy.upenn.edu (Steve Linberg)
Subject: Re: Starnge DBI behavior
Message-Id: <linberg-1208991358300001@ltl1.literacy.upenn.edu>
In article <37B301EA.E7F1282F@mc.net>, kevin@mc.net wrote:
> Have I discovered a bug?
I don't think so.
> my @array;
> my $sth = $dbh->prepare("select * from table");
> $sth->execute;
Not checking for errors on these calls?
> foreach(@array) {
> print "$_->{column1} : $_->{column2}\n";
> }
Why are you treating $_ as a hashref, when you asked for an arrayref?
Maybe you mean $_->[0], $_->[1]?
> $sth = {};
Why are you setting $sth to a reference to an empty hash? Are you trying
to dispose of it, as in $sth->finish?
--
Steve Linberg, Systems Programmer &c.
National Center on Adult Literacy, University of Pennsylvania
Be kind. Remember, everyone you meet is fighting a hard battle.
print 'Just Another Perl ' . $perl_hierarchy[(USER+EXPERT)/2];
------------------------------
Date: Thu, 12 Aug 1999 13:30:13 -0300
From: "Vox" <v0xman@yahoo.com>
Subject: String Matching html with indents
Message-Id: <6DCs3.60923$jl.38427093@newscontent-01.sprint.ca>
If I want to replace the code below with the single word 'dogsandcats'...
<!--top-->
<br>
some text here
<br>
<!--bottom-->
I use the code below which works fine for the above...
if ($line2 =~ /<!--top-->(.*)<!--bottom-->/s) {
$line2 =~ s/^<!--top-->(.*)<!--bottom-->$/dogsandcats/egimosx;
}
but for some reason the original code will not be replaced with
'dogsandcats' when the html is indented in an html document such as:
<!--top-->
<br>
some text here
<br>
<!--bottom-->
This line here will find it ... if ($line2 =~
/<!--top-->(.*)<!--bottom-->/s) { .... but there is something wrong
with this line ... $line2 =~
s/^<!--top-->(.*)<!--bottom-->$/dogsandcats/egimosx; ... in that it won't
recognize the indents or something because it won't replace the indented
html. I'm really confused with this and I didn't find anything in any FAQ's
that would answer this so if someone could please help me in getting it to
recognize the indents it would be a great help. Thanks.
------------------------------
Date: Thu, 12 Aug 1999 13:50:50 -0400
From: linberg@literacy.upenn.edu (Steve Linberg)
Subject: Re: String Matching html with indents
Message-Id: <linberg-1208991350500001@ltl1.literacy.upenn.edu>
In article <6DCs3.60923$jl.38427093@newscontent-01.sprint.ca>, "Vox"
<v0xman@yahoo.com> wrote:
> This line here will find it ... if ($line2 =~
> /<!--top-->(.*)<!--bottom-->/s) { .... but there is something wrong
>
> with this line ... $line2 =~
> s/^<!--top-->(.*)<!--bottom-->$/dogsandcats/egimosx; ... in that it won't
^ ^ ^^^^^ ^
| | \ /
\------- (clues) -----------/ (all unnecessary in this case)
> recognize the indents or something because it won't replace the indented
> html.
That's correct, it's behaving as it should. See perlre, or the regexep
section of the Camel for an explanation of the meanings of ^ and $ in a
regexp. And you should investigate all of your "egimosx" flags at the end
as well, six of which are unnecessary for this example, and two of which
contradict each other.
--
Steve Linberg, Systems Programmer &c.
National Center on Adult Literacy, University of Pennsylvania
Be kind. Remember, everyone you meet is fighting a hard battle.
print 'Just Another Perl ' . $perl_hierarchy[(USER+EXPERT)/2];
------------------------------
Date: Thu, 12 Aug 1999 10:56:10 -0700
From: Tom Phoenix <rootbeer@redcat.com>
Subject: Re: String Matching html with indents
Message-Id: <Pine.GSO.4.10.9908121054580.7774-100000@user2.teleport.com>
On Thu, 12 Aug 1999, Vox wrote:
> Subject: String Matching html with indents
You can't properly parse HTML with just a simple pattern. Sounds as if you
need HTML::Parser, from CPAN. Have fun with it!
--
Tom Phoenix Perl Training and Hacking Esperanto
Randal Schwartz Case: http://www.rahul.net/jeffrey/ovs/
------------------------------
Date: Thu, 12 Aug 1999 17:09:04 GMT
From: Vkoslak <vkoslak@my-deja.com>
Subject: Re: Upload files with Perl for Win32 ?
Message-Id: <7ouv37$d4m$1@nnrp1.deja.com>
In article <q5Mr3.3080$4p2.3656@news.rdc1.ne.home.com>,
"Tim Bornholtz" <bornholtz@home.com> wrote:
> Use CGI.pm. In its manpage there is an example for multi-part forms
and an
> upload input type.
> If you still can't make it work feel free to e-mail me.
>
> hth,
>
> Tim Bornholtz
> tbornhol@prioritytech.com
>
> Frederic Jeanbart <telenet@citenet.net> wrote in message
> news:37AF5225.68E58A86@citenet.net...
> > Can someone give me a starting script, a clue or a resource center
about
> > uploading a file on a Win32 platform via Perl with a Web form? I
found
> > some that are made for UNIX, but they do not work on Win 95/NT...
> >
> > Thanks in advance,
> > Frederic
> >
>
>
i had to make a buffer to get it to work on nt, i think i just
had a temp file on the hard drive that was appended to every so often
it was about 2 years ago though so i dont remember much about it. :(
--
-Vkoslak
========== http://www.mp3.com/vkoslak/ ===========
I don't suffer from insanity...
I enjoy every minute of it!
Sent via Deja.com http://www.deja.com/
Share what you know. Learn what you don't.
------------------------------
Date: Thu, 12 Aug 1999 15:57:08 GMT
From: bart.lateur@skynet.be (Bart Lateur)
Subject: Re: while loop teminates too early
Message-Id: <37b4ecf6.17656300@news.skynet.be>
Larry Rosler wrote:
>A valid text file is, by *my* definition, a sequence of sequences of
>characters, where each sub-sequence is terminated by a newline
>character. Dangling characters without a terminating newline character
>are not valid.
Actually, by my definition, a text file is a file that is entirely
meaningful when looked at with a text editor (or other text viewer). THe
newline characters serve to SEPARATE the lines, not to TERMINATE them,
so a final newline at the end isn't striclty necessary.
>> It was indeed solved with 5.005 (the "defined" is implied), so it will
>> no longer fail.
>
>By 'no longer fail' you mean that the final thing returned on a line-by-
>line read of such a file is the non-line consisting solely of the
>character '0'.
No, to be precise, I mean that the while loop isn't exited when that
line is read.
All the problems were caused because Perl considers the string "0" to be
False. Nobody in his right mind would have thought any string but the
empty string could be considered False, but Perl had a mind of it's own.
The argument "Perl doesn't distinguish between strings and numbers" is
the most heard argument to keep it this way, but that doesn't reconsider
bitwise operators "&", "^" and "|".
> A run-time warning on such an occurrence would be better!
Well... yes. See also the "chop" vs. "chomp" arguments.
Bart.
------------------------------
Date: 12 Aug 1999 11:41:51 -0700
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: while loop teminates too early
Message-Id: <37b3075f@cs.colorado.edu>
[courtesy cc of this posting mailed to cited author]
In comp.lang.perl.misc,
bart.lateur@skynet.be (Bart Lateur) writes:
: open OUT,">test.txt";
: print OUT "5\n4\n3\n2\n1\n0";
: close OUT;
:Are you saying this isn't a text file?
Yup.
--tom
--
"A momentary lapse of stupidity" -- Dean Roehrich
------------------------------
Date: 12 Aug 1999 11:42:47 -0700
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: while loop teminates too early
Message-Id: <37b30797@cs.colorado.edu>
[courtesy cc of this posting mailed to cited author]
In comp.lang.perl.misc,
bart.lateur@skynet.be (Bart Lateur) writes:
:Actually, by my definition,
Anything you say, Humpty.
a text file is a file that is entirely
:meaningful when looked at with a text editor (or other text viewer). THe
:newline characters serve to SEPARATE the lines, not to TERMINATE them,
:so a final newline at the end isn't striclty necessary.
Nope.
--tom
--
X-Windows: Even your dog won't like it.
--Jamie Zawinski
------------------------------
Date: 12 Aug 1999 11:43:55 -0700
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: while loop teminates too early
Message-Id: <37b307db@cs.colorado.edu>
[courtesy cc of this posting mailed to cited author]
In comp.lang.perl.misc,
bart.lateur@skynet.be (Bart Lateur) writes:
:All the problems were caused because Perl considers the string "0" to be
:False. Nobody in his right mind would have thought any string but the
:empty string could be considered False, but Perl had a mind of it's own.
It has to work this way. Think about it.
--tom
--
"We have ways to make you scream."
--Intel advertisement, in the June 1989 Doctor Dobbs Journal
------------------------------
Date: 1 Jul 99 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 1 Jul 99)
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.misc (and this Digest), send your
article to perl-users@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.
The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq" from
almanac@ruby.oce.orst.edu. The real FAQ, as it appeared last in the
newsgroup, can be retrieved with the request "send perl-users FAQ" from
almanac@ruby.oce.orst.edu. Due to their sizes, neither the Meta-FAQ nor
the FAQ are included in the digest.
The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq" from
almanac@ruby.oce.orst.edu.
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 V9 Issue 484
*************************************
