Perl program for extracting the functions alone in a Ruby file - perl

I am having the following Ruby program.
puts "hai"
def mult(a,b)
a * b
end
puts "hello"
def getCostAndMpg
cost = 30000 # some fancy db calls go here
mpg = 30
return cost,mpg
end
AltimaCost, AltimaMpg = getCostAndMpg
puts "AltimaCost = #{AltimaCost}, AltimaMpg = {AltimaMpg}"
I have written a perl script which will extract the functions alone in a Ruby file as follows
while (<DATA>){
print if ( /def/ .. /end/ );
}
Here the <DATA> is reading from the ruby file.
So perl prograam produces the following output.
def mult(a,b)
a * b
end
def getCostAndMpg
cost = 30000 # some fancy db calls go here
mpg = 30
return cost,mpg
end
But, if the function is having block of statements, say for example it is having an if condition testing block means then it is not working. It is taking only up to the "end" of "if" block. And it is not taking up to the "end" of the function. So kindly provide solutions for me.
Example:
def function
if x > 2
puts "x is greater than 2"
elsif x <= 2 and x!=0
puts "x is 1"
else
puts "I can't guess the number"
end #----- My code parsing only up to this
end
Thanks in Advance!

If your code is properly indented, you just want lines that start with def or end, so change your program to:
while (<DATA>){
print if ( /^def/ .. /^end/ );
}
Or run it without a program file at all - run the program from the command line, using -n to have perl treat it as a while loop reading from STDIN:
perl -n -e "print if ( /^def/ .. /^end/ );" < ruby-file.rb

I am not familiar with ruby syntax but if you can ensure good indentation all over the code, you can check based on indentation. Something similar to:
my $add = 0;
my $spaces;
while(my $str = <DATA>) {
if (! $add && $str =~ /^(\s*)def function/) {
$add = 1;
$spaces = $1;
}
if ($add) {
print $_;
$add = 0 if ($str =~ /^$spaces\S/);
}
}

Another option could be counting level of program, something like this:
my $level = 0;
while(<DATA>) {
if(/\b def \b/x .. /\b end \b/x && $level == 0) {
$level++ if /\b if \b/x; # put all statements that closes by end here
$level-- if /\b end \b/x;
print;
}
}
I am not all that familiar with ruby syntax, so you need to put all statements that are closed by end into regex with $level++.
Please note I added \b around those keywords to make sure you are matching whole word and not things like undef as start of function.

Related

perl foreach loop issue on breaking out

