Bad referrer!
There was a script which people were using remotely, so I have to add this
simple subroutine
to check referrers. Currently, the site is getting approx. 20,000 hits per
day.
NO one, not even a single person claimed that they have experienced any
problem after
implementing this change, except for the owner of the site. I am webmaster
for the site.
And now she is pushing to undo this change immediately because she is
constantly
getting error(bad_referrer) and unable to use this script and we both know
she is the only one
experiencing this problem.
Is there something wrong below? If yes, then why others are not getting any
bad referrer error.
If no, what could be the possible reasons that owner is the only person
getting bad referrer error?
TIA,
Sara.
@referers = ('http://www.foo.com', 'http://foo.com');
sub check_url {
local($check_referer) = 0;
if ($ENV{'HTTP_REFERER'}) {
foreach $referer (@referers) {
if ($ENV{'HTTP_REFERER'} =~ m|$referer|i) {
$check_referer = 1;
last;
}
}
}
if ($check_referer != 1) { error('bad_referer') }
}
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Bad referrer!
Sara wrote:
There was a script which people were using remotely, so I have to add this
simple subroutine
to check referrers. Currently, the site is getting approx. 20,000 hits per
day.
NO one, not even a single person claimed that they have experienced any
problem after
implementing this change, except for the owner of the site. I am webmaster
for the site.
And now she is pushing to undo this change immediately because she is
constantly
getting error(bad_referrer) and unable to use this script and we both know
she is the only one
experiencing this problem.
Is there something wrong below? If yes, then why others are not getting any
bad referrer error.
If no, what could be the possible reasons that owner is the only person
getting bad referrer error?
TIA,
Sara.
@referers = ('http://www.foo.com', 'http://foo.com');
sub check_url {
local($check_referer) = 0;
if ($ENV{'HTTP_REFERER'}) {
foreach $referer (@referers) {
if ($ENV{'HTTP_REFERER'} =~ m|$referer|i) {
$check_referer = 1;
last;
}
}
}
if ($check_referer != 1) { error('bad_referer') }
}
Is the owner of the site perhaps accessing the site via an internal IP address or an
internal hostname instead of the visible outside hostname?
--
Andrew Gaffney
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Bad referrer!
Sara wrote:
There was a script which people were using remotely, so I have to add this
simple subroutine
to check referrers. Currently, the site is getting approx. 20,000 hits per
day.
I don't think you are using the correct ENV variable. The referer tells
you what page the user was linking from when they made the submission,
which among other things is very spoofable so really shouldn't be used
for much of anything, especially supposed security. It can allow you
assuming someone isn't messing with you to track a users path through a
site, etc. but beyond that is pretty much worthless.
NO one, not even a single person claimed that they have experienced any
problem after
implementing this change, except for the owner of the site. I am webmaster
for the site.
And now she is pushing to undo this change immediately because she is
constantly
getting error(bad_referrer) and unable to use this script and we both know
she is the only one
experiencing this problem.
Sounds like it is bookmarked or she is typing it in directly in
whichcase there will be no referer (at least for most clients (browsers)).
Is there something wrong below? If yes, then why others are not getting any
bad referrer error.
If no, what could be the possible reasons that owner is the only person
getting bad referrer error?
What are you *really* trying to do? If you are trying to add a security
mechanism to a set of scripts this is definitely NOT the way to do it.
TIA,
Sara.
@referers = ('http://www.foo.com', 'http://foo.com');
The above is not scoped, which means you are still not using 'strict'
and 'warnings' which you have been warned of.
sub check_url {
local($check_referer) = 0;
This is a misuse of 'local'.
if ($ENV{'HTTP_REFERER'}) {
foreach $referer (@referers) {
if ($ENV{'HTTP_REFERER'} =~ m|$referer|i) {
$check_referer = 1;
last;
}
}
}
if ($check_referer != 1) { error('bad_referer') }
}
http://danconia.org
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
free site hosting that supports CGI
Old Does anybody knows where I can find free site hosting that supports CGI? JP, from Brazil. New you must search meny time in this place: http://www.clickherefree.com/ I am not shuare: Me be must pay 2 $ on mount. If you have made cgi hosting. success ): -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
How to verify whether a directory exists
I want to use mkdir(blah blah, o777), but want to first find out whether the directory blah blah exists. I'm not if the -e option will bw right here. Let's say: unless (-e blah_blah) mkdir(blah_blah, 0777); # Is this okay? -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: How to verify whether a directory exists
Please don't cross post, if your question is CGI based then use that
list, otherwise use the other...
B. Fongo wrote:
I want to use mkdir(blah blah, o777), but want to first find out
whether the directory blah blah exists.
I'm not if the -e option will bw right here. Let's say:
unless (-e blah_blah) mkdir(blah_blah, 0777);
# Is this okay?
In general -e checks for file existence, -d checks to see if an existing
file is a directory (or complains that the file doesn't exist).
perldoc -f -e
So your above code leaves a condition, where blah_blah exists but is
*not* a directory which is likely to cause you problems. But since you
haven't told us what happens in this failure case it is hard for us to
say, but,
if (-e blah_blah) {
unless (-d blah_blah) {
die File exists but is not directory;
}
}
else {
# don't forget to check mkdir's failure
mkdir(blah_blah, 0777) or die Can't make directory: $!;
}
HTH,
http://danconia.org
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Frustrated newbie question
On December 5, 2003 12:53 pm, [EMAIL PROTECTED] wrote:
Help. I'm a frustrated newbie who wants to use Perl to make my life easier.
The following simple task is only one small part of a program I'm trying to
put together to automate some things I currently do manually.
I have a file whose format looks like this:
name1 name2 name3
name4 name5 name6, etc.
The names are separated by spaces. I need the names to be one name per
line, like this:
name1
name2
name3, etc.
Try the following. It should get you on your way.
#!/usr/bin/perl -w
use strict;
my @array;
my $array_element;
open(FH,$ARGV[0]);
while(FH) {
@array = split;
foreach $array_element (@array) {
print $array_element, \n;
}
}
To sort the resulting list, I would first save the output and pipe it into
another script.
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Can't find package AutoLoader in CGI::Application program
Hi... I have what I hope is an easy question. I've got perl 5.8.0 installed, and have installed CGI, CGI::Application, HTML::Template and am creating some simple test files for CGI::Application. I've created and run some other applications using CGI and have implemented a simple OO package which AUTOLOADs get/set methods. However, when I try to run the application program that I created with CGI::Application, it gives me the following error messages: [Fri Dec 5 02:25:38 2003] GroupRank.cgi: Can't locate package AutoLoader for @GroupRank::ISA at /usr/local/www/cgi-bin/GroupRank.cgi line 7. [Fri Dec 5 02:25:38 2003] GroupRank.cgi: Can't locate package AutoLoader for @GroupRank::ISA at /usr/local/www/cgi-bin/GroupRank.cgi line 7. Can't locate object method new via package GroupRank at /usr/local/www/cgi-bin/GroupRank.cgi line 7. The CPAN module (r command) says that AutoLoader.pm is installed; AutoLoader 5.59 5.60 N/NW/NWCLARK/perl-5.8.2.tar.gz. The AutoLoader module is located in: /usr/local/lib/perl5/5.8.0/AutoLoader.pm My .cgi file (instance script) looks like this: /// #! /usr/bin/perl -wT use strict; $|++; use GroupRank; my $grouprank = GroupRank-new(); $grouprank-run(); /// The beginning of my GroupRank.pm file looks like this: /// package GroupRank; use base 'CGI::Application'; use AutoLoader; #use DBI; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); $|++; /// NOTE: I added the 'use AutoLoader;' line to see if it could be found and this generates no error. I'm sure it's obvious, but I can't figure out why CGI::Application can't find AutoLoader and gives me that error... any pointers would be much appreciated. thanks...jon seidel -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Reduce file size with Imager
R. Joseph Newton wrote: Eamon Daly wrote: Hi, all. I'm using Imager to create gifs, but the resultant file sizes are /huge/. I'm writing the files out like so: Are you doing animations? If not, skip the GIFs. You can get much better depth [16 million] in a lot less space with JPEG files. Some of the compression algorithms avaiable are loss-free, too. No matter how small the color table, each pixel is still going to take its one byte when using GIF. I see that you set a gif_eliminate_unused flag, but I am sort of sceptical about how effective this will really be. I have never heard of a GIF making such optimizations. Joseph I'm sorry, but there are numerous errors here. First of all, I know nothing about this Imager package (and indeed, very little about Perl), but I suspect the other reply was correct. Check the documentation and you will probably find that the package simply does not do compression of GIF images. It will write uncompressed GIFs, but not compressed ones. The reason is that GIF uses the LZW compression algorithm, which is patented in some countries (the patent only recently expired in the US), and threats of royalty fees and legal action have caused MANY free software packages to stop supporting GIF compression. Second, JPEG (actually JFIF) is a very poor replacement for GIF. JPEG compression is good for photographs and other realistic images, but not for icons, cartoons, and other things that GIF works well for (things that have relatively few colors and/or large blocks of the same color). When attempting to compress a cartoon, for example, you'll find that JPEG/JFIF will give *lower* quality and a *larger* file size than GIF. For this type of image, PNG-8 would be a better choice than GIF, and a much better choice than JPEG/JFIF. Third, only in relatively bad cases will GIF require a byte for every pixel. For example, I just created a solid white 200 by 200 image. That's 40,000 pixels. The file size is 345 bytes. One byte per pixel is what you would get if no compression was used at all (probably what happened in this case, but not what happens in general), or if the compression performed so badly that it might as well have not been used (which is rare for typical images). -Kevin -- My email address is valid, but changes periodically. To contact me please use the address from a recent posting. -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Newbe needs help
Tim Johnson wrote: I would recommend getting a strong grasp of Perl before you start trying to make one-liners for problems like this, since you can end up making a simple problem much more complicated. What's wrong with this: use strict; use warnings; open(OUTFILE,script1) || die Couldn't open script1 for writing!\n; print OUTFILE ddd\n; close OUTFILE; -Original Message- From: sadman [mailto:[EMAIL PROTECTED] Sent: Tuesday, October 28, 2003 2:56 PM To: [EMAIL PROTECTED] Subject: Newbe needs help Hi all can anyone help with a direct command line syntax for the following im trying to add text to the end of the last line in a text file like so aaa bbb ccc Wishing to add ddd on the end of this list. I have tried the following but it doesnt have quite the desired effect any help would be good. perl -pi -e s/'$'/'ddd'/g script1 This gives me this aaaddd dddbbbddd dddcccddd dd ddd Hi Tim i have lert a few basics but still im stuck on a problem ;-( maybe you could help. Using the code yyou sent me it will add the exact text stated at the bottom of the file it opens. What i need to do now is instaed of having the text in the code, have it open up another txt file read the whole txt file and then add all the text from that said file to the end of the outfile, im sure this is simple but ive obviously missed something somewere ;-( any help would be great Thanks sadman -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Perl Mysql
Which modules i have to install in order to connect perl with mysql ?, in what order ?, My perl installation is on solaris 9. I already have mysql installed. Thanks for the help. Here's what I wrote up while installing under OS X, should be pretty similar: To install perl support for MySQL: - Make sure you have the OS X developer tools installed - Go to http://www.cpan.org/modules/by-module/DBI/ and download the latest released DBI (1.38 as of this writing). Read the associated readme for installation instructions. - Then go to http://www.cpan.org/modules/by-module/DBD/ and download a mysql version of the DBD that looks good (mysql-2.1028 as of this writing). Try the instructions, but if they don't work, you may need to fix the Makefile (likely necessary for OS X 10.3). To do this: % perl Makefile.PL --testdb=test --testuser=testuser --testpassword=testuser --testhost=localhost --cflags=-I/usr/local/mysql/include/ --libs=-L/usr/local/mysql/lib -lmysqlclient -lz % perl -pi -e's/MACOSX/env MACOSX/' Makefile (or replace -r MACOSX 'env MACOSX' Makefile) % make % make test % sudo make install Now remove both source directories and you're all set! - B -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
RE: Reading from log
Typically I'm against just doing something for somebody, but you caught me
at a good time.
Here is an example to get you started:
#!/usr/local/bin/perl -w
use strict;
my $input = shift;
my $total;
die Usage: Arg1: Input File to Scan.
unless $input;
open IN, $input or die Unable to open $input for reading, $!, stopped;
while ( defined(IN) ) {
while ( IN ) {
if ( /Total:/ ) { last };
}
while ( IN ) {
if ( /^\s*\d+/ ) {
chomp;
s/\s*(\d+)\s*/$1/;
$total = $_;
printf Total: %010s, $total;
}
}
}
close IN;
-Original Message-
From: danield [mailto:[EMAIL PROTECTED]
Sent: Friday, December 05, 2003 9:49 PM
To: [EMAIL PROTECTED]
Subject: Reading from log
Hello all,
I am looking for help with creating a digest of a log file. I have found
a nice tutorial that should help on
http://www.pageresource.com/cgirec/ptut14.htm. However, this tutorial
expects to have values in list separated by | :
he Rock|Cheer|Rock Bottom
Triple H|Boo|Pedigree
Stone Cold|Cheer|Stone Cold Stunner
And I do have a log file, that looks like:
...
Format count
a 100
b51
c 130
d 5
e 6
Total: ---
292
...
And I need to go through that log and find that 292 and store it into
variable.
If it was something like 'total: 292', I might be able to do it, however the
value
is on completely new line and nothing precedes it.
Is anyone willing to help me?
I am a completely newbie in programming.
Thank you for your time.
danield
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Reduce file size with Imager
Kevin Goodsell wrote: Third, only in relatively bad cases will GIF require a byte for every pixel. For example, I just created a solid white 200 by 200 image. That's 40,000 pixels. The file size is 345 bytes. One byte per pixel is what you would get if no compression was used at all (probably what happened in this case, but not what happens in general), or if the compression performed so badly that it might as well have not been used (which is rare for typical images). -Kevin Seriously? I guess I was going by what I have seen in full-color images. I may have dismissed the GIF protocol too quickly, when I was doing a lot of graphics work. I'll take another look at it. I notice now that I can easily raise information on the format through Google, which wasn't really the case when I last looked for background on graphics encoding. Joseph -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Pattern matching
On Dec 5, 2003, at 3:48 PM, B. Fongo wrote:
I went back to my books to refresh my memory on how to use references.
Your suggestion help a lot, but the subroutine returns wrong values.
It was intent upon demonstrating an idea to see how
much work were we really into. The following
actually sorta explains that we have a bit more
work to deal with.
I did some small modifications on the codes below
, and tried it. It return perl-5.8.0-80.3.i386.rpm and
samba-2.2.7-5.8.0.i386.rpm, which is wrong because:
1. The perl version available on the ftp server is higher.
2. The samba version already installed is higher than the one on the
ftp server.
[..]
my @remote_packages = qw(perl-5.8.0-88.3.i386.rpm
samba-2.2.7-5.7.0.i386.rpm bob-5.3.2.4.1.rpm xml-2.5.2.1.rpm);
my @installed_packages = qw(perl-5.8.0-80.3.i386.rpm
samba-2.2.7-5.8.0.i386.rpm bob-5.3.2.4.1.rpm);
Given these two lists,
Since the local host has no 'xml' it would not care about
picking up the OS independent version that could be installed.
At which point we are down to sorting out how to deal
with the basic naming schema that appareas to be
pkg_nam-pkg_ver-perl_ver.OS.suffix
which of course works for our two canonical bits,
but not for bob or xml... Bob we have and will need
to check the server - those seem to be of the form
pkg_nam-pkg_ver.suffix
eh no? now all we need is a Hash Of Hashes?
something that would look like say
$VAR1 = {
'perl' = {
'version' = '5.8.0',
'full_name' = 'perl-5.8.0-88.3.i386.rpm',
'subversion' = '88.3'
},
'xml' = {
'version' = '2.5.2.1',
'full_name' = 'xml-2.5.2.1.rpm'
},
'samba' = {
'version' = '2.2.7',
'full_name' = 'samba-2.2.7-5.7.0.i386.rpm',
'subversion' = '5.7.0'
},
'bob' = {
'version' = '5.3.2.4.1.1',
'full_name' = 'bob-5.3.2.4.1.1.rpm'
}
};
cf:
http://www.wetware.com/drieux/pbl/Sys/Admin/version_picker.txt
ciao
drieux
---
caveat Emptor, remember in these days
of highten security having a version is
one thing, but having subversion may be
a crime...
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Newbe needs help
On Dec 5, 2003, at 11:20 PM, sadman wrote: [..] i have lert a few basics but still im stuck on a problem ;-( [..] What i need to do now is instaed of having the text in the code, have it open up another txt file read the whole txt file and then add all the text from that said file to the end of the outfile, im sure this is simple but ive obviously missed something somewere ;-( Now we are moving into the land of choices. we need an input file, and an output file to append it to??? say something like cat inputfile outputfile ??? but in perl in the form append_file inputfile outputfile my ($input_file , $output_file) = @ARGV; open(IN, $input_file) or die problem with inputfile: $!\n; open(OUT, $output_file) or die problem with output_file: $!\n; print OUT $_ while(IN); close(IN); close(OUT); ciao drieux --- -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: formats
On Dec 5, 2003, at 6:39 PM, Jose Malacara wrote: [..] write TYPE_1; that's the sticky bit, where tom is talking about not writing to a filehandle... [..] To expand on tom's comments a bit: http://www.wetware.com/drieux/pbl/perlTrick/Format/funk_the_form.plx which generates Type: type1Gateway: cow Acct ID: lost_id Start Date: 2003.12.2Start Time: 1400 #--- Type: type2Gateway: pig Acct ID: new Start Date: 2003.12.2Start Time: 1400 Disconnect Date: 2003.12.3Disconnect Time: 1600 one needs to be thinking in terms of $~ = 'TYPE_1'; write; $~ = ''; print #---\n; HTH. ciao drieux --- -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Seeding a Random Number Generator
Hi, I'm reviewing a perl script that someone wrote to do a statistical analysis. I know it's bad form, but I was wondering if anyone knows what the default seed is for the random number generator in Perl. They haven't seeded it with srand - what does this do? It still seems to pick random numbers, any ideas? Thanks, Pat -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Seeding a Random Number Generator
Pd Schloss wrote: I'm reviewing a perl script that someone wrote to do a statistical analysis. I know it's bad form, but I was wondering if anyone knows what the default seed is for the random number generator in Perl. They haven't seeded it with srand - what does this do? It still seems to pick random numbers, any ideas? Hi. I wrote this back in March. I assume I was right :) Rob Dixon wrote: Interesting. Digging into the code for Perl v5.6.1, 'srand' will try to read four bytes from the /dev/urandom device. If that fails, then it will read the current time of day and mix it up with the PID, a Perl stack pointer and a few arbitrary constants. So, as it should be, there is no 'default' seed. This probably doesn't help, but at least should end your search! Cheers, Rob -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Frustrated newbie question
Stuart Clemons wrote: Help. I'm a frustrated newbie who wants to use Perl to make my life easier. The following simple task is only one small part of a program I'm trying to put together to automate some things I currently do manually. I have a file whose format looks like this: name1 name2 name3 name4 name5 name6, etc. The names are separated by spaces. I need the names to be one name per line, like this: name1 name2 name3, etc. I currently use a macro with a text editor to clean up the file into the one name per line format. I can do this very quickly in contrast to the the last two hours I've spent trying to figure out how to get Perl to do this very simple task. Arrggh ! To simply things, I just tried to take the following string and print it out one name per line. my $x = name1 name2 name3; I've tried various schemes using regex's and the ///s operator. Most of the time I get syntax errors and the few times I get anything to work, it's not what I want. I did get this array structure to work: my @names = qw(name1 name2 name3); print $names[0] \n; print $names[1] \n; print $names[2] \n; So I then spent time unsuccesfully trying to figure out how to get my string split into the array. I couldn't get that to work either. More Arrggh ! Anyway, any help at this point will be appreciated. I'm hoping that in the long run the time I spend learning Perl will pay off, which it will if I can automate some of the tasks I do manually (with the help of macros in a text editor). My next Perl task after I get my list of one name per line, is to sort the list and eliminate duplicate names. Hi Stuart. A lot of people have posted the solution split /\s+/, $string; # or similar which is fine, but has the pitfall that if $string contains leading spaces then it will return an initial empty field. The special case split ' ', $string; # (which is also the default) returns just a list of all sets of contiguous non-whitespace characters in $string, which is probably what you want. If your data is well-behaved and never has any leading whitespace then the two are identical, but it's something to beware of as it can cause obscure bugs. HTH (somebody at least) Rob -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Reading from log
Danield wrote:
I am looking for help with creating a digest of a log file. I have found
a nice tutorial that should help on
http://www.pageresource.com/cgirec/ptut14.htm. However, this tutorial
expects to have values in list separated by | :
he Rock|Cheer|Rock Bottom
Triple H|Boo|Pedigree
Stone Cold|Cheer|Stone Cold Stunner
And I do have a log file, that looks like:
...
Format count
a 100
b 51
c 130
d 5
e 6
Total: ---
292
...
And I need to go through that log and find that 292 and store it into
variable. If it was something like 'total: 292', I might be able to do it,
however the value is on completely new line and nothing precedes it.
Is anyone willing to help me?
I am a completely newbie in programming.
First you need to be able to read from a file, but since that
part isn't the substance of the question, let's just assume that
your data is coming in on the STDIN filehandle. The following
should be partly self-explanatory. Keep reading lines from STDIN
until we find a line containing 'Total:'. Read the next line into
$total and exit the loop. (Beware that $total will then contain
the entire record, including the trailing newline character. It
may well need more massaging before you can use it.)
my $total;
while (STDIN) {
if (/Total:/) {
$total = STDIN;
last;
}
}
HTH,
Rob
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Reduce file size with Imager
Kevin Goodsell wrote:
Third, only in relatively bad cases will GIF require a byte for every
pixel. For example, I just created a solid white 200 by 200 image.
That's 40,000 pixels. The file size is 345 bytes. One byte per pixel is
what you would get if no compression was used at all (probably what
happened in this case, but not what happens in general), or if the
compression performed so badly that it might as well have not been used
(which is rare for typical images).
-Kevin
Thanks again for the correction. It has spurred some new exploration. I've
been looking at the published standard on the format, and it is not at all
like I had assumed. I'm afraid I was lumping it in with BMP and TIFF.
Anyway, I am starting to untangle the coding:
Greetings! E:\d_drive\perlStuffperl -w
open IN, 'fullhead.gif';
binmode IN;
local $/;
my $img = IN;
my @bytes = split //, $img;
my $gif_type;
for (1..6) {
$gif_type .= shift @bytes;
}
print $gif_type\n;
my $width = ord(shift @bytes);
$width += 256 * ord(shift @bytes);
my $height = ord(shift @bytes);
$height += 256 * ord(shift @bytes);
print Width: $width Height: $height\n;
my $control_string = ord (shift @bytes);
my $is_map = $control_string / 128;
$control_string %= 128;
my $bit_resolution = int(($control_string / 16) + 1);
$control_string %= 16;
$control_string %= 2;
my $bits_per_pixel = $control_string;
my $background_color = ord(shift @bytes);
print Background is $background_color\n;
my $color_map = ord(shift @bytes);
print Color map is $color_map\n;
my @colors;
for (my $i = 0; $i 2 ** $bit_resolution; $i++) {
my $color_channels = {};
$color_channels-{'red'} = ord(shift @bytes);
$color_channels-{'green'} = ord(shift @bytes);
$color_channels-{'blue'} = ord(shift @bytes);
push @colors, $color_channels;
print 'R: ', sprintf (%03d, $color_channels-{'red'}),
' G: ', sprintf (%03d, $color_channels-{'green'}),
' B: ', sprintf (%03d, $color_channels-{'blue'}), \n;
}
foreach my $char (@bytes) {
my $byte = ord($char);
my $first_nibble = int($byte / 16);
my $crumbs = $byte % 16;
print $first_nibble\n$crumbs\n;
}
print 'Data size was ', my $byte_size = @bytes, \n;
^Z
GIF89a
Width: 30 Height: 16
Background is 0
Color map is 0
R: 000 G: 000 B: 000
R: 128 G: 000 B: 000
...
2
1
15
9
0
4
0
1
0
0
...
3
11
Data size was 117
Right now, I'm sort of tracking as I read the spec. I swear to Gawd, I
couldn't find anything like this last time I went a-hunting!
It's not very often that you'll see me writing this much flush-left scrit,
but right now I just want to follow a file through sequentially, and deal
with each part as it comes.
Joseph
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Perl Mysql
Dan == Dan Muey [EMAIL PROTECTED] writes: Which modules i have to install in order to connect perl with mysql ?, in what order ?, My perl Dan Excellent choice of combo! I disagree. The only reason to choose MySQL over PostgreSQL these days is compatibility with an existing bolt-on (or your brain :). Get PostgreSQL. Get a real database. Dan You'll want to install DBI Dan It should come witht the mysql driver automatically. No, it doesn't. Go to the CPAN shell, and ask for both DBI and DBD::mysql. -- Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095 [EMAIL PROTECTED] URL:http://www.stonehenge.com/merlyn/ Perl/Unix/security consulting, Technical writing, Comedy, etc. etc. See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training! -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Perl Mysql
Randal L. Schwartz wrote: Dan == Dan Muey [EMAIL PROTECTED] writes: Which modules i have to install in order to connect perl with mysql ?, in what order ?, My perl Dan Excellent choice of combo! I disagree. The only reason to choose MySQL over PostgreSQL these days is compatibility with an existing bolt-on (or your brain :). Get PostgreSQL. Get a real database. But what are the reasons for choosing PostgreSQL over MySQL? What's a real database? Without providing reasons this is just FUD. I will agree that if you are looking for a package closer to a real database you will need to look past MySQL 3.x to the 4.x series. Regardless the OP should analyze the DB chosen based on their own needs. Having a discussion about what makes a good DB is probably OT for this group, so suggesting that a choice already made is inadequate is as much OT. http://danconia.org -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Seeding a Random Number Generator
Pd Schloss wrote: Hi, Hello, I'm reviewing a perl script that someone wrote to do a statistical analysis. I know it's bad form, but I was wondering if anyone knows what the default seed is for the random number generator in Perl. They haven't seeded it with srand - what does this do? It still seems to pick random numbers, any ideas? Download the source code for Perl if you don't already have it and have a look at the pp.c file. John -- use Perl; program fulfillment -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Replacing text
Dan Anderson wrote: I have a script that reads text from a file and inserts text into different places depending on what it needs to do. But I use split to replace the text, i.e.: ($first_part, $second_part) = split #INSERT#TEXT#HERE#, $document, 2; print FILEHANDLE $firstpart, $text_to_insert, $secondpart; Is there a replace function in perl that would let me do something like replace #INSERT#TEXT#HERE, $text_to_insert;? I was going to write my own method but was curious if perl had something faster? You could use the substitution operator: $document =~ s/#INSERT#TEXT#HERE#/$text_to_insert/; Or you could use a combination of substr(), index() and length(): my $text_to_find = '#INSERT#TEXT#HERE#'; substr $document, index( $document, $text_to_find ), length $text_to_find, $text_to_insert; John -- use Perl; program fulfillment -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: How to verify whether a directory exists
On Dec 6, 2003, at 5:27 PM, B. Fongo wrote:
I want to use mkdir(blah blah, o777), but want to first find out
whether the directory blah blah exists.
I'm not if the -e option will bw right here. Let's say:
unless (-e blah_blah) mkdir(blah_blah, 0777);
# Is this okay?
May I recommend File::Path and it's mkpath()
for general useage...
that having been said, you might want to check
the return condition on your mkdir().
unless ( -e $dir )
{
$dir_test = mkdir($dir, 0777);
# code to handle the failed to mkdir here
}
ciao
drieux
---
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
How to verify whether a directory exists
I want to use mkdir(blah blah, o777), but want to first find out whether the directory blah blah exists. I'm not if the -e option will bw right here. Let's say: unless (-e blah_blah) mkdir(blah_blah, 0777); # Is this okay? -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: How to verify whether a directory exists
Please don't cross post, if your question is CGI based then use that
list, otherwise use the other...
B. Fongo wrote:
I want to use mkdir(blah blah, o777), but want to first find out
whether the directory blah blah exists.
I'm not if the -e option will bw right here. Let's say:
unless (-e blah_blah) mkdir(blah_blah, 0777);
# Is this okay?
In general -e checks for file existence, -d checks to see if an existing
file is a directory (or complains that the file doesn't exist).
perldoc -f -e
So your above code leaves a condition, where blah_blah exists but is
*not* a directory which is likely to cause you problems. But since you
haven't told us what happens in this failure case it is hard for us to
say, but,
if (-e blah_blah) {
unless (-d blah_blah) {
die File exists but is not directory;
}
}
else {
# don't forget to check mkdir's failure
mkdir(blah_blah, 0777) or die Can't make directory: $!;
}
HTH,
http://danconia.org
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Perl Mysql
Wiggins == Wiggins D'Anconia [EMAIL PROTECTED] writes: Wiggins But what are the reasons for choosing PostgreSQL over MySQL? What's a Wiggins real database? Without providing reasons this is just FUD. I will Wiggins agree that if you are looking for a package closer to a real Wiggins database you will need to look past MySQL 3.x to the 4.x series. But if you don't want to wait the next five years for MySQL to catch up to where PostgreSQL is now, you might as well install PostgreSQL. Don't quote the old MySQL is faster FUD, because that's not valid. For example, SourceForge picked Pg over My based on *performance* as one of the key factors, and the choice is well documented (see http://www.phpbuilder.com/columns/tim2705.php3?page=1print_mode=1). In every category, Pg is technically superior to My. The only way My now wins is inertia or bolt-on compatibility with legacy apps and legacy brains. Wiggins Regardless the OP should analyze the DB chosen based on their own Wiggins needs. Having a discussion about what makes a good DB is probably OT Wiggins for this group, so suggesting that a choice already made is inadequate Wiggins is as much OT. I didn't see anything that insisted on MySQL. I was just trying to steer the OP toward a better choice to keep the knowledge entropy to a minimum, and remove the chance for one more legacy brain that will need rewiring. -- Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095 [EMAIL PROTECTED] URL:http://www.stonehenge.com/merlyn/ Perl/Unix/security consulting, Technical writing, Comedy, etc. etc. See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training! -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
