Sed command inside TCL script - sed

Help me understand the syntax sed.I removed single quotes, but the code still does not work.
set id [open file.txt]
# send the request, get a lot of data
set tok [::http::geturl "http://example.com"-channel $id]
# cut out the necessary data between two words
exec sed s/{"data1":\(.*\)/data2\1/ $id
close $id
set ir [open file.txt]
set phone [read $ir]
close $ir
puts $phone
The problem is that I get data from a query of the following kind
{"id":3876,"form":"index","time":21,"data":"2529423","service":"Atere","response":"WAIT"}
The brace is an element of the syntax of the language, and I need to cut exactly the value between the word and the brace. How to implement this in a script.

Your code is rather confused, as (a) you are passing a file handle to the sed command. That's not going to work. (b) you are passing an input channel to http rather than an output channel (try opening the file for writing).
About the underlying problem.
If you are receiving basic JSON data back as shown.
a) You can use a JSON parser: tcllib's json module
b) Convert it to a form that Tcl can parse as a dictionary
# Assuming the JSON data is in the $data variable, and there's no
# other data present. This also assumes the data is very basic
# there are no embedded commas. Many assumptions means this
# code is likely to break in the future. A JSON parser would
# be a better choice.
set data "\{"
append data {"id":3876,"form":"index","time":21,"data":"2529423","service":"Atere","response":"WAIT"}
append data "\}"
regsub -all {[{}:",]} $data { } data
set mydatadict $data
puts [dict get $mydatadict id]
Edit:
For http processing:
set tok [::http::geturl "http://example.com"]
set data [::http::data $tok]
::http::cleanup $tok

Related

tcl command for removing a word mutilple times

I want to convert .v file to .VHD ,so there are many lines of assign statements .want to delete all assign words. so is there any TCL command for that ,am using VIVADO 2018.2.
For example, I have this input text:
assign mem[0]=4b'0000;
assign mem[1]=4'b0001;
.................
assign mem[511]=4'b1010;
I want to delete all assign words at a time because to convert .V file to .VHDL
In this case, we are looking to specifically delete a word and not just the sequence of characters assign (because who knows where else that might come up?) The right tool for this is to use the regsub command so that we can specify that we want word boundaries to be matched:
set content [regsub -all {\yassign\y} $content ""]
The \y in there matches a word boundary. Just what we need! (Replacing with the empty string is an obvious way to delete things.)
To turn this into a full conversion, we need to add in the code to read in the file and write it back out again.
set filename_in "something.V"
set filename_out "something.vhdl"
# Standard pattern for reading a whole file
set f [open $filename_in]
set content [read $f]
close $f
set content [regsub -all {\yassign\y} $content ""]
# Standard pattern for writing a whole file
set f [open $filename_out "w"]
puts -nonewline $f $content
close $f
The -nonewline is because when we read in the content, we kept all the line separators and our transform hasn't touched them. Wwe don't want to add any bonus ones at the end; that can get annoying if you're doing many transformations on a file.
If the file is very large, it can help a lot to process things a bit at a time. That's easy in this case because we are not trying to do a multi-line match.
set filename_in "something.V"
set filename_out "something.vhdl"
set f_in [open $filename_in]
set f_out [open $filename_out "w"]
while {[gets $f_in line] >= 0} {
set line [regsub -all {\yassign\y} $line ""]
puts $f_out $line
}
close $f_in
close $f_out
Note that this pattern can't write back to the same file.

How to print variable inside function

I'm using RRDs::Simple function and it needs bunch of parameters.
I have placed these parameters in a special variable (parsing, sorting and calculating data from a file) with all quotes, commas and other stuff.
Of course
RRDs::create ($variable);
doesn't work.
I've glanced through all perl special variables and have found nothing.
How to substitute name of variable for the data that contained in that variable?
At least could you tell me with what kind of tools(maybe another special variables) it can be done?
Assuming I'm understanding what you're asking:
You've build the 'create' data in $variable, and are now trying to use RRDs::create to actually do it?
First step is:
print $variable,"\n"; - to see what is actually there. You should be able to use this from the command line, with rrdtool create. (Which needs a filename, timestep, and some valid DS and RRA parameters)
usually, I'll use an array to pass into RRDs::create:
RRDs::create ( "test.rrd", "-s 300",
"DS:name:GAUGE:600:U:U", )
etc.
If $variable contains this information already, then that should be ok. The way to tell what went wrong is:
if ( RRDs::error ) { print RRDs::error,"\n"; }
It's possible that creating the file is the problem, or that your RRD definitions are invalid for some reason. rrdtool create on command line will tell you, as will RRDs::error;

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.

Perl write to file returns huge weird stacktrace

I have the following problem: when I try to save the file that contains a semicolon in the name it returns a huge and weird stacktrace of the characters on the page. I've tried to escape, to trim and to replace those semicolons, but the result is still the same. I use the following regex:
$value =~ s/([^a-zA-Z0-9_\-.]|;)/uc sprintf("%%%02x",ord($1))/eg;
(I've even added the |; part separately..)
So, when I open the file to write and call the print function it returns lots of weird stuff, like that:
PK!}�3y�[Content_Types].xml ���/�h9\�?�0���cz��:� �s_����o���>�T�� (it is a huge one, this is just a part of it).
Is there any way I could avoid this?
Thank you in advance!
EDIT:
Just interested - what is the PK responsible of in this string? I mean I can understand that those chars are just contents of the file, but what is PK ? And why does it show the content type?
EDIT 2.0:
I'm uploading the .docx file - when the name doesn't contain the semicolon it works all fine. This is the code for the file saving:
open (QSTR,">", "$dest_file") or die "can't open output file: $qstring_file";
print QSTR $value;
close (QSTR);
EDIT 3.0
This is a .cgi script, that is called after posting some data to the server. It has to save some info about the uploading file to a temp file (name, contents, size) in the manner of key-value pairs. So any file that contains the semicolon causes this error.
EDIT 4.0
Found the cause:
The CGI param function while uploading the params counts semicolon as the delimiter! Is there any way to escape it in the file header?
The PK in file header it means it is compressed ZIP like file, like docx.
One guess: The ; is not valid character in filename at the destination?
Your regexp is not good: (the dot alone is applicable to any character...)
$value =~ s/([^a-zA-Z0-9_\-.]|;)/uc sprintf("%%%02x",ord($1))/eg;
Try this:
#replace evey non valid char to underscore
$value =~ s/([^a-zA-Z0-9_\-\.\;])/_/g;

How to access buffer contents of Expect module in perl

I am using expect to automate terminal based applications. I will send data depending on result from "expect" command. I knew that expect, while doing a string matching stores all the unmatched string patterns in a buffer. For example $expect_out(0,string) is used to store the string that expect is actually waiting for, while $expect_out(buffer) contains all the unmatched string patterns occurred till the previous command.
I want to know if there is any way of accessing these expect buffers, like copying expect buffer contents into some variable as shown below
$mybuffer = $expect_out(buffer);
but the above statement is actually throwing an error "syntax error at perl_app_hh.pl line 72, near "$expect_out(""
I just want to copy contents of expect buffer to a variable. So please help me on this issue.
You're going to have to read the documentation for the Expect module. $expect(buffer) is not valid Perl.
$exp = Expect->spawn(...);
$exp->send(...);
$buffer = $exp->before();