Perl CGI - How can I delete contents of text fields? - perl

So, I am totally new with CGI programming in Perl.
The question is simple. Is there any chance to delete the content of a text field in CGI?
I must to write a code that have some popup_menu, submit button and text fields (area).
When I click on the submit button the program reads the value from one of the popup_menu.
The task is to copy this content into text field and then when I choose another element from the popup_menu (and click on the submit button of course), let the new content write into the text field replace the old one.
I think perldoc.perl.org gives only a little information about CGI programming. I'd have lot of questions in thema... :(
Any help would be approciate!

I guess, what you describe is: when you click the submit button, then your cgi script will run, given the parameters you entered in the form. What I then has to do is: write something back and print the form again - with different values.
So even if this is not the perfect way of doing such kind of things (for simple form element substitution you should do it client side and use javascript - you don't need a cgi backend script for this), let's see how a cgi script might look like.
First it's important to know, how you write your form. Let's assume you write it "the hard way" with print.
What your script has to do is parse the input and then add it as a value to the output.
use CGI;
my $q = CGI->new;
# get the value from the popup / html select
my $popup_value = $q->param('popup_menu'); # name of the <select name="..."> in your html
# ...
# writing the form
print $q->header;
# some more prints with form etc.
print textarea( -name => 'text_area',
-default => $popup_value // '', # will use empty string on first call
);
# Don't turn off autoescaping !
BTW, the value of a select option is meant to be a short indicator, not a full text (even this might be possible up to a certain amount of characters). So you might think of building a hash or an array with the appropriate values to be printed in the text area and give your select options the values 0, 1, 2 ...
my #text_values = ('', 'First text', 'second text', 'third text');
my $popup_value = $q->param('popup_menu') || 0; # default index.
# now use 1,2,3, ... as values in your popup_menu options
# ...
print textarea( -name => 'text_area',
-default => $text_values[$popup_value] );

Related

Using perl to split over multiple lines

I'm trying to write a perl script to process a log4net log file. The fields in the log file are separated by a semi-colon. My end goal is to capture each field and populate a mysql table.
Usually I have lines that look a little like this (all on a single line)
DEBUG;2017-06-13T03:56:38,316-05:00;2017-06-13 08:56:38,316;79ab0b95-7f58-
44a8-a2c6-1f8feba1d72d;(null);WorkerStartup 1;"Starting services."
These are easy to process. I can simply split by semicolon to get the information I need.
However occassionally the "message" field at the end may span several lines, especially if there is a stack trace. I would want to capture the entire message as a single column. I cannot use split by semicolon, because the next lines would typically look like:
at some.random.classname
at another.classname
...
Can someone give some tips how to solve this problem?
The following solution uses that the number of " in a field is even ($p=~y/"//%2), this condition number of " odd may be changed by other that can indicate the field is not complete.
The number of columns splitted is fixed to 7 (to allow ; in last field) and may be changed for example #array = map {s/;$//} $p=~/\G(?:"[^"]*"|[^;])*;/g;.
The file is read line by line but a line is processed sub process when it's complete $p variable to store the previous line the last line is processed in END block.
perl -ne '
sub process {
#array = split /;/,$p,7;
# do something with array
print ((join "\n---\n", #array),"\n");
}
if ($p=~y/"//%2) {
$p.=$_;
next;
}
process;
$p=$_;
END{process}
' < logfile.txt

Lexing/Parsing "here" documents

For those that are experts in lexing and parsing... I am attempting to write a series of programs in perl that would parse out IBM mainframe z/OS JCL for a variety of purposes, but am hitting a roadblock in methodology. I am mostly following the lexing/parsing ideology put forth in "Higher Order Perl" by Mark Jason Dominus, but there are some things that I can't quite figure out how to do.
JCL has what's called inline data, which is very similar to "here" documents. I am not quite sure how to lex these into tokens.
The layout for inline data is as follows:
//DDNAME DD *
this is the inline data
this is some more inline data
/*
...
Conventionally, the "*" after the "DD" signifies that following lines are the inline data itself, terminated by either "/*" or the next valid JCL record (starting with "//" in the first 2 columns).
More advanced, the inline data could appear as such:
//DDNAME DD *,DLM=ZZ
//THIS LOOKS LIKE JCL BUT IT'S ACTUALLY DATA
//MORE DATA MASQUERADING AS JCL
ZZ
...
Sometimes the inline data is itself JCL (perhaps to be pumped to a program or the internal reader, whatever).
But here's the rub. In JCL, the records are 80 bytes, fixed in length. Everything past column 72 (cols 73-80) is a "comment". As well, everything following a blank that follows valid JCL is likewise a comment. Since I am looking to manipulate JCL in my programs and spit it back out, I'd like to capture comments so that I can preserve them.
So, here's an example of inline comments in the case of inline data:
//DDNAME DD *,DLM=ZZ THIS IS A COMMENT COL73DAT
data
...
ZZ
...more JCL
I originally thought that I could have my top-most lexer pull in a line of JCL and immediately create a non-token for cols 1-72 and then a token (['COL73COMMENT',$1]) for the column 73 comment, if any. This would then pass downstream to the next iterator/tokenizer a string of the cols 1-72 text followed by the col73 token.
But how would I, downstream from there, grab the inline data? I'd originally figured that the top-most tokenizer could look for a "DD \*(,DLM=(\S*))" (or the like) and then just keep pulling records from the feeding iterator until it hit the delimiter or a valid JCL starter ("//").
But you may see the issue here... I can't have 2 topmost tokenizers... either the tokenizer that looks for COL73 comments must be the top or the tokenizer that gets inline data must be at the top.
I imagine that perl parsers have the same challenge, since seeing
<<DELIM
isn't necessarily the end of the line, followed by the here document data. After all, you could see perl like:
my $this=$obj->ingest(<<DELIM)->reformat();
inline here document data
more data
DELIM
How would the tokenizer/parser know to tokenize the ")->reformat();" and then still grab the following records as-is? In the case of the inline JCL data, those lines are passed as-is, cols 73-80 are NOT comments in that case...
So, any takers on this? I know there will be tons of questions clarifying my needs and I'm happy to clarify as much as is needed.
Thanks in advance for any help...
In this answer I will concentrate on heredocs, because the lessons can be easily transferred to the JCL.
Any language that supports heredocs is not context-free, and thus cannot be parsed with common techniques like recursive descent. We need a way to guide the lexer along more twisted paths, but in doing so, we can maintain the appearance of a context-free language. All we need is another stack.
For the parser, we treat introductions to heredocs <<END as string literals. But the lexer has to be extended to do the following:
When a heredoc introduction is encountered, it adds the terminator to the stack.
When a newline is encountered, the body of the heredoc is lexed, until the stack is empty. After that, normal parsing is resumed.
Take care to update the line number appropriately.
In a hand-written combined parser/lexer, this could be implemented like so:
use strict; use warnings; use 5.010;
my $s = <<'INPUT-END'; pos($s) = 0;
<<A <<B
body 1
A
body 2
B
<<C
body 3
C
INPUT-END
my #strs;
push #strs, parse_line() while pos($s) < length($s);
for my $i (0 .. $#strs) {
say "STRING $i:";
say $strs[$i];
}
sub parse_line {
my #strings;
my #heredocs;
$s =~ /\G\s+/gc;
# get the markers
while ($s =~ /\G<<(\w+)/gc) {
push #strings, '';
push #heredocs, [ \$strings[-1], $1 ];
$s =~ /\G[^\S\n]+/gc; # spaces that are no newlines
}
# lex the EOL
$s =~ /\G\n/gc or die "Newline expected";
# process the deferred heredocs:
while (my $heredoc = shift #heredocs) {
my ($placeholder, $marker) = #$heredoc;
$s =~ /\G(.*\n)$marker\n/sgc or die "Heredoc <<$marker expected";
$$placeholder = $1;
}
return #strings;
}
Output:
STRING 0:
body 1
STRING 1:
body 2
STRING 2:
body 3
The Marpa parser simplifies this a bit by allowing events to be triggered once a certain token is parsed. These are called pauses, because the built-in lexing pauses a moment for you to take over. Here is a high-level overview and a short blogpost describing this technique with the demo code on Github.
In case anyone was wondering how I decided to resolve this, here is what I did.
My main lexing routine accepts an iterator that pumps full lines of text (which can take it from a file, a string, whatever I want). The routine uses that to create another iterator, which examines the line for "comments" after column 72, which it will then return as a "mainline" token followed by a "col72" token. This iterator is then used to create yet another iterator, which passes the col72 tokens through unchanged, but takes the mainline tokens and lexes them into atomic tokens (things like STRING, NUMBER, COMMA, NEWLINE, etc).
But here's the crux... the lexing routine has the ORIGINAL ITERATOR still... so when it receives a token that indicates there is a "here" document, it continues processing tokens until it hits a NEWLINE token (meaning end of the actual line of text) and then uses the original iterator to pull off the here document data. Since that iterator feeds the atomic tokens iterator, pulling from it then prevents those lines from being atomized.
To illustrate, think of iterators like hoses. The first hose is the main iterator. To that I attach the col72 iterator hose, and to that I attach the atomic tokenizer hose. As streams of characters go in the first hose, atomized tokens come out the end of the third hose. But I can attach a 2-way nozzle to the first hose that will allow its output to come out the alternate nozzle, preventing that data from going into the second hose (and hence the third hose). When I'm done diverting the data through the alternate nozzle, I can turn that off and then data begins flowing through the second and third hoses again.
Easy-peasey.

How to display the value of a Perl variable in a tooltip

I've got a CGI perl script which processes a large Application Configuration file and displays extracted config data in table format.
One of the columns shows the hostname for a given server extracted from the config file.
What I'd like to do is have the alias name displayed (stored in $alias) when the user hovers over the hostname - much like a tooltip.
Each table row will have a different hostname and alias and I'm creating the table by iterating through an array.
I'm using the object-oriented approach to CGI Perl.
I tried the using the following:
print $cgi->start_td({class=>'primpeer',title=>'$aliasName'}),"$hostName";
but this just echoed the $aliasName in the tooltip rather than the contents of $aliasName
Put the value of your $alias into a title attribute (presumably of a td element). It will produce a tooltip for you like the alt attribute of an img element.
Variables inside single quote are not interpolled.
Just use double quote instead of single quote:
print $cgi->start_td({class=>'primpeer',title=>"$aliasName"}),"$hostName";
here __^ here __^
or without any quotes:
print $cgi->start_td({class=>'primpeer', title=>$aliasName}), $hostName;

Automating Lotus Notes Text Style with perl?

I'm trying to automate the sending of an email with an embedded attachment and some text that implements HTML code but it seems that the code that I am using will not allow me to create an HTML bolded text or a unordered list. To double check I created the code in vba then passed it through a vba to perl converter and it matched up with what I had written. Here is the part of my script that handles creating the text and embedded attachment in the email:
my $richStyle = $Document->NotesRichTextStyle();
$richStyle->{'PassThruHTML'} = 1;
my $Body = $Document->CreateRichTextItem('Body');
$Body->AppendText(">>EOT");
$Body->AppendStyle($richStyle);
**$Body->AppendText("<b>HELLO</b>");**
$Body->EmbedObject(EMBED_ATTACHMENT,'','$filename','$name');
I get this error:
Not a HASH reference at line $richStyle->{'PassThruHTML'} = 1;
The main point of this code was so that i could use HTML Tags inside the email
My best guess:
my $richStyle = $Document->NotesRichTextStyle();
From the designer help:
Set notesRichTextStyle = notesSession.CreateRichTextStyle( )
You need to create the notesRichTextStyle using the session.
I guess you want to create an HTML mail?
In that case, it would be better to use the MIME entity classes to generate native HTML mails and not to rely on the NotesRichText to HTML conversion.
You can find more info on the MIME entity in the Designer Help: http://publib.boulder.ibm.com/infocenter/domhelp/v8r0/index.jsp?topic=/com.ibm.designer.domino.main.doc/H_NOTESMIMEENTITY_CLASS_OVERVIEW.html
$ perl -Mdiagnostics -e " []->{1}=2 "
Not a HASH reference at -e line 1 (#1)
(F) Perl was trying to evaluate a reference to a hash value, but found a
reference to something else instead. You can use the ref() function to
find out what kind of ref it really was. See perlref.
Uncaught exception from user code:
Not a HASH reference at -e line 1.
at -e line 1
so whatever NotesRichTextStyle returns doesn't like ->{...} so maybe use ->SetProperty... or something else :/

Reading custom values in Ebay RSS feed (XML::RSS module)

I've spent entirely way too long trying to figure this out. I'm using XML: RSS and Perl to read / parse an Ebay RSS feed. Within the <item></item> area, I see these entries:
<rx:BuyItNowPrice xmlns:rx="urn:ebay:apis:eBLBaseComponents">1395</rx:BuyItNowPrice>
<rx:CurrentPrice xmlns:rx="urn:ebay:apis:eBLBaseComponents">1255</rx:CurrentPrice>
However, I can't figure out how to grab the details during the loop. I wrote a regex to grab them:
#current_price = $item =~ m/\<rx\:CurrentPrice.*\>(\d+)\<\/rx\:CurrentPrice\>/g;
Which works if you place the above 'CurrentPrice' entry into a standalone string, but not while the script is reading through the RSS feed.
I can grab most of the information I want out of the item->description area (# bids, auction end time, BIN price, thumbnail image, etc.), but it would be nicer if I could grab the info from the feed without me having to deal with grabbing all that information manually.
How to grab custom fields from an RSS feed (short of writing regexes to parse the entire feed w/o a module)?
Here's the code I'm working with:
$my_limit = 0;
use LWP::Simple;
use XML::RSS;
$rss = XML::RSS->new();
$data = get( $mylink );
$rss->parse( $data );
$channel = $rss->{channel};
$NumItems = 0;
foreach $item (#{$rss->{'items'}}) {
if($NumItems > $my_limit){
last;
}
#current_price = $item =~ m/\<rx\:CurrentPrice.*\>(\d+)\<\/rx\:CurrentPrice\>/g;
print "$current_price[0]";
}
If you have the rss/xml document and want specific data you could use XPATH:
Perl CPAN XPATH
XPath Introduction
What is the way in which "it doesn't work" from an RSS feed? Do you mean no matches when there should be matches? Or one match where there should be several matches?
One thing that jumps out at me about your regular expression is that you use .*, which can sometimes be greedier than you want. That is, if $item contained the expression
<rx:BuyItNowPrice xmlns:rx="urn:...nts">1395</rx:BuyItNowPrice>
<rx:CurrentPrice xmlns:rx="urn:...nts">1255</rx:CurrentPrice>
<rx:BuyItNowPrice xmlns:rx="urn:...nts">1395</rx:BuyItNowPrice>
<rx:SomeMoreStuff xmlns:rx="urn:...nts">zzz</rx:BuyItNowPrice>
<rx:CurrentPrice xmlns:rx="urn:...nts">1255</rx:CurrentPrice>
then the first part of your regular expression (\<rx\:CurrentPrice.*\>) will wind up matching everything on lines 2, 3, and 4, plus the first part of line 5 (up to the >). Instead, you might want to use the regular expression1
m/\<rx:CurrentPrice[^>]*>(\d+)\<\/rx:CurrentPrice\>/
which will only match up to the closing </rx:CurrentPrice> tag after a single instance of an opening <rx:CurrentPrice> tag.
1 The other obvious answer is that you really don't want to use a regular expression at all, that regular expressions are inferior tools for parsing XML compared to customized parsing modules, and that all the special cases you will have to deal with using regular expressions will eventually render you unconscious from having repeatedly beaten your head against your desk. See Salgar's answer, for example.