I am writing a small perl script, primarily to learn the language. Basically it has an action dispatch table. Based on the user input any one of the target actions will be invoked. Each action is a small, independent utility function (say print time), working on which allows me to explore and learn different aspects of perl.
I have run into a problem with the dispatch mechanism. The script runs in a continuous loop, each time taking a user request for an action. This input is compared against the regular expressions of each available action. If there is a match, that action is executed and it breaks out of the match loop to read user's next request. The problem I am facing is that, if I request for the same action twice, it is not matching the second time. If I print the dispatch table immediately after the match, the matched action entry seems to be missing. If I continuously request for same action, it works only on alternate invocations. If I avoid the "last LABEL", it works without any issues.
Perl version is 5.12.4 (on Fedora 15, 32 bit). Below is a simplified but complete example. I am still a beginner in perl. Please excuse if it doesn't meet the standards of a monk :) Kindly help in figuring out the issue with this code. Your help is much appreciated.
#!/bin/env perl
use strict ;
use warnings ;
use Text::ParseWords ;
my #Actions ;
my $Quit ;
sub main
{
# Dispatch table
# Each row has [syntax, help, {RegExp1 => Function1, RegExp2 => Function2,...}]
# There can be multiple RegExps depending on optional arguments in user input
#Actions =
(
['first <value>', 'Print first', {'first (.*)' => \&PrintFirst} ],
['second <value>', 'Print second', {'second (.*)' => \&PrintSecond} ],
['quit', 'Exits the script', {'quit' => \&Quit} ]
) ;
my $CommandLine ;
my #Captures ;
my $RegEx ;
my $Function ;
while(!$Quit)
{
# Get user input, repeat until there is some entry
while(!$CommandLine)
{
print "\$ " ;
my $argline = <STDIN> ;
my #args = shellwords($argline) ;
$CommandLine = join (" ", grep { length() } #args) ;
}
# Find and execute the action matching given input
# For each entry in the #Actions array
ExecAction: foreach my $Action (#Actions)
{
# For each RegExp for that action (only 1 per action in this example)
while (($RegEx, $Function) = each %{#$Action[2]})
{
if (#Captures = $CommandLine =~ m/^$RegEx$/i)
{
print "Match : $RegEx\n" ;
&$Function(#Captures) ;
last ExecAction ; # Works if this line is commented
}
}
}
$CommandLine = undef ;
}
}
sub PrintFirst { print "first $_[0]\n" ; }
sub PrintSecond { print "second $_[0]\n" ; }
sub Quit { $Quit = 1 ; }
main ;
You have stumbled across some subtle behavior of the each operator. By breaking out of the loop (with last ExecAction) before the each operator has exhausted the key-value pairs of %{#$Action[2]}, the next call to each %{#$Action[2]} will attempt to retrieve a different key-value pair. Since there isn't one (there is only one key-value pair defined for each element of the #Action data structure), each returns an empty list, and the contents of the while loop are skipped.
The simplest workaround is to reset the "iterator" associated with each before each use, say, by calling keys:
keys %{#$Action[2]};
while (($RegEx, $Function) = each %{#$Action[2]})
{
...
}
I think explicitly copying the hash to a temporary variable would work, too:
my %action_hash = %{#$Action[2]};
while (($RegEx, $Function) = each %action_hash) {
...
}
You need to reset the hash's iterator if you're going to break out of an each loop
$ perl -E'
%h=(a=>4,b=>5,c=>6,d=>7);
while (my ($k, $v) = each %h) { last if ++$i == 2 }
keys %h if $ARGV[0];
while (my ($k, $v) = each %h) { say "$k:$v"; }
' 0
b:5
d:7
$ perl -E'
%h=(a=>4,b=>5,c=>6,d=>7);
while (my ($k, $v) = each %h) { last if ++$i == 2 }
keys %h if $ARGV[0];
while (my ($k, $v) = each %h) { say "$k:$v"; }
' 1
c:6
a:4
b:5
d:7
each, keys

perl: why not returning for case 0 or 1?

I am implementing a perl fib with hash table:
#!/usr/bin/perl
use strict;
use warnings;
no warnings 'recursion';
my %m_fib = (0,1,1,1);
while (my $a = <STDIN>) {
print "--".&fib($a)."\n";
}
sub fib {
foreach my $i (#_) {
if (not defined $m_fib{$i}) {
$m_fib{$i} = &fib($i - 1) + &fib($i - 2);
}
return $m_fib{$i};
}
}
It is working well with input larger than 1, but silent with either 0 or 1.
The hash should be fine since it is returning the correct result, but why it won't work if I feed that with 0 or 1?
Your input contains the end of line (\n). Remove it with chomp (documentation)
while (my $a = <STDIN>) {
chomp $a;
print "--".&fib($a)."\n";
}
Edit: What the problem is
with any input the defined test will always fail as the string number\n is not present in the hash
Perl is able to perform a mathematical operation with your input 20\n - 1 is 19
Now with 0 or 1 no defined value is found and your code will call fib(-1) and fib(-2) or fib(0) and fib(-1) respectively. This will generate an endless loop.
With 2 the test will fail and Perl will perform the subtraction calling fib(1) + fib(0) (without the \n). In the second call your test will work as $m_fib(0) does indeed exist.
Edit 2
A small review with a few comments
your function processes more than one argument but exits after the first one. You never call it with more than one argument (and even if you did it will never process the second)
some other comments inline (you can review you code using Perl::Critic)
#!/usr/bin/perl
use strict;
use warnings;
# Not needed
# no warnings 'recursion';
my %m_fib = ( 0, 1, 1, 1 );
# From Perl::Critic
#
# Use "<>" or "<ARGV>" or a prompting module instead of "<STDIN>" at line 10, column 17.
# InputOutput::ProhibitExplicitStdin (Severity: 4)
# Perl has a useful magic filehandle called `*ARGV' that checks the
# command line and if there are any arguments, opens and reads those as
# files. If there are no arguments, `*ARGV' behaves like `*STDIN' instead.
# This behavior is almost always what you want if you want to create a
# program that reads from `STDIN'. This is often written in one of the
# following two equivalent forms:
#
# while (<ARGV>) {
# # ... do something with each input line ...
# }
# # or, equivalently:
# while (<>) {
# # ... do something with each input line ...
# }
#
# If you want to prompt for user input, try special purpose modules like
# IO::Prompt.
while ( my $a = <> ) {
chomp $a;
# use " just when needed
print '--' . fib($a) . "\n";
}
sub fib {
my $i = shift;
if ( not defined $m_fib{$i} ) {
# it is not necessary to use & for subroutine calls and
# can be confused with the logical and
$m_fib{$i} = fib( $i - 1 ) + fib( $i - 2 );
}
return $m_fib{$i};
}

Trying to write a simple loop

Could someone help me with a loop please. I'm meant to be writing a program which simply asks you to guess a number between 1 and 10. If it's not the correct answer you get another chance, etc.
I can get my script to print correct/not correct one time, but how do I add into this script a possibility for the user to try again (until they guess the right number)?
Here's my basic script, which I'm sure is very simplistic and probably full of errors. Could someone help me sort out this simple problem?
Sorry for the bad layout, but I don't understand how to place my script on this site, sorry!
use strict;
use warnings;
print "Hello, I've thought of a number, do you know what number it is?\n";
sleep (1);
print "Try and guess, type in a number between 1 and 10!\n";
my $div = <STDIN>;
my $i = 0;
my $int = int(rand (10)) + 1;
chomp $div;
if ($div < $int) {
print ("The number I though of is higher than $div, try again?\n");
}
if ($div > $int) {
print ("The number I though of is lower that $div, try again?\n");
}
if ($div == $int) {
print ("Amazing, you've guessed mt number\n");
}
The more straightforward approach would be a while loop.
use strict;
use warnings;
print "Hello, I've thought of a number, do you know what number it is?\n";
sleep (1);
my $int = int(rand (10)) + 1;
print "Try and guess, type in a number between 1 and 10!\n";
while (my $div = <STDIN>) {
chomp $div;
if ($div < $int) {
print "The number I though of is higher than $div, try again?\n";
}
elsif ($div > $int) {
print "The number I though of is lower that $div, try again?\n";
}
else {
print "Amazing, you've guessed mt number\n";
last;
}
}
While (pun intended) your code already is very good (you are using strict and warnings and there are no syntax errors, yay for that!) there are some things I changed, and some more where I would suggest improvement.
But first, let's look at the loop. The program will stay in the while loop as long as the condition is true. Since everything the user can input (even an empty line) is considered true by Perl, this is forever. Which is fine, as there is a condition to exit the loop. It's in the else part of the if. The last statement tells Perl to exit the loop. If the else is not executed, it will go back to the start of the while block and the user has to try again. Forever.
The changes I made:
- You don't need $i as you did not use it
- You used three seperate if statements. Since only one of the three conditions can be true in this case, I merged them into one
- No need for the parens () with print
Suggestions:
- You should name your variables for what they do, not what they are. $int is not a good name. I'd go with $random, or even $random_number. Verbosity is important if you have to come back to your code at a later point.
- There is a function called say that you can enable with use feature 'say';. It adds say "stuff" as an equivalent to print "stuff\n".
Edit:
If you want to add other conditions that do not directly relate to which number the user has entered, you can add another if.
while (my $div = <STDIN>) {
chomp $div;
if ($div eq 'quit') {
print "You're a sissy... the number was $int. Goodbye.\n";
last;
}
if ($div < $int) {
print "The number I though of is higher than $div, try again?\n";
}
elsif ($div > $int) {
print "The number I though of is lower that $div, try again?\n";
}
else {
print "Amazing, you've guessed mt number\n";
last;
}
}
You can also add a check to make sure the user has entered a number. Your current code will produce warnings if a word or letter was is entered. To do that, you will need a regular expression. Read up on them in perlre. The m// is the match operator that works together with =~. The \D matches any character that is not a number (0 to 9). next steps over the rest of the while block and begins with the check of the while condition.
while (my $div = <STDIN>) {
chomp $div;
if ($div =~ m/\D/) {
print "You may only guess numbers. Please try again.\n";
next;
}
# ...
}
Thus, the complete check means 'look at the stuff the user has entered, and if there is anything else than a number in it at all, complain and let him try again'.
use an until loop
my $guessed = 0;
do {
print "Try and guess, type in a number between 1 and 10!\n";
my $div = <STDIN>;
...;
if ($div == $int) {
print ("Amazing, you've guessed mt number\n");
$guessed = 1;
}
} until ($guessed)

perl + numeration word or parameter in file

I need help about how to numeration text in file.
I have also linux machine and I need to write the script with perl
I have file name: file_db.txt
In this file have parameters like name,ParameterFromBook,NumberPage,BOOK_From_library,price etc
Each parameter equal to something as name=elephant
My question How to do this by perl
I want to give number for each parameter (before the "=") that repeated (unique parameter) in the file , and increase by (+1) the new number of the next repeated parameter until EOF
lidia
For example
file_db.txt before numbering
parameter=1
name=one
parameter=2
name=two
file_db.txt after parameters numbering
parameter1=1
name1=one
parameter2=2
name2=two
other examples
Example1 before
name=elephant
ParameterFromBook=234
name=star.world
ParameterFromBook=200
name=home_room1
ParameterFromBook=264
Example1 after parameters numbering
name1=elephant
ParameterFromBook1=234
name2=star.world
ParameterFromBook2=200
name3=home_room1
ParameterFromBook3=264
Example2 before
file_db.txt before numbering
lines_and_words=1
list_of_books=3442
lines_and_words=13
list_of_books=344224
lines_and_words=120
list_of_books=341
Example2 after
file_db.txt after parameters numbering
lines_and_words1=1
list_of_books1=3442
lines_and_words2=13
list_of_books2=344224
lines_and_words3=120
list_of_books3=341
It can be condensed to a one line perl script pretty easily, though I don't particularly recommend it if you want readability:
#!/usr/bin/perl
s/(.*)=/$k{$1}++;"$1$k{$1}="/e and print while <>;
This version reads from a specified file, rather than using the command line:
#!/usr/bin/perl
open IN, "/tmp/file";
s/(.*)=/$k{$1}++;"$1$k{$1}="/e and print while <IN>;
The way I look at it, you probably want to number blocks and not just occurrences. So you probably want the number on each of the keys to be at least as great as the earliest repeating key.
my $in = \*::DATA;
my $out = \*::STDOUT;
my %occur;
my $num = 0;
while ( <$in> ) {
if ( my ( $pre, $key, $data ) = m/^(\s*)(\w+)=(.*)/ ) {
$num++ if $num < ++$occur{$key};
print { $out } "$pre$key$num=$data\n";
}
else {
$num++;
print;
}
}
__DATA__
name=elephant
ParameterFromBook=234
name=star.world
ParameterFromBook=200
name=home_room1
ParameterFromBook=264
However, if you just wanted to give the key it's particular count. This is enough:
my %occur;
while ( <$in> ) {
my ( $pre, $key, $data ) = m/^(\s*)(\w+)=(.*)/;
$occur{$key}++;
print { $out } "$pre$key$occur{$key}=$data\n";
}
in pretty much pseudo code:
open(DATA, "file");
my #lines = <DATA>;
my %tags;
foreach line (#lines)
{
my %parts=split(/=/, $line);
my $name=$parts[0];
my $value=$parts[1];
$name = ${name}$tags{ $name };
$tags{ $name } = $tags{ $name } + 1;
printf "${name}=$value\n";
}
close( DATA );
This looks like a CS101 assignment. Is it really good to ask for complete solutions instead of asking specific technical questions if you have difficulty?
If Perl is not a must, here's an awk version
$ cat file
name=elephant
ParameterFromBook=234
name=star.world
ParameterFromBook=200
name=home_room1
ParameterFromBook=264
$ awk -F"=" '{s[$1]++}{print $1s[$1],$2}' OFS="=" file
name1=elephant
ParameterFromBook1=234
name2=star.world
ParameterFromBook2=200
name3=home_room1
ParameterFromBook3=264

Parsing files that use synonyms

If I had a text file with the following:
Today (is|will be) a (great|good|nice) day.
Is there a simple way I can generate a random output like:
Today is a great day.
Today will be a nice day.
Using Perl or UNIX utils?
Closures are fun:
#!/usr/bin/perl
use strict;
use warnings;
my #gens = map { make_generator($_, qr~\|~) } (
'Today (is|will be) a (great|good|nice) day.',
'The returns this (month|quarter|year) will be (1%|5%|10%).',
'Must escape %% signs here, but not here (%|#).'
);
for ( 1 .. 5 ) {
print $_->(), "\n" for #gens;
}
sub make_generator {
my ($tmpl, $sep) = #_;
my #lists;
while ( $tmpl =~ s{\( ( [^)]+ ) \)}{%s}x ) {
push #lists, [ split $sep, $1 ];
}
return sub {
sprintf $tmpl, map { $_->[rand #$_] } #lists
};
}
Output:
C:\Temp> h
Today will be a great day.
The returns this month will be 1%.
Must escape % signs here, but not here #.
Today will be a great day.
The returns this year will be 5%.
Must escape % signs here, but not here #.
Today will be a good day.
The returns this quarter will be 10%.
Must escape % signs here, but not here %.
Today is a good day.
The returns this month will be 1%.
Must escape % signs here, but not here %.
Today is a great day.
The returns this quarter will be 5%.
Must escape % signs here, but not here #.
Code:
#!/usr/bin/perl
use strict;
use warnings;
my $template = 'Today (is|will be) a (great|good|nice) day.';
for (1..10) {
print pick_one($template), "\n";
}
exit;
sub pick_one {
my ($template) = #_;
$template =~ s{\(([^)]+)\)}{get_random_part($1)}ge;
return $template;
}
sub get_random_part {
my $string = shift;
my #parts = split /\|/, $string;
return $parts[rand #parts];
}
Logic:
Define template of output (my $template = ...)
Enter loop to print random output many times (for ...)
Call pick_one to do the work
Find all "(...)" substrings, and replace them with random part ($template =~ s...)
Print generated string
Getting random part is simple:
receive extracted substring (my $string = shift)
split it using | character (my #parts = ...)
return random part (return $parts[...)
That's basically all. Instead of using function you could put the same logic in s{}{}, but it would be a bit less readable:
$template =~ s{\( ( [^)]+ ) \)}
{ my #parts = split /\|/, $1;
$parts[rand #parts];
}gex;
Sounds like you may be looking for Regexp::Genex. From the module's synopsis:
#!/usr/bin/perl -l
use Regexp::Genex qw(:all);
$regex = shift || "a(b|c)d{2,4}?";
print "Trying: $regex";
print for strings($regex);
# abdd
# abddd
# abdddd
# acdd
# acddd
# acdddd
Use a regex to match each parenthetical (and the text inside it).
Use a string split operation (pipe delimiter) on the text inside of the matched parenthetical to get each of the options.
Pick one randomly.
Return it as the replacement for that capture.
Smells like a recursive algorithm
Edit: misread and thought you wanted all possibilities
#!/usr/bin/python
import re, random
def expand(line, all):
result = re.search('\([^\)]+\)', line)
if result:
variants = result.group(0)[1:-1].split("|")
for v in variants:
expand(line[:result.start()] + v + line[result.end():], all)
else:
all.append(line)
return all
line = "Today (is|will be) a (great|good|nice) day."
all = expand(line, [])
# choose a random possibility at the end:
print random.choice(all)
A similar construct that produces a single random line:
def expand_rnd(line):
result = re.search('\([^\)]+\)', line)
if result:
variants = result.group(0)[1:-1].split("|")
choice = random.choice(variants)
return expand_rnd(
line[:result.start()] + choice + line[result.end():])
else:
return line
Will fail however on nested constructs