[25792] in Perl-Users-Digest
Perl-Users Digest, Issue: 8031 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat Apr 30 03:05:22 2005
Date: Sat, 30 Apr 2005 00:05:07 -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 Sat, 30 Apr 2005 Volume: 10 Number: 8031
Today's topics:
Re: [Golf-ish] Ordered hash keys <pilkowsk@informatik.uni-marburg.de>
Re: [Golf-ish] Ordered hash keys <tadmc@augustmail.com>
Re: [Golf-ish] Ordered hash keys <wyzelli@yahoo.com>
Re: Finally a better script! <hackeras@gmail.com>
Re: Finally a better script! <hackeras@gmail.com>
Re: Finally a better script! <pilkowsk@informatik.uni-marburg.de>
Re: Finally a better script! <hackeras@gmail.com>
Re: Finally a better script! <emschwar@pobox.com>
Re: Finally a better script! <pilkowsk@informatik.uni-marburg.de>
Re: Finally a better script! <hackeras@gmail.com>
Perfecting index.pl some more! <hackeras@gmail.com>
Re: Perfecting index.pl some more! <tassilo.von.parseval@rwth-aachen.de>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sat, 30 Apr 2005 02:17:47 +0200
From: Fabian Pilkowski <pilkowsk@informatik.uni-marburg.de>
Subject: Re: [Golf-ish] Ordered hash keys
Message-Id: <3dg141F6pleijU1@individual.net>
* Damian James schrieb:
>
> So I wanted to define a lookup table that I would later need to
> iterate over in a specific order. That's easy enough, there are
> many ways to do it; but I specifically wanted to keep the neat,
> visually oriented table in my code:
>
> my @mappings = (
> field1 => 'otherLongwindedDirectoryAttribute',
> field2 => 'kitchenSink',
> field3 => 'userDistanceBetweenEyes'
> );
> my %lookup = @mappings;
> my @fields = @mappings[ map $_*2, 0..($#mappings/2) ];
>
> ...where obviously I am only interested in %lookup and @fields, but
> want to keep the table in the interests of easy alteration.
When typing `perldoc -q "keep my hash sorted"` I get:
Found in C:\Programme\Perl\lib\pod\perlfaq4.pod
How can I always keep my hash sorted?
You can look into using the DB_File module and tie() using the $DB_BTREE
hash bindings as documented in "In Memory Databases" in DB_File. The
Tie::IxHash module from CPAN might also be instructive.
Have a look at this Tie::IxHash from CPAN. Your code could look like:
use Tie::IxHash;
tie( my %lookup, 'Tie::IxHash',
field1 => 'otherLongwindedDirectoryAttribute',
field2 => 'kitchenSink',
field3 => 'userDistanceBetweenEyes'
);
my @fields = keys %lookup;
But I think you don't need your array @fields anymore when using this
module. When keep sorted your Hash by another value have a look at
Tie::Hash::Sorted. In the past many people have thought about ordered
hashes -- I think you won't reinventing the wheel ... ;-)
regards,
fabian
------------------------------
Date: Fri, 29 Apr 2005 21:13:59 -0500
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: [Golf-ish] Ordered hash keys
Message-Id: <slrnd75qf7.eq2.tadmc@magna.augustmail.com>
Damian James <djames@thehub.com.au> wrote:
> my @fields = @mappings[ map $_*2, 0..($#mappings/2) ];
> Is there a simpler, shorter
> or more elegant 'hashificator' that might be suitable in place of the
> arithmetic one I've shown?
You can save 3 strokes by generating the slice indexes with:
grep $_%2, 0..$#mappings
instead of map().
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Sat, 30 Apr 2005 05:54:39 GMT
From: "Peter Wyzl" <wyzelli@yahoo.com>
Subject: Re: [Golf-ish] Ordered hash keys
Message-Id: <z4Fce.34037$5F3.15597@news-server.bigpond.net.au>
"Damian James" <djames@thehub.com.au> wrote in message
news:slrnd75cij.mk.djames@puli.local...
: Hi folks,
:
: So I wanted to define a lookup table that I would later need to
: iterate over in a specific order. That's easy enough, there are
: many ways to do it; but I specifically wanted to keep the neat,
: visually oriented table in my code:
:
: my @mappings = (
: field1 => 'otherLongwindedDirectoryAttribute',
: field2 => 'kitchenSink',
: field3 => 'userDistanceBetweenEyes'
: );
: my %lookup = @mappings;
: my @fields = @mappings[ map $_*2, 0..($#mappings/2) ];
:
: ...where obviously I am only interested in %lookup and @fields, but
: want to keep the table in the interests of easy alteration.
I have previously done somthing like:
my %lookup = (
field1 => 'otherLongwindedDirectoryAttribute',
field2 => 'kitchenSink',
field3 => 'userDistanceBetweenEyes'
);
my @fields = sort(keys(%lookup));
But this relies on sort giving you the order you want rather than a specific
order which may not necessarily match sort's output. Unless you can define
some sort routine that matches your preferred order. In the example given
it would match but that is probably just a happy coincidence of your example
data. How critical is the 'preferred order' of the keys compared to a
'sorted order' of the keys for later processing?
P
------------------------------
Date: Sat, 30 Apr 2005 01:19:31 +0300
From: Nikos <hackeras@gmail.com>
Subject: Re: Finally a better script!
Message-Id: <d4ubtf$7bk$1@nic.grnet.gr>
Nikos wrote: old_script [snip]
Here is the script modified again implementing new ideas:
<code>
my %sql = (
get_counter => "SELECT counter FROM visitorlog",
get_host => "SELECT host FROM visitorlog WHERE host=?",
update_counter => "UPDATE visitorlog SET counter+=1",
update_visitorcounter => "UPDATE visitorlog SET visitorcounter+=1
WHERE host=?",
update_passage => "UPDATE visitorlog SET passage=? WHERE
host=?",
insert_host => "INSERT INTO visitorlog (host, date,
passage, visitorcounter, counter) VALUES (?, ?, ?, ?, ?)",
);
my $passage = param('select') || "Áñ÷éêÞ Óåëßäá!";
my ($data, @data);
if (param('select') and param('select') ne '..')
{
open(FILE, "<../data/text/$passage.txt") or die $!;
@data = <FILE>;
close(FILE);
$data = join('', @data);
$sth = $dbh->prepare( $sql{update_passage} );
$sth->execute($passage, $host);
}
else
{
my $sth = $dbh->prepare( $sql{get_host} );
$sth->execute($host);
if ($sth->rows)
{
$sth = $dbh->prepare( $sql{update_host} );
$sth->execute($host);
$sth = $dbh->prepare( $sql{get_host} );
$sth->execute($host);
$row = $sth->fetchrow_hashref;
$data = "Êáëþò Þëèåò " .$host. "! ×áßñïìáé ðïõ âñßóêåò ôçí
óåëßäá åíäéáöÝñïõóá!\n" .
"Ôåëåõôáßá öïñÜ Þñèåò åäþ ùò " .$row->{host}. " óôéò "
.$row->{date}. " !!\n" .
"ÓýíïëéêÝò Þñèåò åäþ " .$row->{guestcounter}. "
öïñÝò!!!\n" .
"Ôåëåõôáßá åßäåò ôï êåßìåíï { " .$row->{passage}. " }\n" .
"Ðïéü êåßìåíï èá ìåëåôÞóåòé áõôÞí ôçí öïñÜ !?";
}
else
{
if ($host ne "Íßêïò")
{
$data = "ÃåéÜ óïõ " .$host. "!\n" .
"¸ñ÷åóáé ãéá 1ç öïñÜ åäþ !!\n" .
"Åëðßæù íá âñåßò ôá êåßìåíá åíäéáöÝñïíôá :-)";
$sth = $dbh->prepare( $sql{insert_host} );
$sth->execute($host, $date, $passage, $guestcounter, $counter);
}
else
{
$data = "ÃåéÜ óïõ Íéêüëá, ôé ÷áìðÜñéá?! ¼ëá äåîéÜ íá óïõ
ðÜíå ðÜíôá! ;-)";
}
}
}
</code>
I had trouble selecting good variable names but i think i have made good
selections. Of course i changes the mysql columns names as well.
I like your %hash idea a lot in fact i put all the sql statements there.
I was also wondering if we can shorter it and perfect it even more maybe
with subdivisions. :-)
------------------------------
Date: Sat, 30 Apr 2005 01:27:49 +0300
From: Nikos <hackeras@gmail.com>
Subject: Re: Finally a better script!
Message-Id: <d4ucd2$7pt$1@nic.grnet.gr>
A. Sinan Unur wrote:
> $data will now contain the entire contents of /data/text/$script.txt.
Yes Sinan, that is also what i want because then a javascript follows to
get the $data varibale and produce ncie effects.
$data =~ s/\n/\\n/g;
$data =~ s/"/\\"/g;
$data =~ tr/\cM//d;
print <<ENDOFHTML;
<html><head><title></title>
<script type='text/javascript'>
var textToShow = "$data";
{snip]
I was wondering if there is a way to take out the js snippet from my
index.pl but still pass the value of $data to that .js to produce the
nice effects.....
Also i have to take out the backslash and " symbols or otherwise the
javascript part wont work correctly since $data is enclosed to double
quotes.
Is there soem better way to do this?
------------------------------
Date: Sat, 30 Apr 2005 00:51:04 +0200
From: Fabian Pilkowski <pilkowsk@informatik.uni-marburg.de>
Subject: Re: Finally a better script!
Message-Id: <3dfs24F6u6310U1@individual.net>
* Henry Law schrieb:
> Nikos <hackeras@gmail.com> wrote:
>
> > if (param('select') and param('select') ne '..')
>
> And I'm sure in my own mind that this statement isn't going to do what
> you want. For a start you do realise that "ne" is higher priority
> than "and" so this is going to evaluate (param('select') ne '..')
> first (yielding a true/false value), and then take the result and
> logically "and" it with the _same_ param('select'). I may be
> completely wrong and it is exactly what you want (I'm not a skilled
> Perl-ist myself) but I can't imagine what value of param('select')
> will yield sense in that statement.
Try to read this condition as: if param is true and not equal "..". Due
to the very low precedence of and this construct makes sense, usually.
Consider the undefined value as param. Just comparing *undef* with the
string '..' throws a warning ("Use of uninitialized value in string ne
at ..."). Hence one is checking if param is not the undefined value (ok,
here the check tests for trueness instead of definedness).
regards,
fabian
------------------------------
Date: Sat, 30 Apr 2005 02:23:52 +0300
From: Nikos <hackeras@gmail.com>
Subject: Re: Finally a better script!
Message-Id: <d4ufm4$a80$1@nic.grnet.gr>
Fabian Pilkowski wrote:
> * Henry Law schrieb:
>
>>Nikos <hackeras@gmail.com> wrote:
>>
>>
>>>if (param('select') and param('select') ne '..')
Make the above if (param('select') and param('select') != '..') and its
fine :-)
------------------------------
Date: Fri, 29 Apr 2005 17:27:00 -0600
From: Eric Schwartz <emschwar@pobox.com>
Subject: Re: Finally a better script!
Message-Id: <eto64y517wb.fsf@wilson.emschwar>
Nikos <hackeras@gmail.com> writes:
> Fabian Pilkowski wrote:
>> * Henry Law schrieb:
>>
>>>Nikos <hackeras@gmail.com> wrote:
>>>
>>>
>>>>if (param('select') and param('select') ne '..')
>
> Make the above if (param('select') and param('select') != '..') and
> its fine :-)
Um, no. Read 'perldoc perlop'-- and no, I don't care if you claim to
have a hard time with it. I won't read it for you. At the very
least, you should be able to search it for != and ne and find out why
they're different, and why you're wrong.
-=Eric
--
Come to think of it, there are already a million monkeys on a million
typewriters, and Usenet is NOTHING like Shakespeare.
-- Blair Houghton.
------------------------------
Date: Sat, 30 Apr 2005 01:35:47 +0200
From: Fabian Pilkowski <pilkowsk@informatik.uni-marburg.de>
Subject: Re: Finally a better script!
Message-Id: <3dfulkF6uc0c2U1@individual.net>
* Nikos schrieb:
>
> <script type='text/javascript'>
> var textToShow = "$data";
>
> {snip]
>
> I was wondering if there is a way to take out the js snippet from my
> index.pl but still pass the value of $data to that .js to produce the
> nice effects.....
>
> Also i have to take out the backslash and " symbols or otherwise the
> javascript part wont work correctly since $data is enclosed to double
> quotes.
>
> Is there soem better way to do this?
Yes, it is. I've mentioned it in another of your threads. Admittedly, it
is hard to find, there are so many (and long) threads you started the
last days. Perhaps you want to stop that -- it would be easier to find
information one has given to you, then. Read my posting with message-id
<news:3cqclbF6n85knU1@individual.net>
again (the last sentences concern about this). Meanwhile, it's too often
that you don't take the information one gives you. You're asking and
asking but don't take care of the answers. I've answered this question
already but you're going to ask it once again. Why? I don't understand.
OTOH, I suggest you do your page without JavaScript -- it's hard enough
to learn Perl and HTML first. Once you are familiar with them you could
add some JavaScript lessons to your timetable.
And, of course, this group is not for talking about JavaScript nor any
detail you need to set up your website with that language inside.
regards,
fabian
------------------------------
Date: Sat, 30 Apr 2005 08:34:42 +0300
From: Nikos <hackeras@gmail.com>
Subject: Re: Finally a better script!
Message-Id: <d4v5dg$484$2@nic.grnet.gr>
Fabian Pilkowski wrote:
> * Nikos schrieb:
>
>><script type='text/javascript'>
>>var textToShow = "$data";
>>
>>{snip]
>>
>>I was wondering if there is a way to take out the js snippet from my
>>index.pl but still pass the value of $data to that .js to produce the
>>nice effects.....
>>
>>Also i have to take out the backslash and " symbols or otherwise the
>>javascript part wont work correctly since $data is enclosed to double
>>quotes.
>>
>>Is there soem better way to do this?
>
>
> Yes, it is. I've mentioned it in another of your threads. Admittedly, it
> is hard to find, there are so many (and long) threads you started the
> last days. Perhaps you want to stop that -- it would be easier to find
> information one has given to you, then. Read my posting with message-id
>
> <news:3cqclbF6n85knU1@individual.net>
>
> again (the last sentences concern about this). Meanwhile, it's too often
> that you don't take the information one gives you. You're asking and
> asking but don't take care of the answers. I've answered this question
> already but you're going to ask it once again. Why? I don't understand.
True but i have quit that.
If you see my posts from yesterday and on i *do* listen.
> OTOH, I suggest you do your page without JavaScript -- it's hard enough
> to learn Perl and HTML first. Once you are familiar with them you could
> add some JavaScript lessons to your timetable.
No need to learn Javascript. I wont be using this except this
char_by_char nice producing effect i want.
I must pass the value though to js if i put in in a diff file, how?
------------------------------
Date: Sat, 30 Apr 2005 08:31:40 +0300
From: Nikos <hackeras@gmail.com>
Subject: Perfecting index.pl some more!
Message-Id: <d4v57q$484$1@nic.grnet.gr>
Here is how my script has been transformed thanks to your precious
precious suggestions and mine's minor alternation:
#!/usr/bin/perl
use strict;
use warnings;
use CGI::Carp qw(fatalsToBrowser);
use CGI qw(:standard);
use CGI::Cookie;
use DBD::mysql;
use DBI;
use POSIX qw(strftime);
print header( -charset=>'iso-8859-7' );
print start_html( -style=>'../data/css/style.css', -title=>'Øõ÷ùöåëÞ Ð
+íåõìáôéêÜ Êåßìåíá!', -background=>'../data/images/night.gif' );
my ($sth, $row);
my $date = strftime( "%d %b, %H:%M", localtime );
my $host = $ENV{'REMOTE_HOST'};
$host = "Íßêïò" if ( ($host eq "dell") or ($host eq "localhost") or ($
+host ~= /vivodi.gr/) );
my $dbh = ($ENV{'SERVER_NAME'} ne 'nikolas.50free.net')
? DBI->connect('DBI:mysql:nikos_db', 'root', 'c
+ensored')
: DBI->connect('DBI:mysql:nikos_db:50free.net', 'nikos_db', 'c
+ensored')
or {RaiseError=>1};
#*********************************************************************
+**********
my @files = <../data/text/*.txt>;
my @display_files = map( /([^\/]+)\.txt/, @files );
print start_form(-action=>'index.pl');
print p( {-align=>'center'}, font( {-size=>5, -color=>'Lime'}, '
+ÄéÜëåîå Ýíá áðü ôá êåßìåíá ãéá íá äéáâÜóåéò => ' ),
popup_menu( -name=>'select', -value
+s=>\@display_files ),
submit('ÅðéëïãÞ'));
print end_form(), br();
my %sql = (
get_counter => "SELECT counter FROM visitorlog",
get_host => "SELECT host FROM visitorlog WHERE host=?",
update_visitor => "UPDATE visitorlog SET counter+=1 WHERE host=?",
update_passage => "UPDATE visitorlog SET passage=? WHERE host=?",
insert_host => "INSERT INTO visitorlog (null, host, date, passa
+ge, counter) VALUES (?, ?, ?, ?, ?, ?)"
);
my $passage = param('select') || "Áñ÷éêÞ Óåëßäá!";
my ($data, @data);
if (param('select') and param('select') != '..')
{
open(FILE, "<../data/text/$passage.txt") or die $!;
@data = <FILE>;
close(FILE);
$data = join('', @data);
$sth = $dbh->prepare( $sql{update_passage} );
$sth->execute($passage, $host);
}
else
{
my $sth = $dbh->prepare( $sql{get_host} );
$sth->execute($host);
if ($sth->rows)
{
$sth = $dbh->prepare( $sql{update_visitor} );
$sth->execute($host);
$sth = $dbh->prepare( $sql{get_host} );
$sth->execute($host);
$row = $sth->fetchrow_hashref;
$data = "Êáëþò Þëèåò " .$host. "! ×áßñïìáé ðïõ âñßóêåò ôçí óåë
+ßäá åíäéáöÝñïõóá!\n" .
"Ôåëåõôáßá öïñÜ Þñèåò åäþ ùò " .$row->{host}. " óôéò "
+ .$row->{date}. " !!\n" .
"ÓýíïëéêÝò Þñèåò åäþ " .$row->{counter}. " öïñÝò!!!\n"
+ .
"Ôåëåõôáßá åßäåò ôï êåßìåíï { " .$row->{passage}. " }\
+n" .
"Ðïéü êåßìåíï èá ìåëåôÞóåòé áõôÞí ôçí öïñÜ !?";
}
else
{
if ($host ne "Íßêïò")
{
$data = "ÃåéÜ óïõ " .$host. "!\n" .
"¸ñ÷åóáé ãéá 1ç öïñÜ åäþ !!\n" .
"Åëðßæù íá âñåßò ôá êåßìåíá åíäéáöÝñïíôá :-)";
$sth = $dbh->prepare( $sql{insert_host} );
$sth->execute(null, $host, $date, $passage, $counter);
}
else
{
$data = "ÃåéÜ óïõ Íéêüëá, ôé ÷áìðÜñéá?! ¼ëá äåîéÜ íá óïõ ð
+Üíå ðÜíôá! ;-)";
}
}
}
$data =~ s/\n/\\n/g;
$data =~ s/"/\\"/g;
$data =~ tr/\cM//d;
#*********************************************************************
+**********
print <<ENDOFHTML;
<html><head><title></title>
<script type='text/javascript'>
var textToShow = "$data";
var tm;
var pos = 0;
var counter = 0;
function init()
{ tm = setInterval("type()", 45) }
function type()
{
if (textToShow.length != pos)
{
d = document.getElementById("DivText");
c = textToShow.charAt(pos++);
if (c.charCodeAt(0) != 10)
d.appendChild(document.createTextNode(c));
else
d.appendChild(document.createElement("br"));
counter++;
if (counter >= 1800 && (c.charCodeAt(0) == 10 || c == "."))
{
d.appendChild(document.createElement("br"));
d.appendChild(document.createTextNode("Press any key..."));
counter = 0;
clearInterval(tm);
document.body.onkeypress = function () {
document.getElementById("DivText").innerHTML = '';
tm = setInterval("type()", 50);
document.body.onkeypress = null; };
}
}
else
clearInterval(tm);
}
</script>
<body onload=init()>
<center>
<div id="DivText" align="Left" style="
background-image: url(../data/images/kenzo.jpg);
border: Ridge Orange 5px;
width: 850px;
height: 500px;
color: LightSkyBlue;
font-family: Times;
font-size: 18px;">
</div
ENDOFHTML
#*********************************************************************
+**********
print br(), br(), br();
print start_form(-action=>'show.pl');
print table( {class=>'user'},
Tr( td( 'Ðþò óå ëÝíå áäåëöå?'
+ ), td( textfield( 'name' ))),
Tr( td( 'ÐïéÜ åßíáé ç ãíþìç óïõ ãéá ôçí åõ÷ïýëá
»Êýñéå Éçóïý ×ñéóôÝ, ÅëÝçóïí Ìå« ?'
+ ), td( textarea( -name=>'pray', -rows=>4, -columns=>25 ))),
Tr( td( 'ÐåñéÝãñáøå ìáò ìéá ðñïóùðéêÞ óïõ
ðíåõìáôéêÞ åìðåéñßá áðü êÜðïéïí ãÝñïíôá ðñïò
þöåëïò ôùí õðïëïßðùí áäåëöþí ( áí öõóéêÜ Ý÷åéò :-)'
+ ), td( textarea( -name=>'remark', -rows=>6, -columns=>25 ))),
Tr( td( 'Ðïéü åßíáé ôï email óïõ?'
+ ), td( textfield( 'email' ))),
Tr( td( submit( 'ÅìöÜíéóç üëùí ôùí áðüøåùí'
+ )), td( submit( 'ÁðïóôïëÞ' ))),
);
print end_form(), br(), br();
open(FILE, "<../data/text/tips") or die $!;
my @tips = <FILE>;
close(FILE);
@tips = grep { !/^\s*\z/s } @tips;
my $tip = $tips[ int(rand(@tips)) ];
print table( {class=>'tip'}, Tr( td( {class=>'tip'}, $tip ))), br();
$sth = $dbh->prepare( $sql{update_counter} ) if ($host ne "Íßêïò");
$sth->execute;
$sth = $dbh->prepare( $sql{get_counter} );
$sth->execute;
#here i decided to add together all the times visitors visit
#my webpage so to get a total counter in order to avoid
#create a new mysql table called counters and store that
#value there. Or even to a flat file!
while ($row = $sth->fetchrow_hashref)
{
$counter += $row->{counter};
}
print table( {class=>'info'},
Tr( td( {class=>'host'}, $host )),
Tr( td( {class=>'date'}, $date )),
Tr( td( {class=>'counter'}, $counter ))
);
print br(), a( {href=>'games.pl'}, img{src=>'../data/
+images/games.gif'} );
print p( {-align=>'right'}, a( {href=>'show.pl?name=showlog'}, font(
+ {-size=>2, -color=>'Lime'}, b( 'Last Update: 30/4/2005' ))));
How i can i shorter it, perfect it some more by dividing into subs?
What must be/not be in a sub?
------------------------------
Date: Sat, 30 Apr 2005 08:44:36 +0200
From: "Tassilo v. Parseval" <tassilo.von.parseval@rwth-aachen.de>
Subject: Re: Perfecting index.pl some more!
Message-Id: <slrnd76aak.pb.tassilo.von.parseval@localhost.localdomain>
Also sprach Nikos:
> Here is how my script has been transformed thanks to your precious
> precious suggestions and mine's minor alternation:
>
> #!/usr/bin/perl
> use strict;
> use warnings;
> use CGI::Carp qw(fatalsToBrowser);
> use CGI qw(:standard);
> use CGI::Cookie;
> use DBD::mysql;
I think you can drop that line as DBI will pull in the appropriate
database driver for you.
> use DBI;
> use POSIX qw(strftime);
>
> print header( -charset=>'iso-8859-7' );
> print start_html( -style=>'../data/css/style.css', -title=>'
> + !', -background=>'../data/images/night.gif' );
>
> my ($sth, $row);
> my $date = strftime( "%d %b, %H:%M", localtime );
> my $host = $ENV{'REMOTE_HOST'};
> $host = "" if ( ($host eq "dell") or ($host eq "localhost") or ($
> +host ~= /vivodi.gr/) );
>
> my $dbh = ($ENV{'SERVER_NAME'} ne 'nikolas.50free.net')
> ? DBI->connect('DBI:mysql:nikos_db', 'root', 'c
> +ensored')
> : DBI->connect('DBI:mysql:nikos_db:50free.net', 'nikos_db', 'c
> +ensored')
> or {RaiseError=>1};
[ You should do something against long lines in your postings;
These continuation pluses make the code hard to read in a newsreader. ]
> #*********************************************************************
> +**********
>
> my @files = <../data/text/*.txt>;
> my @display_files = map( /([^\/]+)\.txt/, @files );
>
> print start_form(-action=>'index.pl');
> print p( {-align=>'center'}, font( {-size=>5, -color=>'Lime'}, '
> + => ' ),
> popup_menu( -name=>'select', -value
> +s=>\@display_files ),
> submit(''));
> print end_form(), br();
>
> my %sql = (
> get_counter => "SELECT counter FROM visitorlog",
> get_host => "SELECT host FROM visitorlog WHERE host=?",
> update_visitor => "UPDATE visitorlog SET counter+=1 WHERE host=?",
> update_passage => "UPDATE visitorlog SET passage=? WHERE host=?",
> insert_host => "INSERT INTO visitorlog (null, host, date, passa
> +ge, counter) VALUES (?, ?, ?, ?, ?, ?)"
> );
>
> my $passage = param('select') || " !";
> my ($data, @data);
@data should be declared in the smallest possible scope. So remove its
declaration.
> if (param('select') and param('select') != '..')
The second conditions is most likely always true because you use the
wrong comparison-operator. String comparison is done with 'eq' and
'ne'.
> {
> open(FILE, "<../data/text/$passage.txt") or die $!;
> @data = <FILE>;
my @data = <FILE>;
> close(FILE);
>
> $data = join('', @data);
No need to read the file linewise and then join the lines to one string.
Instead:
local $/; # enable slurp-mode
$data = <FILE>;
See $INPUT_RECORD_SEPARATOR in 'perldoc perlvar'.
> $sth = $dbh->prepare( $sql{update_passage} );
> $sth->execute($passage, $host);
> }
> else
> {
[...]
> }
>
> $data =~ s/\n/\\n/g;
> $data =~ s/"/\\"/g;
> $data =~ tr/\cM//d;
As you want shorter code, here's one way:
s/\n/\\n/g,
s/"/\\"/g ,
tr/\cM//d ,
for $data;
> #*********************************************************************
> +**********
> print <<ENDOFHTML;
[...]
> ENDOFHTML
> #*********************************************************************
> +**********
>
> print br(), br(), br();
More concise:
print br() x 3;
> print start_form(-action=>'show.pl');
> print table( {class=>'user'},
> Tr( td( ' ?'
> + ), td( textfield( 'name' ))),
> Tr( td( '
> , ?'
> + ), td( textarea( -name=>'pray', -rows=>4, -columns=>25 ))),
> Tr( td( '
>
> ( :-)'
> + ), td( textarea( -name=>'remark', -rows=>6, -columns=>25 ))),
> Tr( td( ' email ?'
> + ), td( textfield( 'email' ))),
> Tr( td( submit( ' '
> + )), td( submit( '' ))),
> );
> print end_form(), br(), br();
>
> open(FILE, "<../data/text/tips") or die $!;
> my @tips = <FILE>;
> close(FILE);
>
> @tips = grep { !/^\s*\z/s } @tips;
No need for the /s modifier (it only affects what '.' matches). Also,
but this is probably a matter of style, either write '/^\s*$/' or
'/\A\s*\z' for consistency. Better yet, avoid \A and \z altogether. They
are fairly uncommon (incidentally, I had to look up their meaning
first).
> my $tip = $tips[ int(rand(@tips)) ];
The int() is reduntant here. Array-subscripts can only be integers, so
perl will truncate the number for you:
my $tip = $tips[ rand @tips ];
> print table( {class=>'tip'}, Tr( td( {class=>'tip'}, $tip ))), br();
>
> $sth = $dbh->prepare( $sql{update_counter} ) if ($host ne "");
> $sth->execute;
>
> $sth = $dbh->prepare( $sql{get_counter} );
> $sth->execute;
>
> #here i decided to add together all the times visitors visit
> #my webpage so to get a total counter in order to avoid
> #create a new mysql table called counters and store that
> #value there. Or even to a flat file!
> while ($row = $sth->fetchrow_hashref)
> {
> $counter += $row->{counter};
> }
A flat file for a counter might in fact be a better idea than iterating
over an SQL-table. It should be less wasteful. In case you should use a
file, be aware of locking issues that have to be taken into account.
> print table( {class=>'info'},
> Tr( td( {class=>'host'}, $host )),
> Tr( td( {class=>'date'}, $date )),
> Tr( td( {class=>'counter'}, $counter ))
> );
>
> print br(), a( {href=>'games.pl'}, img{src=>'../data/
> +images/games.gif'} );
> print p( {-align=>'right'}, a( {href=>'show.pl?name=showlog'}, font(
> + {-size=>2, -color=>'Lime'}, b( 'Last Update: 30/4/2005' ))));
>
>
> How i can i shorter it, perfect it some more by dividing into subs?
> What must be/not be in a sub?
For a script of that length, functions are probably not required. The
logic is fairly linear and you're not jumping around in it too much.
Tassilo
--
use bigint;
$n=71423350343770280161397026330337371139054411854220053437565440;
$m=-8,;;$_=$n&(0xff)<<$m,,$_>>=$m,,print+chr,,while(($m+=8)<=200);
------------------------------
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 8031
***************************************
