accessing the systray
Is there a module that will allow me to put an icon in the systray (freedesktop.org compliant...fluxbox, gnome, etc.)? Searching CPAN for 'systray' turned up nothing. I'm going to take a stab at writing a systray plugin for irssi, just because someone claimed xchat was better because of the systray integration :P -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: regex for l33t speak
Randy W. Sims wrote: The only problem with that is that a dictionary is required for it to work because each "symbol" can have multiple translations. Taking info from the wikipedia[1]: a final "s" can be changed to "z" to get the l33t, but to reverse it you have to check first with the "z" because it might be an actual "z". Then if it is not a dictionary word perform the translation and check for a word ending in "s". For example, given the l33t word "h4x0rz", an algorithm would have to perform something like the following translations, checking each one till it finds a dictionary entry if any: (done by hand and I don't know much about l33t, so...) h4x0rz h4x0rs h4xorz h4xors h4xerz h4xers h4ck0rz h4ck0rs h4ckorz h4ckors h4ckerz h4ckers h4cks0rz h4cks0rs h4cksorz h4cksors h4ckserz h4cksers hack0rz hack0rs hackorz hackors hackerz hackers => BINGO (More permutations here, but we already found a dictionary word, so we stop.) The basic algorithm for anyone who want to try it, and it's pretty commonly seen in parsing, so it's relatively straigtforward: scan string till you reach the end of a "word" check dictionary for the "word" LOOP: back up apply conversion(s) check dictionary repeat until success or no more permutations END LOOP: This would probably make a good QotW, or rather the original question would make a good quiz while the above would be one possible solution. So would implementing an efficient dictionary lookup without loading the entire dictionary in memory. Randy. 1. <http://en.wikipedia.org/wiki/Leetspeak> Wow, this is more difficult than I first thought. I think I'm just going to drop the whole idea as the channel is relatively low traffic and it was more for fun than usefulness. Thanks for all the suggestions, though. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: regex for l33t speak
Randy W. Sims wrote: Andrew Gaffney wrote: I'm trying to come up with a regex for my IRC bot that detects 1337 (in order to kick them from the channel). I can't seem to come up with one that will have few false positives but also work most of the time. Has anyone done something like this before? Does anyone have any suggestions? Write a converter to translate common "symbols" to the correct letter. If the translated "word" is a valid dictionary word, flag it. [EMAIL PROTECTED] 3 => E X => X @ => A m => M P => P 1 => L e => E [EMAIL PROTECTED] => EXAMPLE EXAMPLE is a dictionary word, so [EMAIL PROTECTED] must be leet since the conversion rules produced meaningful results. It's not perfect, but should work with very few if any false positives. Thanks for yet another very interesting approach. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: regex for l33t speak
Thomas Bätzler wrote:
Andrew Gaffney <[EMAIL PROTECTED]> wrote:
Too literally. Basically, I'm trying to match a word that
contains a mix of >=2 numbers (possibly next to each other)
and letters. My current regex is:
\b\d*[a-zA-Z]*(\d+[a-zA-Z]+)+\d*[a-zA-Z]*[^:,]\b
but that seems to catch too much.
Ever considered doing this w/o a regex? Maybe it would be
easier to split the text into words first, and then count
letters and numbers using tr//, like
#!/usr/bin/perl -w
sub badword {
my $word = shift;
return $word =~ tr/a-zA-Z/ / >= 2 && $word =~ tr/0-9/ / >= 2;
}
my $text = 'I confess to 0wn1ng the email address [EMAIL PROTECTED]';
foreach my $word (split /\s+/, $text){
print "bad: $word\n" if badword( $word );
}
__END__
Thanks. That's an interesting solution.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: regex for l33t speak
Tim Johnson wrote: First off, "perldoc perlre" is a good place to start. What do you have so far? Does something like /\b1337\b/ work? Or am I taking you too literally? Too literally. Basically, I'm trying to match a word that contains a mix of >=2 numbers (possibly next to each other) and letters. My current regex is: \b\d*[a-zA-Z]*(\d+[a-zA-Z]+)+\d*[a-zA-Z]*[^:,]\b but that seems to catch too much. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
regex for l33t speak
I'm trying to come up with a regex for my IRC bot that detects 1337 (in order to kick them from the channel). I can't seem to come up with one that will have few false positives but also work most of the time. Has anyone done something like this before? Does anyone have any suggestions? -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: remove me from the list
Robert Citek wrote: On Friday, Jan 28, 2005, at 11:52 US/Central, Richard Wood wrote: How do I go about removing my email address from this list? If you send a blank message to e-mail [EMAIL PROTECTED], you'll get a help file. Within that helpfile will be a line like so: Or you can even look at the bottom of *every* email that you get from this list: To unsubscribe, e-mail: [EMAIL PROTECTED] -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: Can someone translate a small .PY to Perl?
Randal L. Schwartz wrote: "Andrew" == Andrew Gaffney <[EMAIL PROTECTED]> writes: Andrew> while `/bin/true`; Uh, what? Execute /bin/true, take its output if its output is non-null, continue. Last I checked, /bin/true outputs nothing. :) Maybe you wanted: while true; do; ...; done Or more commonly: while :; do ... done because the ":" command is true. It works for me. That's the way I'd seen it done when I was learning bash. I believe the while checks the return value, not the output of the command. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: Can someone translate a small .PY to Perl?
S. David Rose wrote: Sorry, sir. I did not state it boldly enough, but this is to be used on a Netware server. There is no port for Python on Netware, but PERL is available. Obviously, bash scripting will not work It's Netware 5.0 / 5.1 for my servers. Ah, sorry. I didn't catch that part. Also, reply to the list instead of the sender. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: Can someone translate a small .PY to Perl?
GMane Python wrote:
Hello Everyone.
Whil e reading the Python Cookbook as a means of learning Python, I
came across the script by Nicola Larosa. Not knowing anything about PERL, I
was wondering if there were a translation in PERL so I could have my Netware
servers send heartbeats to the heartbeat server?
I am beginning to learn the Python language after a 10-year
programming 'vacation' from my last class in college. Looking at this, I
think it'll end up being a rather quick translation, but although I'm
searching for translations, I'd really like to be able to just get my
Netware server to send heartbeats and not take flack from my boss for
'having to learn PERL' just to get the server to send a beat packet, so
that's why I'm asking for someone's help who knows the syntax of the
language.
Thanks!
Dave
Title: PyHeartbeat - detecting inactive computers
Submitter: Nicola Larosa
# Filename: HeartbeatClient.py
"""Heartbeat client, sends out an UDP packet periodically"""
import socket, time
SERVER_IP = '127.0.0.1'; SERVER_PORT = 43278; BEAT_PERIOD = 5
print ('Sending heartbeat to IP %s , port %d\n'
'press Ctrl-C to stop\n') % (SERVER_IP, SERVER_PORT)
while True:
hbSocket = socket.socket(socket.AF_INET, socket.SOCK_DGRAM)
hbSocket.sendto('PyHB', (SERVER_IP, SERVER_PORT))
if __debug__: print 'Time: %s' % time.ctime()
time.sleep(BEAT_PERIOD)
Both Perl or Python are overkill for this. This can be done with a very simple
bash script. It only requires netcat.
#!/bin/bash
SERVER_IP="127.0.0.1"
SERVER_PORT=43278
BEAT_PERIOD=5
while `/bin/true`;
do
echo "pyHB" | nc -u -q 0 $SERVER_IP $SERVER_PORT
sleep ${BEAT_PERIOD}s
done
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: Is there a time module to help with this...
[EMAIL PROTECTED] wrote: Hi all. I would like to write a simple monitoring tool that basically performs an action on a list of servers (ping, port check, etc) at a specified time interval. So let's say I want to ping each server every 5 minutes. I don't want to code a loop where I ping all the servers and then sleep for 5 minutes, and then start over again. Reason this wouldn't work is because as the list of servers grows and while some pings may time out, the actual time to go through the loop once would never be the same. So i'm hoping there is some sort of time module that will perform a list of tasks at a timed interval. While one server may be timing out, it's still making sure that the others are being checked within the 5 minute time frame. If there is no module to help me with this, can anyone offer any other help, perhaps if you have done something like this in the past? You could setup cron to run the script once every 5 minutes. Some like the following in your crontab should work: */5 * * * * root/my/script/to/ping/hosts.pl -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. -- 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 reinvent grep with perl?
Siegfried Heintze wrote: Andrew, Thanks. When I hit "n" to go to the next page, it says "No previous regular expression (press RETURN)". So I can only display the first page. I have it expanded to the full screen but I still cannot see the portion of the display that tells me how to use extended regular expressions. Apparently the basic regular expressions don't include "^" and "$". If your 'man' uses 'less' like mine does, you hit Space to go to the next page and use the arrow keys to scroll one line at a time. I haven't used 'info' in a while, but I believe you can search those with 's'. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- 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 reinvent grep with perl?
Siegfried Heintze wrote: My man pages and info pages are not working well and I cannot figure out how to make grep search for a certain pattern. I even tried egrep and fgrep. So how do I reinvent grep with perl? Here is my attempt: There's no need. When you do 'man whatever', you can hit '/', type a search term, and hit enter. To search that same term again, '/' then enter will do. This works on my Gentoo Linux box. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: subclassing HTML::Parser
Charles K. Clarkson wrote:
From: Andrew Gaffney <mailto:[EMAIL PROTECTED]> wrote:
: I've created a module that uses HTML::Parser to parse some
: HTML and create a tree structure. Someone had suggested to
: use HTML::TreeBuilder, but my HTML contains HTML::Mason
: code embedded, and HTML::TreeBuilder doesn't handle that
: well at all. HTML::TreeBuilder also adds , ,
: and tags when there aren't any in the document it
: is parsing. The files I'm using this with are only parts
: of HTML pages, so I don't want that stuff added.
:
: My module works well enough, but I'm getting to the point
: where I need multiple parse trees existing at the same
: time in a mod_perl environment. The way my module is now,
: they could get mixed up, because I can't find a way to
: pass a custom variable to the event handler subroutines
: of HTML::Parser.
:
: I've figured that if I subclass it, I can create a new
: object for each parse tree instead of just returning an
: array reference. Here is my current code:
:
: package SkylineEdit;
:
: use HTML::Parser ();
:
: @ISA = ('Exporter');
: @EXPORT = ('html_to_htmltree', 'htmltree_to_html',
: 'get_node_content',
: 'set_node_content');
Comment out the exporter stuff and start a new module.
For lack of imagination I used SkylineEditOO.pm. This
should cache everything the way you want and requires
little editing of SkylineEdit.pm.
Since I hadn't gotten a response within a day of posting, I ended up modifying
my code to store both parse trees that I needed in one $htmltree. This worked
out well since both parse trees are from the same document. Thanks for the code,
though. I can use it as an example when I run into this kind of problem again.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: getting list of all .html files in a directory and its directories
Chris Devers wrote: On Fri, 30 Jul 2004, Andrew Gaffney wrote: I think it is a problem with the regex. If I change it to: grep -RLi '<%init>' * | grep '.html' I get all files that don't have '<%init>', but it doesn't work with the '<%(init|perl)>'. That regex doesn't seem to match anything. More man page material: I was using `egrep` for the earlier examples, not `grep`. On my computer (a Mac), `egrep` is equivalent to `grep -e`; either way, this pulls in an enhanced regex parser that, in this case, is being used to match multiple patterns (by|doing|this). Hence, these two lines are equivalent: egrep'pattern|anotherpattern' * grep -e 'pattern|anotherpattern' * Also, the line you ended up with -- grep -RLi '<%init>' * | grep '.html' -- should be equivalent to this one -- grep -RLi '<%init>' *html -- without needing the second grep statement. It isn't though. I had the '-R' flag in which means I want it to search subdirectories also. The '*html' gets interpreted by the shell and it ends up not recursing. And to weave the multiple pattern matching back in, you can do these: egrep -RLi '<%(init|perl)>' *html grep -RLie '<%(init|perl)>' *html I ended up with "egrep -RLi '<%(init|perl)>' * | egrep '.html$'" which seems to get me exactly what I wanted. Both of these should match files that have neither of the two patterns you were asking about: /<%init>/ nor /<%perl>/ . Make sense? Yes. Thanks for the help. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: getting list of all .html files in a directory and its directories
Chris Devers wrote: On Fri, 30 Jul 2004, Andrew Gaffney wrote: Chris Devers wrote: On Fri, 30 Jul 2004, Andrew Gaffney wrote: Then yes, I misunderstood. This version should do what you want: $ find /path/to/htdocs -type f | xargs egrep -liv '<%(perl|init)>' That still doesn't appear to do what I want. I believe it is showing me all files where *all* lines don't contain '<%perl>' or '<%init>'. Since not *all* lines contain either one of those, all files still show in the list. Okay, let's try again then: $ grep -li '' *html # print all html files with '' 20things.html bookmarks.html gas.html gas_form.html itunes.html noise.html $ $ grep -Li '' *html # print all html files WITHOUT '' HEADER.shtml $ The sets are non-intersecting, and so apparently what you meant. If you want to refine this further, try `egrep --help` or `man egrep`. I should have tested what I sent before sending it, but ten seconds of skimming over the documentation on your own should have been enough to show you these lines from `egrep --help`: $ egrep --help | grep -i 'files.*match.*print' -L, --files-without-match only print FILE names containing no match -l, --files-with-matches only print FILE names containing matches $ So, as with many Unix commands, shift-L inverts the usual sense of L, meaning that '-L' gets you the opposite of what '-l' does. Now have we got it? :-) I think it is a problem with the regex. If I change it to: grep -RLi '<%init>' * | grep '.html' I get all files that don't have '<%init>', but it doesn't work with the '<%(init|perl)>'. That regex doesn't seem to match anything. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: getting list of all .html files in a directory and its directories
Chris Devers wrote: On Fri, 30 Jul 2004, Andrew Gaffney wrote: I think you misunderstand. I don't want to delete the files that contain '<%perl>' or '<%init>'. I just want to make a list of all .html files in a directory tree and remove the ones that contains '<%perl>' or '<%init>' from my list. Then yes, I misunderstood. This version should do what you want: $ find /path/to/htdocs -type f | xargs egrep -liv '<%(perl|init)>' It's exactly like the first one I sent before, but I've added "-v" to the egrep arguments, which inverts the meaning from "all files with this pattern" to "all files NOT with this pattern". In this case, that's what you're trying to get. If you then want to remove / delete files, tack on the sed & rm commands I had in the earlier version, but it sounds like you just mean "omit from the list" rather than "remove from the hard drive". That still doesn't appear to do what I want. I believe it is showing me all files where *all* lines don't contain '<%perl>' or '<%init>'. Since not *all* lines contain either one of those, all files still show in the list. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: getting list of all .html files in a directory and its directories
Chris Devers wrote: On Fri, 30 Jul 2004, Andrew Gaffney wrote: I need to get a list of all the files that end with '.html' in a directory and all of its subdirectories. I then want to search through each file and remove the ones from the list that contain '<%perl>' or '<%init>'. How can I do this? Thanks for any help. From a Unix command line, you could do something like this: $ find /path/to/htdocs -type f | xargs egrep -li '<%(perl|init)>' The above line results in a list of all the files that have either '<%perl>' or '<%init>' in them. From here, you can o a step further by deleting them all. Because files with spaces in their name (or their path) can break this horribly, I'll use `sed` to wrap each line in quotes before removing them: $ find /path/to/htdocs -type f | \ > xargs egrep -li '<%(perl|init)>' | \ > sed 's/\(.*\)/"\1"/' | \ > xargs rm -i This should also prompt you before taking any action, in case you realize that you really wanted one of these files. If you want to just proceed blindly -- and my but you're brave if you do -- then delete the "-i" from the last line. I think you misunderstand. I don't want to delete the files that contain '<%perl>' or '<%init>'. I just want to make a list of all .html files in a directory tree and remove the ones that contains '<%perl>' or '<%init>' from my list. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
getting list of all .html files in a directory and its directories
I need to get a list of all the files that end with '.html' in a directory and all of its subdirectories. I then want to search through each file and remove the ones from the list that contain '<%perl>' or '<%init>'. How can I do this? Thanks for any help. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
subclassing HTML::Parser
I've created a module that uses HTML::Parser to parse some HTML and create a
tree structure. Someone had suggested to use HTML::TreeBuilder, but my HTML
contains HTML::Mason code embedded, and HTML::TreeBuilder doesn't handle that
well at all. HTML::TreeBuilder also adds , , and tags when
there aren't any in the document it is parsing. The files I'm using this with
are only parts of HTML pages, so I don't want that stuff added.
My module works well enough, but I'm getting to the point where I need multiple
parse trees existing at the same time in a mod_perl environment. The way my
module is now, they could get mixed up, because I can't find a way to pass a
custom variable to the event handler subroutines of HTML::Parser.
I've figured that if I subclass it, I can create a new object for each parse
tree instead of just returning an array reference. Here is my current code:
package SkylineEdit;
use HTML::Parser ();
@ISA = ('Exporter');
@EXPORT = ('html_to_htmltree', 'htmltree_to_html', 'get_node_content',
'set_node_content');
my $htmltree;
my $node;
my @prevnodes;
my $htmloutput;
sub start {
my $tagname = shift;
my $attr = shift;
my $newnode = {};
$newnode->{tag} = $tagname;
foreach my $key(keys %{$attr}) {
$newnode->{$key} = $attr->{$key};
}
$newnode->{content} = [];
push @prevnodes, $node;
push @{$node}, $newnode;
$node = $newnode->{content};
}
sub end {
my $tagname = shift;
$node = pop @prevnodes;
}
sub text {
my $text = shift;
chomp $text;
# $text =~ s/(^\n|\n$)//gs;
if($text ne '') {
push @{$node}, $text;
}
}
sub set_node_content {
my $htmltree = shift;
my $node = shift;
my $content = shift;
my $tmpnode = $htmltree->[0];
$node =~ s/^\d+\.//;
while($node =~ /(\d+)\.?/cg) {
$tmpnode = $tmpnode->{content}->[$1];
}
$tmpnode->{content} = [$content];
return $htmltree;
}
sub get_node_content {
my $htmltree = shift;
my $node = shift;
my $levels = shift || 0;
my $tmpnode = $htmltree->[0];
$node =~ s/^\d+\.//;
while($node =~ /(\d+)\.?/cg) {
$tmpnode = $tmpnode->{content}->[$1];
}
descend_htmltree($tmpnode->{content}, 0, "");
return $htmloutput;
}
sub descend_htmltree {
my $node = shift;
my $withclickiness = shift;
my $node_id = shift;
my $colors = { td => '#ff', p => '#aa', table => '#ff' };
my $node_counter = 0;
foreach my $tmpnode (@{$node}) {
if(ref($tmpnode) eq 'HASH') {
my $nodeid = "${node_id}.${node_counter}";
$htmloutput .= "" if($withclickiness &&
$tmpnode->{tag} eq 'table');
$htmloutput .= "<$tmpnode->{tag}";
foreach(keys %{$tmpnode}) {
$htmloutput .= " $_=\"$tmpnode->{$_}\"" if($_ ne 'tag' && $_ ne 'content');
}
$htmloutput .= ">";
$htmloutput .= ""
if($withclickiness && ($tmpnode->{tag} eq 'p' || $tmpnode->{tag} eq 'td'));
descend_htmltree($tmpnode->{content}, $withclickiness, $nodeid);
$htmloutput .= "" if($withclickiness && ($tmpnode->{tag} eq 'p' ||
$tmpnode->{tag} eq 'td'));
$htmloutput .= "{tag}>" if($tmpnode->{tag} ne 'br');
$htmloutput .= "" if($withclickiness && $tmpnode->{tag} eq 'table');
} else {
# my $nodeid = "${node_id}.${node_counter}";
$htmloutput .= "$tmpnode";
}
$node_counter++;
}
}
sub htmltree_to_html {
my $filename = shift || '';
my $withclickiness = shift || 0;
my $htmltree = shift;
descend_htmltree($htmltree->[0]->{content}, $withclickiness, "0");
if($filename ne '') {
open HTML, "> $filename" or die "Can't open $filename for HTML output";
print HTML $htmloutput;
close HTML;
}
return $htmloutput;
}
sub html_to_htmltree {
my $filename = shift;
my $html = shift || '';
# my $rightpane = shift || 0;
# my $htmltree;
$htmltree = [ { tag => 'document', content => [] } ];
$node = $htmltree->[0]->{content};
@prevnodes = ($htmltree);
$htmloutput = "";
my $p = HTML::Parser->new( api_version => 3,
start_h => [\&start, "tagname, attr"],
end_h => [\&end, "tagname"],
text_h => [\&text, "dtext"] );
if($filename ne '') {
open HTML, "< $filename" or die "Can't open input HTML file";
$html = "";
while() {
$html .= $_;
}
close HTML;
#$html =~ s|()|${1}_${2}|sg;
}
return undef if($html =~ /<\%\w+?>/s);
$p->parse($html);
$p->eof;
return $htmltree;
}
1;
What changes do I need to make so that I can do something like the following?
Thanks for any help.
use SkylineEdit;
my $htmltree = SkylineEdit->new;
$htmltree->html_to_htmltree($somefile);
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
tracking where I am in a tree structure (was: Re: parsing HTML)
Andrew Gaffney wrote:
Andrew Gaffney wrote:
Randy W. Sims wrote:
On 7/21/2004 11:24 PM, Andrew Gaffney wrote:
Randy W. Sims wrote:
On 7/21/2004 10:42 PM, Andrew Gaffney wrote:
I am trying to build a HTML editor for use with my HTML::Mason
site. I intend for it to support nested tables, SPANs, and
anchors. I am looking for a module that can help me parse existing
HTML (custom or generated by my scripts) into a tree structure
similar to:
my $html = [ { tag => 'table', id => 'maintable', width => 300,
content =>
[ { tag => 'tr', content =>
[
{ tag => 'td', width => 200, content => "some
content" },
{ tag => 'td', width => 100, content => "more
content" }
]
]
]; # Not tested, but you get the idea
[snip]
I'd rather generate a structure similar to what I have above instead
of having a large tree of class objects that takes up more RAM and
is probably slower. How would I go about generating a structure such
as that above using HTML::Parser?
Parsers like HTML::Parser scan a document and upon encountering
certain tokens fire off events. In the case of HTML::Parser, events
are fired when encountering a start tag, the text between tags, and
at the end tag. If you have an arbitrarily deep document structure
like HTML, you can store the structure using a stack:
Thanks. In the time it took you to put that together, I came up with
the following to figure out how HTML::Parser works. I'll use your code
to expand upon it.
Here is my current working code. Please take a look at it and see if
there are any obvious (or not so obvious) problems. I thought this would
end up being far more difficult.
parsehtml.pl
#!/usr/bin/perl
use strict;
use warnings;
use HTML::Parser ();
my $htmltree = [ { tag => 'document', content => [] } ];
my $node = $htmltree->[0]->{content};
my @prevnodes = ($htmltree);
sub start {
my $tagname = shift;
my $attr = shift;
my $newnode = {};
$newnode->{tag} = $tagname;
foreach my $key(keys %{$attr}) {
$newnode->{$key} = $attr->{$key};
}
$newnode->{content} = [];
push @prevnodes, $node;
push @{$node}, $newnode;
$node = $newnode->{content};
}
sub end {
my $tagname = shift;
$node = pop @prevnodes;
}
sub text {
my $text = shift;
chomp $text;
if($text ne '') {
push @{$node}, $text;
}
}
my $p = HTML::Parser->new( api_version => 3,
start_h => [\&start, "tagname, attr"],
end_h => [\&end, "tagname"],
text_h => [\&text, "dtext"] );
$p->parse_file("test.html");
use Data::Dumper;
print Dumper $htmltree;
test.html
=
some content
more content
Now for the next challenge. I need to be able to know where I am in the tree
structure for any node that I am in while I am walking it. I will pass along a
value via CGI in the form of '0.0.2.1.2' which another script will translate as
'$htmltree->[0]->{content}->[0]->{content}->[2]->{content}->[1]->{content}->[2]'.
Using the above code, and the following code I wrote for walking the tree and
generating HTML from it, how can I mark each outputted HTML tag with its
position in the tree?
sub descend_htmltree {
my $node = shift;
my $withclickiness = shift || 0;
foreach my $tmpnode (@{$node}) {
if(ref($tmpnode) eq 'HASH') {
my $nodeid = ""; # Magic code to generate node's position in tree
$htmloutput .= "" if($withclickiness);
$htmloutput .= "<$tmpnode->{tag}";
foreach(keys %{$tmpnode}) {
$htmloutput .= " $_=\"$tmpnode->{$_}\"" if($_ ne 'tag' && $_ ne 'content');
}
$htmloutput .= ">";
descend_htmltree($tmpnode->{content});
$htmloutput .= "{tag}>";
$htmloutput .= "" if($withclickiness);
} else {
$htmloutput .= "$tmpnode";
}
}
}
sub htmltree_to_html {
my $filename = shift || '';
my $withclickiness = shift || 0;
descend_htmltree($htmltree->[0]->{content}, $withclickiness);
if($filename ne '') {
open HTML, "> $filename" or die "Can't open $filename for HTML output";
print HTML $htmloutput;
close HTML;
}
return $htmloutput;
}
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: parsing HTML
Andrew Gaffney wrote:
Randy W. Sims wrote:
On 7/21/2004 11:24 PM, Andrew Gaffney wrote:
Randy W. Sims wrote:
On 7/21/2004 10:42 PM, Andrew Gaffney wrote:
I am trying to build a HTML editor for use with my HTML::Mason
site. I intend for it to support nested tables, SPANs, and anchors.
I am looking for a module that can help me parse existing HTML
(custom or generated by my scripts) into a tree structure similar to:
my $html = [ { tag => 'table', id => 'maintable', width => 300,
content =>
[ { tag => 'tr', content =>
[
{ tag => 'td', width => 200, content => "some
content" },
{ tag => 'td', width => 100, content => "more
content" }
]
]
]; # Not tested, but you get the idea
[snip]
I'd rather generate a structure similar to what I have above instead
of having a large tree of class objects that takes up more RAM and is
probably slower. How would I go about generating a structure such as
that above using HTML::Parser?
Parsers like HTML::Parser scan a document and upon encountering
certain tokens fire off events. In the case of HTML::Parser, events
are fired when encountering a start tag, the text between tags, and at
the end tag. If you have an arbitrarily deep document structure like
HTML, you can store the structure using a stack:
Thanks. In the time it took you to put that together, I came up with the
following to figure out how HTML::Parser works. I'll use your code to
expand upon it.
Here is my current working code. Please take a look at it and see if there are
any obvious (or not so obvious) problems. I thought this would end up being far
more difficult.
parsehtml.pl
#!/usr/bin/perl
use strict;
use warnings;
use HTML::Parser ();
my $htmltree = [ { tag => 'document', content => [] } ];
my $node = $htmltree->[0]->{content};
my @prevnodes = ($htmltree);
sub start {
my $tagname = shift;
my $attr = shift;
my $newnode = {};
$newnode->{tag} = $tagname;
foreach my $key(keys %{$attr}) {
$newnode->{$key} = $attr->{$key};
}
$newnode->{content} = [];
push @prevnodes, $node;
push @{$node}, $newnode;
$node = $newnode->{content};
}
sub end {
my $tagname = shift;
$node = pop @prevnodes;
}
sub text {
my $text = shift;
chomp $text;
if($text ne '') {
push @{$node}, $text;
}
}
my $p = HTML::Parser->new( api_version => 3,
start_h => [\&start, "tagname, attr"],
end_h => [\&end, "tagname"],
text_h => [\&text, "dtext"] );
$p->parse_file("test.html");
use Data::Dumper;
print Dumper $htmltree;
test.html
=
some content
more content
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: parsing HTML
Randy W. Sims wrote:
On 7/21/2004 11:24 PM, Andrew Gaffney wrote:
Randy W. Sims wrote:
On 7/21/2004 10:42 PM, Andrew Gaffney wrote:
I am trying to build a HTML editor for use with my HTML::Mason site.
I intend for it to support nested tables, SPANs, and anchors. I am
looking for a module that can help me parse existing HTML (custom or
generated by my scripts) into a tree structure similar to:
my $html = [ { tag => 'table', id => 'maintable', width => 300,
content =>
[ { tag => 'tr', content =>
[
{ tag => 'td', width => 200, content => "some
content" },
{ tag => 'td', width => 100, content => "more
content" }
]
]
]; # Not tested, but you get the idea
[snip]
I'd rather generate a structure similar to what I have above instead
of having a large tree of class objects that takes up more RAM and is
probably slower. How would I go about generating a structure such as
that above using HTML::Parser?
Parsers like HTML::Parser scan a document and upon encountering certain
tokens fire off events. In the case of HTML::Parser, events are fired
when encountering a start tag, the text between tags, and at the end
tag. If you have an arbitrarily deep document structure like HTML, you
can store the structure using a stack:
#!/usr/bin/perl
package SampleParser;
use strict;
use HTML::Parser;
use base qw(HTML::Parser);
sub start {
my($self, $tagname, $attr, $attrseq, $origtext) = @_;
my $stack = $self->{_stack};
my $depth = $stack ? @$stack : 0;
print ' ' x $depth, "<$tagname>\n";
push @{$self->{_stack}}, ' ';
}
sub end {
my($self, $tagname, $origtext) = @_;
pop @{$self->{_stack}};
my $stack = $self->{_stack};
my $depth = $stack ? @$stack : 0;
print ' ' x $depth, "<\\$tagname>\n";
}
1;
package main;
use strict;
use warnings;
my $p = SampleParser->new();
$p->parse_file(\*DATA);
__DATA__
Title
The body.
Thanks. In the time it took you to put that together, I came up with the
following to figure out how HTML::Parser works. I'll use your code to expand
upon it.
#!/usr/bin/perl
use strict;
use warnings;
use HTML::Parser ();
sub start {
print "start ";
foreach my $arg (@_) {
if(ref($arg) eq 'HASH') {
foreach my $key(keys %{$arg}) {
print " $key - $arg->{$key}\n";
}
} else {
print "$arg\n";
}
}
}
sub end {
print "end ";
foreach(@_) {
print "$_\n";
}
}
sub text {
my $text = shift;
chomp $text;
print " text - '$text'\n" if($text ne '');
}
my $p = HTML::Parser->new( api_version => 3,
start_h => [\&start, "tagname, attr"],
end_h => [\&end, "tagname"],
text_h => [\&text, "dtext"],
marked_sections => 1 ); # Not sure what this does
$p->parse_file("test.html");
The above gives me the expected output for the sample HTML I provided before.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: parsing HTML
Randy W. Sims wrote:
On 7/21/2004 10:42 PM, Andrew Gaffney wrote:
I am trying to build a HTML editor for use with my HTML::Mason site. I
intend for it to support nested tables, SPANs, and anchors. I am
looking for a module that can help me parse existing HTML (custom or
generated by my scripts) into a tree structure similar to:
my $html = [ { tag => 'table', id => 'maintable', width => 300,
content =>
[ { tag => 'tr', content =>
[
{ tag => 'td', width => 200, content => "some
content" },
{ tag => 'td', width => 100, content => "more
content" }
]
]
]; # Not tested, but you get the idea
which would correspond to the following HTML:
some content
more content
Once I have the data in the tree, I can easily modify it and transform
it back into HTML. Is there a module that can help make this easier or
should I go about this differently?
HTML::Parser doesn't build a tree, but you can use it to build one if
neccessary. However, you might find building a tree is not neccessary.
And this is less memory intensive.
Then there is HTML::Tree.
I'd rather generate a structure similar to what I have above instead of having a
large tree of class objects that takes up more RAM and is probably slower. How
would I go about generating a structure such as that above using HTML::Parser?
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
parsing HTML
I am trying to build a HTML editor for use with my HTML::Mason site. I intend
for it to support nested tables, SPANs, and anchors. I am looking for a module
that can help me parse existing HTML (custom or generated by my scripts) into a
tree structure similar to:
my $html = [ { tag => 'table', id => 'maintable', width => 300, content =>
[ { tag => 'tr', content =>
[
{ tag => 'td', width => 200, content => "some content" },
{ tag => 'td', width => 100, content => "more content" }
]
]
]; # Not tested, but you get the idea
which would correspond to the following HTML:
some content
more content
Once I have the data in the tree, I can easily modify it and transform it back
into HTML. Is there a module that can help make this easier or should I go about
this differently?
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: Expect prog. doesn't work in background !
Ravinder Arepally wrote: It works from command line. Problem is when we run it as a cron job. Yes, because you have a good PATH set at the command line. Not all cron daemons will set a sensible PATH environment variable. Use full paths to executables in your perl program. For example, use '/usr/bin/ftp' (or whatever) instead of 'ftp'. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: Expect prog. doesn't work in background !
Ravinder Arepally wrote: All. I wrote this perl program using Expect.pm and this program also works fine in foreground but does NOT work in background (cron job). Any help is greatly appreciated. Try using full paths to external programs. Cron doesn't always set a usable PATH when it runs scripts. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: Help a newbie to pick best version of Linux for Perl and perl/TK.
Marco Perl wrote: Hi, Could you tell me what version of Linux is the most stable and with most lib modules to do pearl and perl/TK? I really appreciate your experience. Marco. What exactly are you talking about? Almost all Linux distributions are "stable" and come with Perl. Usually, the version of the Linux kernel won't affect anything in Perl or Perl/Tk, either. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: Regex for numbers and text
Jerry Preston wrote: Hi! I am trying to setup a single regex to breakdown the following lines: Jerry 2.74 4.5 mon Mark-14-10.75 -10 new With /(\w+)\s+(-?\d+.\d+)\s+(-?\d+.\d+)\s+(-?\d+.\d+)\s+(\w+)/; What am I doing wrong? At first glance, the regex appears to be fine, although I could just be missing something. What is your code and what happens instead of what you expect? -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- 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 Error when running MIME::Lite
jason corbett wrote: How can I install it when I don't have root rights to place it in the bin? First, please reply to the list. Second, either get the person who does have root access to install the module or install it locally in your home dir and add it to your @INC (someone else can tell you how to do that). -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- 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 Error when running MIME::Lite
jason corbett wrote: Cannot locate MIME/Lite.pm in @INC. @INC contains: /usr/local/perl156/lib/5.6.1/PA-RISC2... Any one know about this? You need to install the MIME::Lite module. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: parsing large amounts of text
John W. Krahn wrote:
Andrew Gaffney wrote:
I'm working on a custom Perl script to parse my Apache logs and report custom
information. When I run the following program, it ends up eating all available
RAM (the system has 1GB) and dying. My access_log is ~410MB. Am I doing
something wrong?
The only problems I can see is that your regular expression is
inefficient and your AoA @requests may get very large.
#!/usr/bin/perl
use strict;
use warnings;
use CGI();
my $months = { Jan => 1, Feb => 2, Mar => 3, Apr => 4, May => 5, Jun => 6, Jul
=> 7, Aug => 8, Sep => 9, Oct => 10, Nov => 11, Dec => 12 };
my @requests;
my $start = time;
open LOG, "< /var/log/apache/access_log";
You should *ALWAYS* verify that the file opened correctly.
open LOG, '< /var/log/apache/access_log'
or die "Cannot open '/var/log/apache/access_log' $!";
while() {
my $line = $_;
Why not just:
while ( my $line = ) {
Why use $line at all?
$line =~ /^(\d+\.\d+\.\d+\.\d+) (.+?) (.+?) \[(.+?)\] \"(?:(.+?) )?(.+)(?:
(.+?))?\" (\d+) (.+?) \"(.+?)\" \"(.+?)\"$/;
If you are not using $2, $3, $5, $7 and $10 why capture them? You
should probably replace .+? with something more meaningful that won't
backtrack.
my ($ip, $date, $request, $requestcode, $bytesreturned, $browser) = ($1, $4,
$6, $8, $9, $11);
You shouldn't use the numererical scalars unless the regular expression
succeeded or they will just contain the values from the last successful
match.
$request = CGI::unescape($request);
push @requests, [$ip, $date, $request, $requestcode, $bytesreturned, $browser];
}
I would write that while loop as:
while ( ) {
my @fields = /^(\d+\.\d+\.\d+\.\d+) .+? .+? \[(.+?)\] "(?:.+?
)?(.+)(?:.+?)?" (\d+) (.+?) ".+?" "(.+?)"$/ or next;
$fields[ 2 ] = CGI::unescape( $fields[ 2 ] );
push @requests, [EMAIL PROTECTED];
}
my $end = time;
my $elapsed = $end - $start;
close LOG;
print "$#requests total records. $elapsed seconds elapsed\n";
John
I had originally wrote this program about 6 months ago when I still had a lot
more Perl bad habits. I just started expanding upon the program without really
thinking about all that. I'll take your suggestions, though.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
parsing large amounts of text
I'm working on a custom Perl script to parse my Apache logs and report custom
information. When I run the following program, it ends up eating all available
RAM (the system has 1GB) and dying. My access_log is ~410MB. Am I doing
something wrong?
#!/usr/bin/perl
use strict;
use warnings;
use CGI();
my $months = { Jan => 1, Feb => 2, Mar => 3, Apr => 4, May => 5, Jun => 6, Jul
=> 7, Aug => 8, Sep => 9, Oct => 10, Nov => 11, Dec => 12 };
my @requests;
my $start = time;
open LOG, "< /var/log/apache/access_log";
while() {
my $line = $_;
$line =~ /^(\d+\.\d+\.\d+\.\d+) (.+?) (.+?) \[(.+?)\] \"(?:(.+?) )?(.+)(?:
(.+?))?\" (\d+) (.+?) \"(.+?)\" \"(.+?)\"$/;
my ($ip, $date, $request, $requestcode, $bytesreturned, $browser) = ($1, $4,
$6, $8, $9, $11);
$request = CGI::unescape($request);
push @requests, [$ip, $date, $request, $requestcode, $bytesreturned, $browser];
}
my $end = time;
my $elapsed = $end - $start;
close LOG;
print "$#requests total records. $elapsed seconds elapsed\n";
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: Creating images
dan wrote:
Hi all, again!
I'm attempting to make a web page, where all the buttons are dynamic, where
dynamic I say there's 1 "template" button image with nothing written on it,
and I want to put requests into a html page to call a script as an image to
put text on top of the image, then output as 1 image. Does this make sense
what I'm try to do? Is this even possible? If so, what's the best way of
going about it, as I have absolutely no idea where to start on this one.
I've aquired Apache::ImageMagick, but can't make head nor tail of the
readme.
To give you a start, this is a script I created a while back to create uniform
buttons for a website I was working on.
#!/usr/bin/perl
use strict;
use warnings;
use GD;
my $im = new GD::Image(61,20);
my ($text, $saveto) = @ARGV;
my $white = $im->colorAllocate(255,255,255);
my $black = $im->colorAllocate(0,0,0);
my $gray = $im->colorAllocate(132,132,132);
my $blue = $im->colorAllocate(206,206,255);
my $leftblue = $im->colorAllocate(231,231,255);
my $bottomblue = $im->colorAllocate(165,165,206);
my $rightblue = $im->colorAllocate(123,123,156);
my $topblue = $im->colorAllocate(214,214,255);
$im->transparent($white);
$im->interlaced('true');
$im->filledRectangle(0,0,60,19,$white);
$im->filledRectangle(3,3,60,19,$gray);
$im->filledRectangle(0,0,57,16,$blue);
$im->rectangle(0,0,57,16,$white);
$im->line(1,0,56,0,$topblue);
$im->line(57,1,57,15,$rightblue);
$im->line(1,16,56,16,$bottomblue);
$im->line(0,1,0,15,$leftblue);
# Dry run to determine size of outputted text
my @bounds = GD::Image->stringFT($black,"/somedir/arialnb.ttf",9,0,0,0,$text);
# Use above dimensions to center text
$im->stringFT($black,"/somedir/arialnb.ttf",9,0,((57-$bounds[2])/2),13,$text);
open IMAGE, "> $saveto" or die "Can't open $saveto\n";
binmode IMAGE;
print IMAGE $im->png;
close IMAGE;
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: can't coerce array into hash
Charles K. Clarkson wrote:
Andrew Gaffney <[EMAIL PROTECTED]> wrote:
: My boss wants me to write a script that will allow him to browse
: through the customers in our DB alphabetically. He wants all the
: customer's information to display on the page. I wrote the following
: as part of the script. I get the error 'Can't coerce array into hash'
: at the first 'if' into the loop. What am I doing wrong?
:
: my $sth2 = $dbh->prepare("SELECT id FROM people ORDER BY lname,
: fname, mname"); $sth2->execute;
: my $people = $sth2->fetchall_arrayref;
What does $people look like?
use Data::Dumper 'Dumper';
print Dumper $people;
__END__
Tell us what you get.
I'm loving Data::Dumper more and more. Apparently, it doesn't return a ref to an
array of hashrefs like I figured it would. It it an array of array refs. I only
requested one field from the DB so it is $people->[$lv]->[0].
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
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 coerce array into hash
My boss wants me to write a script that will allow him to browse through the
customers in our DB alphabetically. He wants all the customer's information to
display on the page. I wrote the following as part of the script. I get the
error 'Can't coerce array into hash' at the first 'if' into the loop. What am I
doing wrong?
my $sth2 = $dbh->prepare("SELECT id FROM people ORDER BY lname, fname, mname");
$sth2->execute;
my $people = $sth2->fetchall_arrayref;
my $lastperson, $nextperson;
for my $lv (0..$#{$people}) {
if($people->[$lv]->{id} eq $id) {
if(!$lv) {
$lastperson = $people->[$lv-1]->{id};
} else {
$lastperson = -1;
}
if($lv != $#{$people}) {
$nextperson = $people->[$lv+1]->{id};
} else {
$nextperson = -1;
}
}
}
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: different versions of same Perl module in different Apache vh osts
Bob Showalter wrote: Andrew Gaffney wrote: I will end up having more than 2 vhosts, most of which will need a custom version of this particular module. In that case, I think you'll need to give the modules different names. You could write your handler in such a way that it would recompile the module (switching flavors) with each request, but that would kind of defeat the purpose of mod_perl... Is there a way to auto-import a particular module in the vhost definition so that my scripts don't have to 'use' it? I think that would give me the results I'm looking for. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: different versions of same Perl module in different Apache vh osts
Bob Showalter wrote: Andrew Gaffney wrote: I didn't really know where to post this since it isn't specifically Apache or Perl, so I'm posting herejust because :) I run 2 vhosts under Apache 1.3.29 (needed for mod_perl-1.x which is needed by HTML::Mason) on my Gentoo server. One vhost is the current production site and the other vhost is the development version of the site. I use a custom Perl module for authentication and other common functions for all my Perl CGI/mod_perl scripts. I want to be able to make changes to the module, but I only want it to affect the second vhost. Basically, I need to have 2 copies of my custom module, one for each vhost. Is there an easy way to do this? If you have only one instance of Apache, I think the answer is no. The multiple virtual hosts still share the single perl interpreter. Why not just run two instances of Apache and put your development version on the second (listen on port 8080 or some such)? I will end up having more than 2 vhosts, most of which will need a custom version of this particular module. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: Website Login and data parsing
Lesly Ramirez wrote:
Hello All,
Need help creating a script that goes into a secure website, logs in
using my credentials and then parses through the data looking for dates
and dollar amounts and reports back in an email if the information was
found.
Does anyone know which modules I can use to make this happen? Please
advise.
I wrote a program that logs in to my old bank's online banking and grabs my
balance and available balance. The following code should give you an idea of
where to start.
#!/usr/bin/perl
use LWP::UserAgent;
use HTTP::Cookies;
my $res, $req;
my $ua = LWP::UserAgent->new;
$ua->cookie_jar(HTTP::Cookies->new(file => "/tmp/bankcookies.txt", autosave => 1));
my $availbalance, $balance;
my $username = "username";
my $password = "";
# Login
$req = HTTP::Request->new(POST => 'https://pcbanking.umb.com/login.asp');
$req->content_type('application/x-www-form-urlencoded');
$req->content("pgUserId=${username}&pgPassword=${password}&pgValidationReq=1&pgWhichBrowser=IE&pgLogin=Login");
$res = $ua->request($req);
# Get Balances
$req = HTTP::Request->new(GET => https://pcbanking.umb.com/Accountsummary.asp');
$res = $ua->request($req);
$output = $res->as_string;
$output =~ s/.+(.+)<\/div>.+/$1/s;
$output =~ /\$(\d+\.\d+).+\$(\d+\.\d+)
It was pretty easy to login automatically to this site, but I can't do the same
thing for my current bank or my credit card company (Capital One), because their
login pages use Javascript to generate random values and set cookies that are
needed to login. I could figure it out if I really wanted to, but it isn't that
big of a deal for me.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: different versions of same Perl module in different Apache vhosts
Philipp Traeder wrote:
On Saturday 05 June 2004 HH:18:16, Andrew Gaffney wrote:
I didn't really know where to post this since it isn't specifically Apache
or Perl, so I'm posting herejust because :)
I run 2 vhosts under Apache 1.3.29 (needed for mod_perl-1.x which is needed
by HTML::Mason) on my Gentoo server. One vhost is the current production
site and the other vhost is the development version of the site. I use a
custom Perl module for authentication and other common functions for all my
Perl CGI/mod_perl scripts.
I want to be able to make changes to the module, but I only want it to
affect the second vhost. Basically, I need to have 2 copies of my custom
module, one for each vhost. Is there an easy way to do this?
Hi Andrew,
that's a very interesting question ;-)
I don't know anything about mod_perl, but I'd think that it depends on how you
load your module and where it is located. IIRC, you can set environment
variables per vhost. Maybe there's a way of modifying the @INC variable for
your development vhost?
From what I've heard over at PerlMonks, this won't work because of the way that
mod_perl-1.x works.
Or - a less elegant option: Set an environment variable (or rewrite the URL)
for the development vhost, and replace your authentication module with a
module that checks this environment variable (or: a URL parameter) and loads
the right module.
Let's say your module is called authentication.pm - rename it to
authentication_real.pm and duplicate it as authentication_dev.pm
Create a new file authentication.pm that does something like:
if ($ENV{'development_special_purpose'}) {
require 'authentication_dev.pm';
}
else {
require 'authentication_real.pm';
}
I'm not speaking from experience here and I've not tested or re-checked if
this works, just thinking in loud voice ;-)
I'm looking for something that doesn't require extra code, but it would probably
work.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
different versions of same Perl module in different Apache vhosts
I didn't really know where to post this since it isn't specifically Apache or Perl, so I'm posting herejust because :) I run 2 vhosts under Apache 1.3.29 (needed for mod_perl-1.x which is needed by HTML::Mason) on my Gentoo server. One vhost is the current production site and the other vhost is the development version of the site. I use a custom Perl module for authentication and other common functions for all my Perl CGI/mod_perl scripts. I want to be able to make changes to the module, but I only want it to affect the second vhost. Basically, I need to have 2 copies of my custom module, one for each vhost. Is there an easy way to do this? -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: [Socket Programming]: Need info for Client / Server scenario
[EMAIL PROTECTED] wrote: I need some good links for understanding socket programming (Client / Server programming). I have written some scripts for multiple clients and a server (Forking Server). But I am facing some problems - the server data has to be shared among all the child processes - does this happen when we fork - what should I do for this to happen. Requirement is: "Normal clients" keep polling the server for some info. Server will get some info from a "master client" till then the server responds back with null info to the "Normal clients". The server data that my master client is updating should get reflected in all the child processes (of forked server) - this is not happening. What should I do to achieve this? Also I want my server to respond back immediately to all the clients getting connected. This is not happening. Warning: the following is coming from someone who has never written any programs with multi-connection servers, forking, or threads, but I have done lots of reading ;) It seems to me that it would work better in your situation to start separate threads instead of forking in your program. It would allow you to easily have a shared memory space, and I believe threads aren't quite as "expensive" as new processes (forking). Again, keep in mind that you should take anything I say with a grain of salt. Anything I say in this thread should be assumed wrong until verified by someone who has some idea what they are talking about :) -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: regex help
Roberto Etcheverry wrote:
On Fri, 28 May 2004, Andrew Gaffney wrote:
I'm trying to write a regex to parse the following data. Each group is a string
to parse.
05/28/04
Purchase With Pin Pin
$10.00(pending)
$1,224.45
05/27/04
Purchase With Pin Shell Service Stlake
St. Loumo
$1.78
$1,234.45
05/21/04
Atm Withdrawal One O'fallon Squo'fallon
Mo 1
$20.00
$
1,134.79
This is the regex I put together:
my $regex = ']+?>(\d{2})/(\d{2})/(\d{2}).+?';
$regex .= ']+?>(.*?).+?';
$regex .= ']+?>(.+?).+?';
$regex .= ']+?>(?:\$(\d+\.\d{2})).*?.+?';
$regex .= ']+?>(?:\$(\d+\.\d{2})).*?.+?';
$regex .= ']+?>.*?(?:\$(\d+\.\d{2})).*?';
The first field will always be in the form 'mm/dd/yy'. The second and third
field need to be captured as they are. As for the fourth and fifth fields, only
one will contain a value. The other one will be empty (nothing between
). The format is '$123.45' with the possibility of trailing HTML before
the . I only want the number without the $. The sixth field will contain a
dollar amount like the fourth and fifth fields. It could be surrounded by HTML.
Again, I only need the number without the $. What is wrong with the above regex?
I am using it with the 's' modifier.
It seems two things are missing:
1) A '?' after the 4th and 5th group (because they may be empty).
2) Include ',' on the regex matching the amounts (to match '1,234.45' for
example).
So the regex would be:
my $regex = ']+?>(\d{2})/(\d{2})/(\d{2}).+?';
$regex .= ']+?>(.*?).+?';
$regex .= ']+?>(.+?).+?';
$regex .= ']+?>(?:\$([\d,]+\.\d{2}))?.*?.+?';
$regex .= ']+?>(?:\$([\d,]+\.\d{2}))?.*?.+?';
$regex .= ']+?>.*?(?:\$([\d,]+\.\d{2})).*?';
Ah, thank you. Those changes worked.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: weird math
Kevin Old wrote: On Thu, 2004-05-27 at 23:31, Andrew Gaffney wrote: I am writing a program to parse a CSV file downloaded from my bank. I have it keep a running balance, but I'm getting a weird total. Apparently, -457.16 + 460.93 = 3.769998. But when 20 is subtracted from that, I get -16.23. There are no weird numbers like that in my input data. All numbers have no more than 2 numbers after the decimal point. Here is my code: [...] print "$balance\n"; Andrew, Try using this when you print out the $balance: printf "%.2f", $balance; You'll get 3.77. I was going to use that for output, but I was just curious why it was happening in the first place. I think all the other posts answered that question. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
regex help
I'm trying to write a regex to parse the following data. Each group is a string
to parse.
05/28/04
Purchase With Pin Pin
$10.00(pending)
$1,224.45
05/27/04
Purchase With Pin Shell Service Stlake
St. Loumo
$1.78
$1,234.45
05/21/04
Atm Withdrawal One O'fallon Squo'fallon
Mo 1
$20.00
$
1,134.79
This is the regex I put together:
my $regex = ']+?>(\d{2})/(\d{2})/(\d{2}).+?';
$regex .= ']+?>(.*?).+?';
$regex .= ']+?>(.+?).+?';
$regex .= ']+?>(?:\$(\d+\.\d{2})).*?.+?';
$regex .= ']+?>(?:\$(\d+\.\d{2})).*?.+?';
$regex .= ']+?>.*?(?:\$(\d+\.\d{2})).*?';
The first field will always be in the form 'mm/dd/yy'. The second and third
field need to be captured as they are. As for the fourth and fifth fields, only
one will contain a value. The other one will be empty (nothing between
). The format is '$123.45' with the possibility of trailing HTML before
the . I only want the number without the $. The sixth field will contain a
dollar amount like the fourth and fifth fields. It could be surrounded by HTML.
Again, I only need the number without the $. What is wrong with the above regex?
I am using it with the 's' modifier.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
weird math
I am writing a program to parse a CSV file downloaded from my bank. I have it
keep a running balance, but I'm getting a weird total. Apparently, -457.16 +
460.93 = 3.769998. But when 20 is subtracted from that, I get -16.23.
There are no weird numbers like that in my input data. All numbers have no more
than 2 numbers after the decimal point. Here is my code:
#!/usr/bin/perl
do './money.pl';
# use strict and warnings is defined in money.pl
my $balance = 0;
print $cgi->header;
print "\n";
print "\nDateTypeDescriptionWithdrawlDeposit
my $csvdata = parse_csv("/tmp/usbank.csv");
foreach(@{$csvdata}) {
print "$_->{date}$_->{type}$_->{descr}";
if($_->{amount} > 0) {
print "$_->{amount}";
} else {
print "$_->{amount}";
}
$balance += $_->{amount};
print "$balance\n";
}
print "";
money.pl is an include file that contains the parse_csv() function which pulls
apart each line of the downloaded CSV and pushes it into an array as an
anonymous hash.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: displaying to_char formatting in Perl
Wiggins d Anconia wrote: Please bottom post I only top-post when other people in the thread do because it keeps things a little less confusing. It annoys the crap out of me, though. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: displaying to_char formatting in Perl
MCMULLIN, NANCY wrote: Thank you kindly. That fixed it. No problem. I do that all the time ;) -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: displaying to_char formatting in Perl
There isn't really a syntax error in your SQL query, but Perl is creating one. Because of the interpolation issue I described in my previous post, Perl is generating the line: TO_CHAR(ie_dollar_amt, ',999.99'), MCMULLIN, NANCY wrote: Sorry. The original error I reported was due to a syntax error. I fixed that. What's happening is when I do not include the line: TO_CHAR(ie_dollar_amt, '$999,999.99'), it displays 366 records correctly. With that line included - it comes up with "Query returned 0 records" - no data. (Thank you for reminding me about CGI:Carp.. I will include it in all programs.) -Original Message- From: Jan Eden [mailto:[EMAIL PROTECTED] Sent: Thursday, May 27, 2004 1:38 PM To: MCMULLIN, NANCY; Perl Lists Subject: RE: displaying to_char formatting in Perl Hi Nancy, MCMULLIN, NANCY wrote on 27.05.2004: The error is "Internal Server Error". As soon as I comment out the (2)lines below: -- TO_CHAR(ie_dollar_amt, '$999,999.99'), it works just fine. As suggested before: use CGI::Carp qw(fatalsToBrowser); You'll get a more informative error message then. - Jan -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: displaying to_char formatting in Perl
MCMULLIN, NANCY wrote:
The error is "Internal Server Error".
As soon as I comment out the (2)lines below:
-- TO_CHAR(ie_dollar_amt, '$999,999.99'),
it works just fine.
Here's the code:
==
#!c:/activeperl/bin/perl
use strict;
use DBI;
use DBD::Oracle;
use CGI qw(:standard *table *Tr );
my $dbh = DBI->connect('DBI:Oracle:xx', 'yyy', 'zzz') || die "Couldn't connect todatabase: " . DBI->errstr;
my $NUM_OF_ROWS=0;
my %bgca = ( -bgcolor => "#ff", -align => "left", );
my $sql = param('sql');
my @cols = param('select');
my $select_list;
foreach (@cols) {
$select_list .= " $_,";
}
chop($select_list) if $select_list;
unless ($select_list) {
$select_list = '*';
}
$sql = "
SELECT coban.c_oac_oban ,c_fund_code,
DECODE(d_doc_nbr, null, ' ' , d_doc_nbr),
TO_CHAR(ie_dollar_amt, '$999,999.99'),
DECODE(ie_dollar_amt, null, ' ' , ie_dollar_amt),
DECODE(d_cost_cd, null, ' ' , d_cost_cd),
DECODE(d_coc, null, ' ', d_coc)
FROM
cpas_difms cd,
(SELECT c_oac_oban, ie_infile, ie_seq_nbr FROM CPAS_LOAD
WHERE (ie_infile, ie_seq_nbr) IN
(SELECT ie_infile, ie_seq_nbr FROM CPAS_DIFMS
WHERE ie_proc_cd='1')) coban
WHERE ie_proc_cd='1'
AND coban.ie_infile = cd.ie_infile and coban.ie_seq_nbr = cd.ie_seq_nbr
UNION ALL
SELECT goban.g_oac || goban.g_asn_oban OAC_OBAN, g_fund_code,
DECODE(d_doc_nbr, null, ' ', d_doc_nbr),
TO_CHAR(ie_dollar_amt, '$999,999.99'),
DECODE(ie_dollar_amt, null, ' ' , ie_dollar_amt),
DECODE(d_cost_cd, null, ' ' , d_cost_cd),
DECODE(d_coc, null, ' ', d_coc)
FROM
gafs_difms gd,
(SELECT g_oac, g_asn_oban,ie_infile, ie_seq_nbr FROM GAFS_LOAD
WHERE (ie_infile, ie_seq_nbr) IN
(SELECT ie_infile, ie_seq_nbr FROM GAFS_DIFMS
WHERE ie_proc_cd='1')) goban
WHERE ie_proc_cd='1'
AND goban.ie_infile = gd.ie_infile and goban.ie_seq_nbr = gd.ie_seq_nbr";
if (param('sql')) {
$sql .= ' '.param('sql');
}
my $sth;
eval {
$sth = $dbh->prepare($sql);
};
if ($@) {
errman($@);
exit;
}
my $rv;
eval {
$rv = $sth->execute;
};
if ($@) {
errman($@);
exit;
}
my (@row_ary, $ar);
eval {
$ar = $sth->fetchall_arrayref;
};
if ($@) {
errman($@);
exit;
}
eval {
$sth->finish;
};
if ($@) {
errman($@);
exit;
}
eval {
$dbh->disconnect;
};
if ($@) {
errman($@);
exit;
}
print header( -type =>"text/html" ),
start_html( -title => "...", -bgcolor => "#FEF3DE", -font face => "tahoma", -font size => "1",),
start_table(
{ -border => 0,
-cellspacing => 3,
-width => 700,
} ),
th( \%bgca, [EMAIL PROTECTED] );
foreach (@$ar) {
print start_Tr(),
td( \%bgca,
$_
),
end_Tr;
$NUM_OF_ROWS++;
}
print end_table;
my ($name, $value);
print end_html;
warn "error: $DBI::errstr\n" if $DBI::err;
print ("","Query returned $NUM_OF_ROWS records" , "");
exit(0);
==
You need to escape the $ as \$. In the first snippet you showed us, it was only
enclosed by '' which wouldn't interpolate. In this code snippet, the whole thing
is enclosed in "" which does interpolate. Perl was trying to access the variable
$999, which doesn't exist.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: Regular Expresssion - Matching over multiple lines
James Edward Gray II wrote:
On May 17, 2004, at 11:16 PM, Andrew Gaffney wrote:
Roman Hanousek wrote:
Hi All I have bunch of files that contain code like this:
What I am trying to do is match then check that this
piece of code contains a alt= tag.
And if it doen't print the lines where it's missing to screen or file.
while($input =~ ||sgc) {
print "Missing ALT\n" if(! defined $1);
}
That doesn't give you line numbers, but it does give you an idea of
where to start.
Be careful. Matching HTML-style markup with regexen is surprisingly
tricky. I suspect the version above would not work well in many
instances. Remember .+ is super greedy, more so since you allow it to
swallow \n as well. The above pattern should match the first . That's probably not going to work out to well, in many cases.
Depending on how much is known about the tags, you might have more luck
with a pattern like:
m!]+)/>!g
From there it's pretty easy to check $1 for an alt="...", or whatever.
Hope that helps.
Doesn't the 'gc' modified make the whole think not as greedy? As a side effect
of continuation, doesn't it try to match as many times as possible?
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: Regular Expresssion - Matching over multiple lines
Roman Hanousek wrote:
Hi All
I have bunch of files that contain code like this:
What I am trying to do is match then check that this
piece of code contains a alt= tag.
And if it doen't print the lines where it's missing to screen or file.
while($input =~ ||sgc) {
print "Missing ALT\n" if(! defined $1);
}
That doesn't give you line numbers, but it does give you an idea of where to start.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
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 ssh vnc tunnel
Paul D. Kraus wrote: I am trying to write a quick script that will establish an ssh tunnel to a remote linux server that will let me run vncviewer on any machine behind that machine. I have this ... system ( "ssh -g -C -L 5900:machinebehindserver:5900 remotelinuxserver" ); system ( "vncviewer localhost" ); of course this doesn't work because it tryes to run vncviewer localhost on the ssh server rather then on my box. The commands run from terminal work fine. I run the ssh command then i open another terminal and run the vncviewer. Everything is groovy :) Change the above ssh command to: ssh -N -f -g -C -L 5900:machinebehindserver:5900 remotelinuxserver This will send ssh to the background after establishing the tunnel. Also, you don't need Perl for this. You can easily use a bash script which will have less overhead. #!/usr/bin/bash ssh -N -f -g -C -L 5900:machinebehindserver:5900 remotelinuxserver vncviewer localhost -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: removing element of array
Charles K. Clarkson wrote:
Andrew Gaffney <[EMAIL PROTECTED]> wrote:
:
: I've modified your code to be more like it is in my program:
:
: #!/usr/bin/perl
:
: use strict;
: use warnings;
: use Data::Dumper 'Dumper';
:
: my $array1 = ['test1', 'test2', 'test3', 'test4', '!test5',
: 'test6', 'test7'];
:
: print Dumper $array1;
:
: for my $lv (0..$#{$array1}) {
:splice @$array1, $lv, 1 if($array1->[$lv] =~ /^!/);
: }
:
: print Dumper $array1;
:
: This doesn't quite work because I'm removing elements
: from the array I'm looping through. What would be the
: best way to take care of this?
Don't use splice::)
print Dumper $array1;
@$array1 = grep ! /^!/, @$array1;
print Dumper $array1;
Well, I'm working with the data in the array at the same time I'm trying to
remove certain elements. I need to process the elements that start with a '!'
and then remove them. I process all other elements differently.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: removing element of array
Andrew Gaffney wrote:
Charles K. Clarkson wrote:
Andrew Gaffney <[EMAIL PROTECTED]> wrote:
: : Charles K. Clarkson wrote:
: > : > I don't understand what result you want to assign to
: > the original array ref. Give us an example of what you want
: > to end up with and we can get you there.
: > : > Starting with this:
: > : > : my $array1 = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, :
13, 14, 15];
: > : > End up with:
: > : > $array1 = ???
: > $array2 = ???
: > $array3 = ???
: : I was just using those as temporary variables. Basically, I
: want to end up with an array that is [0, 1, 2, 3, 4, 5, 7, 8,
: 9, 10, 11, 12, 13, 14, 15] (missing the 7th element in this
: case). I'm just trying to figure out how to remove an
: arbitrary element from an array and not leave an empty space.
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper 'Dumper';
my $array1 = [0 .. 15];
print Dumper $array1;
splice @$array1, 6, 1;
print Dumper $array1;
I've modified your code to be more like it is in my program:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper 'Dumper';
my $array1 = ['test1', 'test2', 'test3', 'test4', '!test5', 'test6',
'test7'];
print Dumper $array1;
for my $lv (0..$#{$array1}) {
splice @$array1, $lv, 1 if($array1->[$lv] =~ /^!/);
}
print Dumper $array1;
This doesn't quite work because I'm removing elements from the array I'm
looping through. What would be the best way to take care of this? Would
it work to set elements to remove to undef and then remove them
afterwards by iterating through the array backwards (to not change the
array indexes relative to the beginning)?
for my $lv (0..$#{$array1}) {
$array1->[$lv] = undef if($array1->[$lv] =~ /^!/);
}
for my $lv ($#{$array1}..0) {
splice @$array1, $lv, 1 if(! defined $array1->[$lv]);
}
Would this work as I think it would?
To answer myself: No. But the following works:
for my $lv (0..$#{$array1}) {
$array1->[$lv] = undef if($array1->[$lv] =~ /^!/);
}
for my $lv (-($#{$array1})..0) {
$lv = abs($lv);
if(! defined $array1->[$lv]) {
splice @$array1, $lv, 1;
}
}
Perl wouldn't let me count backwards in a for() loop, so I worked around it by
negatizing the start and using abs() to convert it back to the positive array
index. It worked perfectly.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: removing element of array
Charles K. Clarkson wrote:
Andrew Gaffney <[EMAIL PROTECTED]> wrote:
:
: Charles K. Clarkson wrote:
: >
: > I don't understand what result you want to assign to
: > the original array ref. Give us an example of what you want
: > to end up with and we can get you there.
: >
: > Starting with this:
: >
: > : my $array1 = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
: 13, 14, 15];
: >
: > End up with:
: >
: > $array1 = ???
: > $array2 = ???
: > $array3 = ???
:
: I was just using those as temporary variables. Basically, I
: want to end up with an array that is [0, 1, 2, 3, 4, 5, 7, 8,
: 9, 10, 11, 12, 13, 14, 15] (missing the 7th element in this
: case). I'm just trying to figure out how to remove an
: arbitrary element from an array and not leave an empty space.
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper 'Dumper';
my $array1 = [0 .. 15];
print Dumper $array1;
splice @$array1, 6, 1;
print Dumper $array1;
I've modified your code to be more like it is in my program:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper 'Dumper';
my $array1 = ['test1', 'test2', 'test3', 'test4', '!test5', 'test6', 'test7'];
print Dumper $array1;
for my $lv (0..$#{$array1}) {
splice @$array1, $lv, 1 if($array1->[$lv] =~ /^!/);
}
print Dumper $array1;
This doesn't quite work because I'm removing elements from the array I'm looping
through. What would be the best way to take care of this? Would it work to set
elements to remove to undef and then remove them afterwards by iterating through
the array backwards (to not change the array indexes relative to the beginning)?
for my $lv (0..$#{$array1}) {
$array1->[$lv] = undef if($array1->[$lv] =~ /^!/);
}
for my $lv ($#{$array1}..0) {
splice @$array1, $lv, 1 if(! defined $array1->[$lv]);
}
Would this work as I think it would?
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: removing element of array
Charles K. Clarkson wrote: Andrew Gaffney <[EMAIL PROTECTED]> wrote: : : I tried to write a small test script to figure this out, : but I can't get anywhere. I used array references in my : test program, because I need to pull out an element from : an array through a ref and assign the result back to the : same array ref. I don't understand what result you want to assign to the original array ref. Give us an example of what you want to end up with and we can get you there. Starting with this: : my $array1 = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15]; End up with: $array1 = ??? $array2 = ??? $array3 = ??? I was just using those as temporary variables. Basically, I want to end up with an array that is [0, 1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 12, 13, 14, 15] (missing the 7th element in this case). I'm just trying to figure out how to remove an arbitrary element from an array and not leave an empty space. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: removing element of array
Andrew Gaffney wrote:
Wiggins d'Anconia wrote:
Andrew Gaffney wrote:
I have an array that I need to remove an element from the middle of.
Is there a one-liner way to do this?
perldoc -f delete
perldoc -f splice
Helps?
A little, but I don't know how to put it all together.
I tried to write a small test script to figure this out, but I can't get
anywhere. I used array references in my test program, because I need to pull out
an element from an array through a ref and assign the result back to the same
array ref. Here's what I've got:
#!/usr/bin/perl
use strict;
use warnings;
my $array1 = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15];
my $array2 = [EMAIL PROTECTED] @{$array1}, 0, 6};
my $array3 = [EMAIL PROTECTED] @{$array1}, 7};
push @{$array2}, @{$array3};
print join ', ', @{$array1} . "\n";
This gives me the following when I run it:
Can't use string ("5") as an ARRAY ref while "strict refs" in use at ./array.pl
line 8.
What am I doing wrong?
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: removing element of array
Wiggins d'Anconia wrote: Andrew Gaffney wrote: I have an array that I need to remove an element from the middle of. Is there a one-liner way to do this? perldoc -f delete perldoc -f splice Helps? A little, but I don't know how to put it all together. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
removing element of array
I have an array that I need to remove an element from the middle of. Is there a one-liner way to do this? -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: Problem with use strict;
MCMULLIN, NANCY wrote: But when I run the same code with use strict commented out - it works just fine... 'use strict' enforces the use of 'my' or 'our' for variable declarations. If a variable declaration doesn't have that while 'use strict' is in effect, the program won't compile. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: find outside ipadress of router with perl
bert huygens wrote: Dear All, is it possible in Perl to find the outside ip-address from an adsl-router without using an outside box. i need to restart a script when the outside address of the router changes Yeah, use LWP to goto 'http://privacy.net/' and run the following regex against the results: /Your IP address is (\d+\.\d+\.\d+\.\d+)/ The router's outside IP should be in $1. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
simulating bash
As part of a program I'm writing, I need to read some variables from a bash
script and do some bash-style interpolation. My current code:
sub get_depend {
my $ebuildfname = shift;
my $ebuildcontents;
my %ebuildvars;
my $pkgname = $ebuildfname;
$pkgname =~ s|/usr/portage/||;
$pkgname =~ s|(.+)/.+/(.+).ebuild|$1/$2|;
my $pkg = parse_package_name($pkgname);
$pkg->{version} =~ s/^-//;
$ebuildvars{PV} = "$pkg->{version}";
open EBUILD, "< $ebuildfname" or die "Couldn't open '$ebuildfname'\n";
while() {
$ebuildcontents .= $_;
}
close EBUILD;
while($ebuildcontents =~ /\b([-A-Z0-9_]+)=\"(.*?)\"{1}?/sgc) {
$ebuildvars{$1} = $2;
}
foreach(keys %ebuildvars) {
$ebuildvars{$_} =~ s/\$\{?([-A-Z0-9_]+)\}?/$ebuildvars{$1}/gs;
}
my $depend = $ebuildvars{'DEPEND'} || '';
$depend =~ s/(\s+|\n+)/ /gs;
return $depend;
}
This works to do one-pass interpolation, but it doesn't get all the variables
(for example: VAR1="something $VAR2" VAR2="test $VAR3" VAR3="anything $VAR4"
would give me VAR1="something test $VAR3" VAR2="test $VAR3" VAR3="anything
$VAR4"). How can I make this work without actually calling bash?
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: dependency tree
Jeff 'japhy' Pinyan wrote:
On May 12, Andrew Gaffney said:
my %tree = { package1 => [ package2, package3, package4 ],
package2 => [ package7 ],
package3 => [ package5 ],
package4 => [ package7, package6],
package5 => [ ],
package6 => [ ],
package7 => [ ] };
You have curly braces { ... } where you want parentheses ( ... ).
Whoops. I'm usually use hash references instead of actual hashes.
Now, I want to walk the tree starting with a known "package1" and build an
ordered list of packages to install. For example:
package7
package2
package5
package3
(no package7 here because it is already in the list)
package6
package4
package1
This sounds like postorder tree traversal to me:
I've seen that term before when looking into this, but I don't know what it means.
// pseudocode
postorder (tree) {
if tree is null: return
for node in tree.nodes: postorder(node)
print tree
}
With your hash, in perl, this would look like:
postorder(\%tree, 'package1');
sub postorder {
my ($tree, $pkg, $seen) = @_;
return if $seen->{$pkg}++; # to stop from traversing a node twice
postorder($tree, $_, $seen) for @{ $tree->{$pkg} };
print "$pkg\n";
}
This gives the expected output.
Is $seen another hash that should be passed as a reference to postorder() ?
I also want to be able to track what package is a dependency of what
(which key a certain value is under) with my tree structure. What is the
easiest way to do this? Is there a better way to do this?
You'd need another structure somewhere. Starting with this:
my %tree = (
package1 => [ qw( package2 package3 package4 ) ],
package2 => [ qw( package7 ) ],
package3 => [ qw( package5 ) ],
package4 => [ qw( package7 package6 ) ],
package5 => [ ],
package6 => [ ],
package7 => [ ],
);
You could then do:
my %parents_of;
for my $p (keys %tree) {
push @{ $parents_of{$_} }, $p for @{ $tree{$p} };
}
If you can't understand that code, let me unroll it a bit for you:
for my $parent (keys %tree) {
for my $kid (@{ $tree{$parent} }) {
push @{ $parents_of{$kid} }, $parent;
}
}
Now you have another hash of arrays that is basically the inverse of
%tree:
%parents_of = (
package4 => [ 'package1' ],
package5 => [ 'package3' ],
package6 => [ 'package4' ],
package7 => [ 'package4', 'package2' ],
package2 => [ 'package1' ],
package3 => [ 'package1' ],
);
Nice. Thank you. I'll give this a try.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
dependency tree
In a program I'm working on, I build a hash "tree" of sorts that contains
package dependencies. Each key contains an array with the first level
dependencies of the key. Each one of those dependencies have their own key with
their first level dependencies in the hash. For example:
my %tree = { package1 => [ package2, package3, package4 ],
package2 => [ package7 ],
package3 => [ package5 ],
package4 => [ package7, package6],
package5 => [ ],
package6 => [ ],
package7 => [ ] };
Now, I want to walk the tree starting with a known "package1" and build an
ordered list of packages to install. For example:
package7
package2
package5
package3
(no package7 here because it is already in the list)
package6
package4
package1
I also want to be able to track what package is a dependency of what (which key
a certain value is under) with my tree structure. What is the easiest way to do
this? Is there a better way to do this?
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: return array/hash ref from function
Andrew Gaffney wrote: Wiggins d Anconia wrote: Wiggins d Anconia wrote: my %masks; my %use; my @pkglist; my %pkgdeps; Why are these declared with a global scope? If they must be then something is wrong with your subs. Move these to after your sub listing, if your program still works then they are fine as globals, otherwise you have broken encapsulation and that leads to more complex code. It also means you are not letting 'strict' help you in the manner it was designed to. Nope, I need %masks, %use, and %pkgdeps to be global because multiple subroutines will need access to them. And that is the exact reason not to do it. The code is becoming spaghetti code because of this very reason, and generally indicates a design issue. Step back and take a look at your data, then come up with the routines (aka this is where OOP comes in). If you allow your subs to break encapsulation like this then tracking down the kind of bug you mention gets progressively more difficult, and becomes a maintenance nightmare in the future, as well as a testing nightmare. It also may mean you will get less help from the list ;-), which is why we stress 'strict' so much, otherwise it becomes a risk to soak up our time as well as your own. How could I redesign it that these global configuration values are accessible to the functions that need them but aren't actually global? [snip subs] init(); my $original = build_deptree($ARGV[0]); use Data::Dumper; print Dumper(%pkgdeps); Based on this snippet you should have need for only one global, $original. Everything else should be lexical non-file scoped. Remember that subs should take values and return values, your init() does neither which means its contents can be moved into main, or into build_deptree, or you need to be passing it something. This program is far from complete. There will be many more functions that will need access to those global variables. I put those configuration subroutine calls into init() because it cleans up the main code a bit. See above, I know that, but that doesn't mean it is the best way :-). Try moving all of your subs into a library and keeping your main separate, use 'strict' in both files, make every variable 'my'd, when that works I suspect your problems will be solved. This still holds. I'll have to figure out how to redesign the configuration variables before I can do this. Well, no need for the moment. After uncommenting 'use warnings' and going through the output and fixing each warning, it works. I changed way too many things to say which one in particular worked. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: return array/hash ref from function
Wiggins d Anconia wrote: Wiggins d Anconia wrote: my %masks; my %use; my @pkglist; my %pkgdeps; Why are these declared with a global scope? If they must be then something is wrong with your subs. Move these to after your sub listing, if your program still works then they are fine as globals, otherwise you have broken encapsulation and that leads to more complex code. It also means you are not letting 'strict' help you in the manner it was designed to. Nope, I need %masks, %use, and %pkgdeps to be global because multiple subroutines will need access to them. And that is the exact reason not to do it. The code is becoming spaghetti code because of this very reason, and generally indicates a design issue. Step back and take a look at your data, then come up with the routines (aka this is where OOP comes in). If you allow your subs to break encapsulation like this then tracking down the kind of bug you mention gets progressively more difficult, and becomes a maintenance nightmare in the future, as well as a testing nightmare. It also may mean you will get less help from the list ;-), which is why we stress 'strict' so much, otherwise it becomes a risk to soak up our time as well as your own. How could I redesign it that these global configuration values are accessible to the functions that need them but aren't actually global? [snip subs] init(); my $original = build_deptree($ARGV[0]); use Data::Dumper; print Dumper(%pkgdeps); Based on this snippet you should have need for only one global, $original. Everything else should be lexical non-file scoped. Remember that subs should take values and return values, your init() does neither which means its contents can be moved into main, or into build_deptree, or you need to be passing it something. This program is far from complete. There will be many more functions that will need access to those global variables. I put those configuration subroutine calls into init() because it cleans up the main code a bit. See above, I know that, but that doesn't mean it is the best way :-). Try moving all of your subs into a library and keeping your main separate, use 'strict' in both files, make every variable 'my'd, when that works I suspect your problems will be solved. This still holds. I'll have to figure out how to redesign the configuration variables before I can do this. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: return array/hash ref from function
Wiggins d Anconia wrote:
Charles K. Clarkson wrote:
Andrew Gaffney <[EMAIL PROTECTED]> wrote:
:
: I think that 'my' is bad because I have something similar to:
:
: my %tree;
:
: sub return_an_arrayref() {
:my @array = ('thing1', 'thing2', 'thing3');
:return [EMAIL PROTECTED];
: }
:
: sub build_tree() {
:foreach(@thing) {
: $tree{$_} = return_an_arrayref();
:}
: }
:
: use Data::Dumper;
: print Dumper(%tree);
:
: The output shows a bunch of empty arrays or arrays with
: all undef elements under each key in %tree. I know
: return_an_arrayref() is returning data because I can
: print all the elements out in build_tree().
Remember Finagle's Third Law:
"In any collection of data, the figure most obviously
correct, beyond all need of checking, is the mistake."
Your results indicate that return_an_arrayref() does
sometimes return a reference to an empty array. Show us
unedited code for more help.
Alright, you asked for it. In order to run this program, you will need
to be
running Gentoo Linux as this program uses the Portage tree and
Portage's config
files.
Ok, slow down killer :-).
#!/usr/bin/perl
use strict;
#use warnings;
#use Getopt::Long;
my %masks;
my %use;
my @pkglist;
my %pkgdeps;
Why are these declared with a global scope? If they must be then
something is wrong with your subs. Move these to after your sub
listing, if your program still works then they are fine as globals,
otherwise you have broken encapsulation and that leads to more complex
code. It also means you are not letting 'strict' help you in the manner
it was designed to.
Nope, I need %masks, %use, and %pkgdeps to be global because multiple
subroutines will need access to them.
[snip subs]
init();
my $original = build_deptree($ARGV[0]);
use Data::Dumper;
print Dumper(%pkgdeps);
Based on this snippet you should have need for only one global,
$original. Everything else should be lexical non-file scoped. Remember
that subs should take values and return values, your init() does neither
which means its contents can be moved into main, or into build_deptree,
or you need to be passing it something.
This program is far from complete. There will be many more functions that will
need access to those global variables. I put those configuration subroutine
calls into init() because it cleans up the main code a bit.
Try moving all of your subs into a library and keeping your main
separate, use 'strict' in both files, make every variable 'my'd, when
that works I suspect your problems will be solved.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: return array/hash ref from function
Wiggins d Anconia wrote:
Wiggins d Anconia wrote:
I have a number of functions in a program I'm writing that return a
reference to
an array or hash. In the functions, I declare the variable to return
with 'my'
which I'm finding out is bad. Should I declare variables to return
from a
function with 'our'? Do I need to make sure I don't have conflicting
variable
names from other functions? What pitfalls do I need to know about when
doing this?
Need to address why you think creating them with 'my' is bad when
returning them first, it isn't (as long as you are truly returning
them). Use 'my' until you know you don't :-).
See if this helps:
http://perl.plover.com/FAQs/Namespaces.html
It is *well* worth the read...
I think that 'my' is bad because I have something similar to:
my %tree;
sub return_an_arrayref() {
my @array = ('thing1', 'thing2', 'thing3');
return [EMAIL PROTECTED];
}
sub build_tree() {
foreach(@thing) {
$tree{$_} = return_an_arrayref();
}
}
use Data::Dumper;
print Dumper(%tree);
The output shows a bunch of empty arrays or arrays with all undef
elements under
each key in %tree. I know return_an_arrayref() is returning data
because I can
print all the elements out in build_tree().
Ah, turn on strict and warnings. See if that helps, if not come back
:-). This is why these two pragma are so critical.
For me your code will not run.
It was more pseudocode than anything. I can't seem to duplicate the problem with
test code. One thing I forgot to mention is that these functions are called
recursively as far as 15 levels deep. Would that cause issues when returning a
ref to a 'my'ed array from a function?
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: return array/hash ref from function
Charles K. Clarkson wrote:
Andrew Gaffney <[EMAIL PROTECTED]> wrote:
:
: I think that 'my' is bad because I have something similar to:
:
: my %tree;
:
: sub return_an_arrayref() {
:my @array = ('thing1', 'thing2', 'thing3');
:return [EMAIL PROTECTED];
: }
:
: sub build_tree() {
:foreach(@thing) {
: $tree{$_} = return_an_arrayref();
:}
: }
:
: use Data::Dumper;
: print Dumper(%tree);
:
: The output shows a bunch of empty arrays or arrays with
: all undef elements under each key in %tree. I know
: return_an_arrayref() is returning data because I can
: print all the elements out in build_tree().
Remember Finagle's Third Law:
"In any collection of data, the figure most obviously
correct, beyond all need of checking, is the mistake."
Your results indicate that return_an_arrayref() does
sometimes return a reference to an empty array. Show us
unedited code for more help.
Alright, you asked for it. In order to run this program, you will need to be
running Gentoo Linux as this program uses the Portage tree and Portage's config
files.
#!/usr/bin/perl
use strict;
#use warnings;
#use Getopt::Long;
my %masks;
my %use;
my @pkglist;
my %pkgdeps;
sub get_masks {
my @maskfiles = ("/usr/portage/profiles/package.mask",
"/etc/portage/package.mask");
foreach my $maskfile (@maskfiles) {
open MASKS, "< $maskfile" or next;
while() {
chomp;
next if($_ eq '' || /^#/);
my $list = expand_package_list($_, 1);
foreach my $pkg (@$list) {
$masks{$pkg} = 1;
}
}
close MASKS;
}
}
sub get_unmasks {
my @maskfiles = ("/etc/portage/package.unmask");
foreach my $maskfile (@maskfiles) {
open UNMASKS, "< $maskfile" or next;
while() {
chomp;
next if($_ eq '' || /^#/);
my $list = expand_package_list($_, 1);
foreach my $pkg (@$list) {
delete $masks{$pkg} if(exists $masks{$pkg});
}
}
close UNMASKS;
}
}
sub process_use_flags {
my $useflags = shift;
$useflags =~ s/(\\|\n)/ /sg;
$useflags =~ s/\s+/ /g;
my @useflags = split /\s+/, $useflags;
foreach(@useflags) {
if($_ eq '-*') {
foreach(keys %use) {
delete $use{$_};
}
} elsif(/^-(.+)$/) {
delete $use{$1} if(exists $use{$1});
} else {
$use{$_} = 1;
}
}
}
sub get_make_config {
my @makeconfs = ("/etc/make.profile/make.defaults", "/etc/make.conf");
my $makecontents;
foreach my $makeconf (@makeconfs) {
open MAKECONF, "< $makeconf" or next;
while() {
$makecontents .= $_;
}
close MAKECONF;
$makecontents =~ /\s+USE=\"(.+?)\"{1}?/s;
my $useflags = $1;
process_use_flags($useflags);
}
}
sub get_env_config {
my $useflags = $ENV{USE};
process_use_flags($useflags) if($useflags ne '');
}
sub enable_autouse {
open USE, "< /etc/make.profile/use.defaults" or die "Can't open use.defaults\n";
foreach() {
next if(/^(#.+)?$/);
/^(.+)\s+(.+)$/;
foreach(split /\s+/, $2) {
my ($useflag, $pkgname) = ($1, $2);
process_use_flags($useflag) if(check_package_installed($pkgname));
}
}
}
sub init {
get_masks();
get_unmasks();
get_make_config();
get_env_config();
enable_autouse();
print join(', ', sort keys %use) . "\n";
}
sub get_depend {
my $ebuildfname = shift;
my $ebuildcontents;
my %ebuildvars;
my $pkgname = $ebuildfname;
$pkgname =~ s|/usr/portage/||;
$pkgname =~ s|(.+)/.+/(.+).ebuild|$1/$2|;
my $pkg = parse_package_name($pkgname);
$pkg->{version} =~ s/^-//;
$ebuildvars{PV} = "$pkg->{version}";
open EBUILD, "< $ebuildfname" or die "Couldn't open '$ebuildfname' to get
DEPEND\n";
while() {
$ebuildcontents .= $_;
}
close EBUILD;
while($ebuildcontents =~ /\b([-A-Z0-9_]+)=\"(.*?)\"{1}?/sgc) {
$ebuildvars{$1} = $2;
}
foreach(keys %ebuildvars) {
$ebuildvars{$_} =~ s/\$\{?([-A-Z0-9_]+)\}?/$ebuildvars{$1}/gs;
}
my $depend = $ebuildvars{'DEPEND'};
$depend =~ s/(\s+|\n+)/ /gs;
return $depend;
}
sub check_package_installed {
my $pkgname = shift;
my $pkg = parse_package_name($pkgname);
if($pkg->{version} eq '') {
opendir PKGDIR, "/var/db/pkg/$pkg->{category}" or die "Can't open directory
'/var/db/pkg/$pkg->{category}'\n";
my @pkgs = grep { /^$pkg->{name}-/ } readdir(PKGDIR);
close PKGDIR;
push @pkgs, '';
return 1 if($#pkgs);
} else {
my $pkgdir =
"/var/db/pkg/$pkg->{category}/$pkg->{name}$pkg->{version}$pkg->{suffix}$pkg->{revision}";
return 1 if(-d $pkgdir);
}
return 0;
}
sub expand_depend {
my $depstring = shift;
my @depl
Re: return array/hash ref from function
Wiggins d Anconia wrote:
I have a number of functions in a program I'm writing that return a
reference to
an array or hash. In the functions, I declare the variable to return
with 'my'
which I'm finding out is bad. Should I declare variables to return from a
function with 'our'? Do I need to make sure I don't have conflicting
variable
names from other functions? What pitfalls do I need to know about when
doing this?
Need to address why you think creating them with 'my' is bad when
returning them first, it isn't (as long as you are truly returning
them). Use 'my' until you know you don't :-).
See if this helps:
http://perl.plover.com/FAQs/Namespaces.html
It is *well* worth the read...
I think that 'my' is bad because I have something similar to:
my %tree;
sub return_an_arrayref() {
my @array = ('thing1', 'thing2', 'thing3');
return [EMAIL PROTECTED];
}
sub build_tree() {
foreach(@thing) {
$tree{$_} = return_an_arrayref();
}
}
use Data::Dumper;
print Dumper(%tree);
The output shows a bunch of empty arrays or arrays with all undef elements under
each key in %tree. I know return_an_arrayref() is returning data because I can
print all the elements out in build_tree().
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
return array/hash ref from function
I have a number of functions in a program I'm writing that return a reference to an array or hash. In the functions, I declare the variable to return with 'my' which I'm finding out is bad. Should I declare variables to return from a function with 'our'? Do I need to make sure I don't have conflicting variable names from other functions? What pitfalls do I need to know about when doing this? -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
building a dependency tree
I am writing a Perl version of Gentoo Linux's Portage package management tool just for the heck of it (and I think I can do it better (yes, I am full of myself ;) )). I already have a good portion of the program done except for the main part: building the dependency tree. My program can currently: * read Portage's configuration files and environment variables * parse an ebuild (file that describes the way a package is built and installed) to get the dependency information * parse the dependency string taking into account USE flags (determine which optional components get built for certain packages) * take a dependency string such as 'x11-base/xfree', '>=net-fs/samba-2.3', etc. and return a list of candidate versions in the Portage tree (directory structure containing ~80,000 ebuilds taking into account masked packages * determine the highest version of a particular package from a list of available package versions * determine if a certain version of a certain package is already installed I plan on writing a function that will get the dependency information for a certain package, check the dependencies for those dependencies, and so on down the line. I'd have a structure like: mainpackage-1.0 |--dependency1-1.3 | ---dep1_of_dep1 |--dependency2-2.3 | ---dep1_of_dep2 | ---dep2_of_dep2 | ---dep3_of_dep2 |--dependency3 where each dependency is a string in the form of 'x11-base/xfree', '>=net-fs/samba-2.3', etc. What I can't figure out is how to take that structure and turn it into a list that looks something like: dep1_of_dep1 dependency1-1.3 dep1_of_dep2 dep2_of_dep2 dep3_of_dep2 dependency2-2.3 dependency3 mainpackage-1.0 Generating the above would be pretty simple, but it isn't so simple to take into account packages that have dependencies on different version ranges than another package (one package having '>somepackage-3.4' and another ' -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: simple include
Wiggins d'Anconia wrote: Please bottom post J Adam Latham wrote: Try removing "my" from all the variables in your module ... You're privatizing them to your module thereby excluding them from your external program ... At least that's my guess! :^) Hopefully you could at least suggest to 'our' them instead of 'my', so that 'strict' checking can remain in play, as it should remain in play perldoc -f our In general this is where drieux would interject his ramblings about how you have reached a point where you probably want to brew your own module (check the list archives for such rantings which are usually very informative), which is simple enough to do. I would suggest reading up on creating your own module, perldoc perlmod perldoc perlmodlib perldoc -f package perldoc -f use perldoc Exporter Essentially you create a separate file, a .pm, throw a package statement in there, make it an Exporter if you so desire, 'our' a few variables, then in your scripts you simply 'use' it. Back in business when you get stuck ask more questions. I figured that would be the answer. I've created custom modules before. I was just being lazy and didn't want to create a module and place it in one of the @INC directories ;) -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: Removing characters from a string
[EMAIL PROTECTED] wrote: How would I remove any and "only" single characters from a string? $_ = "This is a character d g string test"; I want this to read "This is character string test." Off the top of my head...untested: $string =~ s/ \w\b//g; -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
simple include
I'm working on a small Perl-based webapp. I want to create a small include file that all
scripts will use. It looks like:
use CGI;
use DBI();
my $cgi = new CGI;
my $dbh = DBI->connect("DBI:mysql:database=somedb;host=127.0.0.1", "user", "pass");
my $p = $cgi->Vars;
my $uid = $cgi->cookie('uid');
if($uid eq '') {
print $cgi->header;
print "location.replace('/cgi-bin/login.pl');";
}
1;
In my scripts, I do 'require "./common.pl";' but I get errors when I try to use the
variable defined in common.pl. Am I doing something wrong? Am I going about this
completely the wrong way?
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Kismet::Client
I'm looking at using the Kismet::Client module to create my own Kismet client that collects and displays the data I want. I've been looking through its documentation at http://search.cpan.org/~kaysb/Kismet-Client-0.03/Client.pm but it isn't very helpful. Do they just interface with a Kismet C library? If so, where is the documentation for this library? If not, is there more detailed documentation for this module? -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: Not Exactly Perl prob but!
Ryan Thomas wrote: Hello All A friend is coming to the states next week and has asked me to set up her laptop with a dial up account so she can get her webmail. Can anyone recommend a free dialup service in USA ? You're right. That isn't related to Perl. You could have atleast said it was so she could download Perl or something ;) I've never dealt with them, but they got a good review by my local LUG: https://www.access-4-free.com/rates.htm -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: using Hash::Case and Storable
Wiggins d Anconia wrote:
Wiggins d Anconia wrote:
[snip]
my $thawed = retrieve('somefile');
tie my(%realhash), 'Hash::Case::Lower', $thawed;
Ah, I guess I'd missed that part in the docs for the Hash::Case::Lower
module. Is it safe
to 'delete $thawed' after I tie the hash so I don't have an extra copy
of the hash
floating around?
Try and see. A look at the source suggests there isn't a problem doing
it, if there is I would think it is an implementation bug. I assume by
"delete" you mean allow the variable to go out of scope or otherwise get
garbage collected, as opposed to 'delete' as in -f.
Correct.
You may also want to consider that nested hashes (if my understanding
and glance at the code are correct) are not necessarily lower case.
This might be either a suggested improvement, or even a new subclass of
Tie::Hash, aka Tie::Hash::LowerDeep or similar, essentially you would
end up with a nested call to tieing any internal hash refs.
I'd realized that. I don't need the nested hashes to be lower case, so it is not an issue.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: using Hash::Case and Storable
Wiggins d Anconia wrote:
I'm using the Storable module to save and load a hash tree. I also
want to use the
Hash::Case::Lower module to make my hash case insensitive. I can't
figure out how to tie a
hashref to the Hash::Case::Lower module and load data into it with
Storable. I tried
something like:
use Hash::Case::Lower;
use Storable;
tie my(%realhash), 'Hash::Case::Lower';
my $hashref = \%realhash;
$hashref = retrieve('somefile');
This causes $hashref to be assigned to the anonymous hash returned
from retrieve() so that
it no longer points to the tied hash. It is then no longer case
insensitive. How can I
make this work?
You need to tie your hash after retrieving the values. Or provide the
values as part of the tie invocation. I haven't worked with Hash::Case
before, but it looks from the docs that you can provide your retrieved
hashref as the 'VALUES'. For instance,
my $thawed = retrieve('somefile');
tie my(%realhash), 'Hash::Case::Lower', $thawed;
Ah, I guess I'd missed that part in the docs for the Hash::Case::Lower module. Is it safe
to 'delete $thawed' after I tie the hash so I don't have an extra copy of the hash
floating around?
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
parsing written language
Is there a module out there that could aid me in parsing written English? I've searched CPAN, but I didn't find anything that seemed to be relevant. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
using Hash::Case and Storable
I'm using the Storable module to save and load a hash tree. I also want to use the
Hash::Case::Lower module to make my hash case insensitive. I can't figure out how to tie a
hashref to the Hash::Case::Lower module and load data into it with Storable. I tried
something like:
use Hash::Case::Lower;
use Storable;
tie my(%realhash), 'Hash::Case::Lower';
my $hashref = \%realhash;
$hashref = retrieve('somefile');
This causes $hashref to be assigned to the anonymous hash returned from retrieve() so that
it no longer points to the tied hash. It is then no longer case insensitive. How can I
make this work?
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: using string as hashref
James Edward Gray II wrote:
On Apr 25, 2004, at 1:40 PM, Andrew Gaffney wrote:
James Edward Gray II wrote:
On Apr 25, 2004, at 12:56 PM, Andrew Gaffney wrote:
I'm writing a program that uses a hashref tree to store data. I'm
just playing around with this, so it's nothing critical. I remember
reading that you could use a string to specify a variable name or
something similar. I have the following string value:
my $node = "$data->{computer}->{test}->{item1}->{text}";
This wouldn't be using a string for a variable name, it would be
using a string to hold a variable name, some keys and a little syntax
or using a sting to hold some Perl code.
You could always eval() it to get the answer, but I seriously doubt
that's called for, by what I understood of the problem description.
eval() does work for this. I never thought of that. Is there another
way, though?
More simply, you could get the answer by removing the quotes in the
line.
That is only an example. In the finished program, that string will be
put together dynamically from user input.
I'm with you now. See if this program gives you the needed ideas:
#!/usr/bin/perl
use strict;
use warnings;
my $data = {computer => {test => {item1 => {text =>
"computer.test.item1";
print fetch(qw(computer test item1 text)), "\n";
sub fetch {
my @keys = @_;
my $node = $data;
while (my $key = shift @keys) {
if (exists $node->{$key}) { $node = $node->{$key}; }
else { return; }
}
return $node;
}
__END__
Hope that helps.
But is that faster than using eval()?
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: using string as hashref
James Edward Gray II wrote:
On Apr 25, 2004, at 12:56 PM, Andrew Gaffney wrote:
I'm writing a program that uses a hashref tree to store data. I'm just
playing around with this, so it's nothing critical. I remember reading
that you could use a string to specify a variable name or something
similar. I have the following string value:
my $node = "$data->{computer}->{test}->{item1}->{text}";
This wouldn't be using a string for a variable name, it would be using a
string to hold a variable name, some keys and a little syntax or using a
sting to hold some Perl code.
You could always eval() it to get the answer, but I seriously doubt
that's called for, by what I understood of the problem description.
eval() does work for this. I never thought of that. Is there another way, though?
More simply, you could get the answer by removing the quotes in the line.
That is only an example. In the finished program, that string will be put together
dynamically from user input.
Hash keys are already strings, that's why we use them when we need this
kind of functionality. It's much preferred over soft references
(strings as variable names). You gather all the keys you need for the
above and walk the tree to get the answer, right?
Perhaps I didn't understand the problem well. Try telling us again what
you are trying to do, please.
which corresponds to the the hash tree:
my $data = {computer => {test => {item1 => {text =>
"computer.test.item1";
How can I get it to print "computer.test.item1" (from hash tree above)
instead of just the bare string contents of $node?
print $data->{computer}{test}{item1}{text}, "\n";
Again, I don't think I understood the problem well. Try us again...
The node location in the hash tree is generated dynamically. I can't hardcode it in as above.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
using string as hashref
I'm writing a program that uses a hashref tree to store data. I'm just playing around with
this, so it's nothing critical. I remember reading that you could use a string to specify
a variable name or something similar. I have the following string value:
my $node = "$data->{computer}->{test}->{item1}->{text}";
which corresponds to the the hash tree:
my $data = {computer => {test => {item1 => {text => "computer.test.item1";
How can I get it to print "computer.test.item1" (from hash tree above) instead of just the
bare string contents of $node?
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: getting array index inside for loop
JupiterHost.Net wrote:
Andrew Gaffney wrote:
Charles K. Clarkson wrote:
Andrew Gaffney <[EMAIL PROTECTED]> wrote:
: : I have code that uses a 'foreach(@array) {}' to loop
: through an array. I now need to be able to get the
: array index inside of that. I know I could switch to
: a 'for($loopvar=0;$loopvar<@array;$loopvar++) {}' to
: do that, but I'd have to change some other code also.
: If not that way, is there a way to get the array
: index inside of a loop like 'for(0..$#array) {}'?
You could count the index:
{
my $index = 0;
foreach my $value ( @array ) {
.
.
.
$index++;
}
}
The outer braces keep $index to a smaller scope.
BTW, $value above is an alias. If you are needing the
index to change the current value in @array you can do
it by changing $value.
I figured that's what it would probably come down to. I don't need the
index for something in the array I'm working with but to access a
related array with related data at the same indexes.
Would hashes be usefull for you there?
Nope, I need the data in the 2nd array to come out in the same order as it went in.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: getting array index inside for loop
Charles K. Clarkson wrote:
Andrew Gaffney <[EMAIL PROTECTED]> wrote:
:
: I have code that uses a 'foreach(@array) {}' to loop
: through an array. I now need to be able to get the
: array index inside of that. I know I could switch to
: a 'for($loopvar=0;$loopvar<@array;$loopvar++) {}' to
: do that, but I'd have to change some other code also.
: If not that way, is there a way to get the array
: index inside of a loop like 'for(0..$#array) {}'?
You could count the index:
{
my $index = 0;
foreach my $value ( @array ) {
.
.
.
$index++;
}
}
The outer braces keep $index to a smaller scope.
BTW, $value above is an alias. If you are needing the
index to change the current value in @array you can do
it by changing $value.
I figured that's what it would probably come down to. I don't need the index for something
in the array I'm working with but to access a related array with related data at the same
indexes.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
getting array index inside for loop
I have code that uses a 'foreach(@array) {}' to loop through an array. I now need to be
able to get the array index inside of that. I know I could switch to a
'for($loopvar=0;$loopvar<@array;$loopvar++) {}' to do that, but I'd have to change some
other code also. If not that way, is there a way to get the array index inside of a loop
like 'for(0..$#array) {}'?
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: parsing Apache2 access log
Andrew Gaffney wrote:
I maintain the Perl CGI/mod_perl side of a website, and someone else
maintains the static HTML side. Well, the htdocs dir has gotten very
messy. Because of things I've done with CGI/mod_perl/Mason, there are
many static pages that are no longer used.
I want to write a Perl script that will parse the Apache access log and
keep track of the most recent access of each file referenced. I then
want to compare this list to the contents of the htdocs directory. If a
file exists in htdocs that was not referenced in the Apache access log
after a certain cutoff date (or not referenced at all), I want to print
the filename.
In effect, this will generate a list of "safe to delete" files which I
will then inspect by hand before deleting. Is there already something
like this out there or has anyone else done something like this? If not,
is there a module that will help me parse the Apache access log?
I whipped up the following program myself that mostly does what I want. It still has a few
problems. For example, it will display directories that are in /var/www/htdocs unless
someone had specifically requested that directory without a trailing slash. It is also
slow. It takes about 5 minutes to run this on a 200MB access_log. I realize I shouldn't be
complaining about that, but the machine is a dual Athlon MP 2200+ w/ 1GB RAM.
#!/usr/bin/perl
use strict;
use warnings;
use CGI();
my %files;
open LOG, "< /var/log/apache/access_log";
while() {
my $line = $_;
$line =~ /^(\d+\.\d+\.\d+\.\d+) (.+) (.+) \[(.+)\] \"(.+) (.+) (.+)\" (\d+) (\d+)
\"(.+)\" \"(.+)\"$/;
my ($ip, $date, $request, $requestcode, $bytesreturned, $browser) = ($1, $4, $6, $8,
$9, $11);
next if($request =~ m|^/cgi-bin/|);
$request =~ s/^\/(.+)\??/$1/;
# $date =~ m|^(\d+)/(.+)/(\d+):|;
$request = CGI::unescape($request);
$files{$request} = 1;
}
close LOG;
opendir HTDOCS, "/var/www/htdocs";
my @htdocsfiles = readdir HTDOCS;
my @newhtdocsfiles;
foreach my $htdocsfile (@htdocsfiles) {
unless(exists $files{$htdocsfile}) {
push @newhtdocsfiles, $htdocsfile;
}
}
foreach(@newhtdocsfiles) {
print "$_\n";
}
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
parsing Apache2 access log
I maintain the Perl CGI/mod_perl side of a website, and someone else maintains the static HTML side. Well, the htdocs dir has gotten very messy. Because of things I've done with CGI/mod_perl/Mason, there are many static pages that are no longer used. I want to write a Perl script that will parse the Apache access log and keep track of the most recent access of each file referenced. I then want to compare this list to the contents of the htdocs directory. If a file exists in htdocs that was not referenced in the Apache access log after a certain cutoff date (or not referenced at all), I want to print the filename. In effect, this will generate a list of "safe to delete" files which I will then inspect by hand before deleting. Is there already something like this out there or has anyone else done something like this? If not, is there a module that will help me parse the Apache access log? -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: determining size of array through reference
david wrote:
Andrew Gaffney wrote:
I've got an array reference and I'm trying to figure out how many elements
are in it. I've tried '$#arrayref', '[EMAIL PROTECTED]', '$(@($arrayref))', and
probably a few others that I've forgotten. What is the correct way to do
this?
you can try @{EXP} or $#{EXP}+1 where EXP is your array reference:
[panda]# perl -le 'print $#{[1,3,5,7]}+1'
4
[panda]# perl -le 'print @{[1,3,5,7]}+0'
4
[panda]#
the '{}' is sometimes optional depends on EXP, i usually use it for personal
perference.
'$#{$arrayref}+1' worked for me. Thanks. Once again, I don't know what I'd do without the
people on this list.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
determining size of array through reference
I've got an array reference and I'm trying to figure out how many elements are in it. I've tried '$#arrayref', '[EMAIL PROTECTED]', '$(@($arrayref))', and probably a few others that I've forgotten. What is the correct way to do this? -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: determining reference type
WC -Sx- Jones wrote:
Andrew Gaffney wrote:
How do you determine what type of data a reference points to? I have a
function (one in previous post) that can take either an array of
scalars or an array of hash references. I want to execute different
code based on which one it was. How can I do that?
use the ref() function -
perldoc -f ref
sub marshall {
my($thing) = @_;
$type = ref($thing);
if ($type eq "ARRAY") {
return(encode_list($thing));
}
elsif ($type eq "HASH") {
return(encode_hash($thing));
}
elsif (!$type) {
return(encode_scalar($thing));
}
else { die("Can't handle $type\n"); }
}
http://www.usenix.org/publications/perl/perl12.html
That did the trick. Thanks.
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
determining reference type
How do you determine what type of data a reference points to? I have a function (one in previous post) that can take either an array of scalars or an array of hash references. I want to execute different code based on which one it was. How can I do that? -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
need help modifying code
I have written the following code to generate HTML reports from Perl scripts. It works
pretty well. I need to modify it to accept parameters for each column (e.g. column width,
whether to total that column, etc.), but I can't figure out the best way to go about it.
sub generate_report_html {
my ($title, $columns, $data) = @_;
print <<" EOF";
${title} Report
EOF
foreach (@$columns) {
print "$_";
}
print "\n";
foreach my $row (@$data) {
print "";
foreach (@$row) {
print "$_";
}
print "\n";
}
print <<' EOF';
EOF
}
The code is called like:
my $columns = ["Col1", "Col2", "Col3", "Col4"];
my @data;
while(...) {
# Get data somehow
push @data, ["$data1", "$data2", "$data3", "$data4"];
}
generate_report_html("report title", $columns, [EMAIL PROTECTED]);
I want to be able to call it like:
my $columns = [{width => 150, text => 'Col1', total => 0},
{width => 100, text => 'Col2', total => 1},
{width => 200, text => 'Col3', total => 1},
{width => 100, text => 'Col4', total => 0}];
my @data;
while(...) {
# Get data somehow
push @data, ["$data1", "$data2", "$data3", "$data4"];
}
generate_report_html("report title", $columns, [EMAIL PROTECTED]);
Can anyone offer any suggestions?
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: determing number of records returned with DBI
Guay Jean-Sébastien wrote: Hello Andrew, Is there a way to find out how many records were returned with a DBI query? There's the obvious counting each record as you fetch it, but I need the count before I start going through them. I was looking through the DBI documentation (perldoc DBI) not long ago and this caught my eye... It's in the "Statement Handle Methods" section. Just proof that sometimes the info is there, but it's hard to find or buried in a very big man page (which certainly is the case for the DBI man page...). < snip > rows $rv = $sth->rows; Returns the number of rows affected by the last row affecting command, or -1 if the number of rows is not known or not available. Generally, you can only rely on a row count after a non-SELECT execute (for some specific operations like UPDATE and DELETE), or after fetching all the rows of a SELECT statement. With the mysql driver, it does return the number of fetched rows before you start iterating through them. It does what I need it to do. Thanks. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
determing number of records returned with DBI
Is there a way to find out how many records were returned with a DBI query? There's the obvious counting each record as you fetch it, but I need the count before I start going through them. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: What is happening here
WC -Sx- Jones wrote:
What is happening here -
#! /usr/bin/perl
use strict;
use warnings;
my $count;
while(1) {
(++$count) ? $count += $count-- : $count += $count++;
print "$count\n"; exit if $count > 60_000;
sleep 1;
}
__END__
-Sx-
That is a damn good question. I'm not sure what results I was expecting when I ran it, but
it sure wasn't this:
3
15
63
255
1023
4095
16383
65535
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: date math
Chris Charley wrote:
"Andrew Gaffney" <[EMAIL PROTECTED]> wrote in message
news:[EMAIL PROTECTED]
R. Joseph Newton wrote:
Andrew Gaffney wrote:
[snip]
I didn't do it this way because there is a "first" pay period. If there
are only 2 pay
periods from the starting date, you can't build a list of 6. My way takes
that into
account. Below is the modified code based on (most of) your suggestions.
use constant PAY_PERIOD_DAYS => 14;
my @pay_periods;
my @final_pay_periods;
my $last_period_end = Date::Simple->new('2004-03-20');
my @lt = localtime;
my $today = Date::Simple->new($lt[5]+1900, $lt[4]+1, $lt[3]);
Here you could just say:
my $today = Date::Simple->new;
while($today > $last_period_end + 1) {
my $new_start = $last_period_end + 1;
my $new_end = $last_period_end + PAY_PERIOD_DAYS;
push @pay_periods, "$new_start to $new_end";
You can make the list ordered from most recent period to least recent
by saying:
unshift @pay_periods, "$new_start to $new_end";
$last_period_end = $new_end;
}
> my $period_counter = 0;
> foreach(reverse @pay_periods) {
>$period_counter++;
>last if($period_counter > 6);
>push @final_pay_periods, $_;
> }
Not necessary to do the above, but need this statement to
limit @pay_periods to most recent 6 periods (if there are 6)
splice @pay_periods, 6 if @pay_periods > 6;
All good suggestions. Thanks. My code is now:
use constant PAY_PERIOD_DAYS => 7; # Boss wanted it changed to 1 week from 2
my @pay_periods;
my $last_period_end = Date::Simple->new('2004-01-10');
my $today = Date::Simple->new;
while($today > $last_period_end + 1) {
my $new_start = $last_period_end + 1;
my $new_end = $last_period_end + PAY_PERIOD_DAYS;
unshift @pay_periods, "$new_start to $new_end";
$last_period_end = $new_end;
}
splice @pay_periods, 6 if @pay_periods > 6;
--
Andrew Gaffney
Network Administrator
Skyline Aeronautics, LLC.
636-357-1548
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
Re: Find User Apache is running as
JupiterHost.Net wrote: Hello List! I was trying to figure out how to see the user the script/webserver is running as. (Like Apache is 'nobody' or the owner 'foomonkey' perhaps with SuExec enabled) I looked in %ENV and didn't see it in there. Any ideas? If you're running Linux (might work on other UNIXs too), you can run 'ps aux | grep apache' (Apache 2.x) or 'ps aux | grep httpd' (Apache 1.x). The first column is the user it's running as. -- Andrew Gaffney Network Administrator Skyline Aeronautics, LLC. 636-357-1548 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
