How to read "<somestring>" in input string in perl - string

Below is my code. It still produces same string with no "<init>"
input string :
1: invokespecial #1 // Method java/lang/Object."<init>":()V
my $file = "Hello.javap";
open my $fh, '<', $file or die "Could not open '$file' $!";
while (my $line = <$fh>) {
if (index(uc($line), uc("Code:")) != -1) {
$code_block_started=1;
}
if(index($line,":")==-1)
{
if (my ($method) = $line =~ /.* \/\/ Method (.*);/) {
print "Method: $method\n";
}
print $line;
$code_block_started=0;
}
if($code_block_started){
if ($line =~/[0-9]/) {
my #num_strip = split(':',$line);
my #get_command = split(' ',$num_strip[1]);
# print "\n $get_command[0]";
$count{$get_command[0]}++;
}
}

Are you simply asking how to escape the " in perl? If so, write \"<init>\" just like in most languages.
Are you asking for a regular expression? If so, $str ~= /.* \/\/ Method (.*);/ will put java/lang/Object."<init>":()V into $1.

while (my $str = <>) {
if (my ($method) = $str =~ m{// Method (.*)}) {
print "$method\n";
}
}

when Perl sees the double-quote just before the word "name" it thinks that was the end of the string and then it complains about the word name being a bareword.
You might have already guessed, we need to escape the embedded " character:
use strict;
use warnings;
my $name = 'foo';
print "The \"name\" is \"$name\"\n";
http://perlmaven.com/quoted-interpolated-and-escaped-strings-in-perl

Related

I can create filehandles to strings in Perl 5, how do I do it in Perl 6?

In Perl 5, I can create a filehandle to a string and read or write from the string as if it were a file. This is great for working with tests or templates.
For example:
use v5.10; use strict; use warnings;
my $text = "A\nB\nC\n";
open(my $fh, '<', \$text);
while(my $line = readline($fh)){
print $line;
}
How can I do that in Perl 6? The following doesn't work for Perl 6 (at least not for my instance of Perl6 running on MoarVM 2015.01 from the January 2015 release of Rakudo Star on 64-bit CentOS 6.5):
# Warning: This code does not work
use v6;
my $text = "A\nB\nC\n";
my $fh = $text;
while (my $line = $fh.get ) {
$line.say;
}
# Warning: Example of nonfunctional code
I get the error message:
No such method 'get' for invocant of type 'Str'
in block <unit> at string_fh.p6:8
It's not very surprising that Perl5's open(my $fh, '<', \$text) is not the same as Perl6's my $fh = $text;. So the question is: How does one create a virtual file handle from a string in Perl 6 like open(my $fh, '<', \$str) in Perl 5? Or is that something that has yet to be implemented?
UPDATE (writing to a filehandle in Perl 5)
Likewise, you can write to string filehandles in Perl 5:
use v5.10; use strict; use warnings;
my $text = "";
open(my $fh, '>', \$text);
print $fh "A";
print $fh "B";
print $fh "C";
print "My string is '$text'\n";
Outputs:
My string is 'ABC'
I haven't seen anything remotely similar in Perl 6, yet.
Reading
The idiomatic way to read line-by-line is the .lines method, which is available on both Str and IO::Handle.
It returns a lazy list which you can pass on to for, as in
my $text = "A\nB\nC\n";
for $text.lines -> $line {
# do something with $line
}
Writing
my $scalar;
my $fh = IO::Handle.new but
role {
method print (*#stuff) { $scalar ~= #stuff };
method print-nl { $scalar ~= "\n" }
};
$fh.say("OH HAI");
$fh.say("bai bai");
say $scalar
# OH HAI
# bai bai
(Adapted from #perl6, thanks to Carl Mäsak.)
More advanced cases
If you need a more sophisticated mechanism to fake file handles, there's IO::Capture::Simple and IO::String in the ecosystem.
For example:
use IO::Capture::Simple;
my $result;
capture_stdout_on($result);
say "Howdy there!";
say "Hai!";
capture_stdout_off();
say "Captured string:\n" ~$result;

Add default system newline in Perl

When I append text to a file I would like to add the correct line ending for the file: for Unix: "\n" and for Windows "\r\n". However, I could not find an easy way to do this. This was the best I could come up with:
use strict;
use warnings;
use Devel::CheckOS ();
my $fn = 'file';
open (my $fh, '<', $fn) or die "Could not open file '$fn': $!\n";
my $first_line = <$fh>;
my $len = length $first_line;
my $file_type = "undetermined";
if ($len == 1) {
$file_type = "Unix" if $first_line eq "\n";
}
if ($len >= 2) {
if (substr($first_line, $len - 1, 1) eq "\n") {
if (substr($first_line, $len - 2, 1) eq "\r") {
$file_type = "DOS";
} else {
$file_type = "Unix";
}
}
}
close $fh;
if ($file_type eq "undetermined") {
$file_type = get_system_file_type();
}
print "File type: $file_type.\n";
sub get_system_file_type {
return Devel::CheckOS::os_is('MicrosoftWindows') ? "DOS" : "Unix";
}
Is it really necessary to do all these checks? Or are there simpler ways to do this?
Use the :crlf handle, for example with use open and use if:
use if ($^O eq "MSWin32") => open qw(IO :crlf :all);
The relevant documentations:
PerlIO for the io layers. Note that this page states:
If the platform is MS-DOS like and normally does CRLF to "\n" translation for text files then the default layers are :
unix crlf
So the above code should be redundant, but that's what you're asking for.
perlvar for the $^O variable.
open for the open pragma.
if for conditional loading of modules.

Perl String comparison

I'm trying to compare a string to another.
If it's a JSON structure which contains things, I want to print "contains things".
If it's a JSON structure which doesn't contain thing, I print "empty"
If it something which is not between curly brackets "{}", i print that there's an error.
Here's what I've done :
if($content =~ m/{.+}/){
print "Contains things \n";
} elsif($content eq "{}"){
$job_status{$url}="";
print "empty \n";
} else {
print "Error \n";
}
When I pass "{}" to the variable $content, he does not enter the "elsif", but go to the "else", and throw an error.
I've tried to put "==" instead the "eq" in the if, even though I know it's for numbers. When so, he enters the "elsif", and print "empty", like he should do with the "eq", and throws :
Argument "{}" isn't numeric in numeric eq (==)".
I could use the JSON library but I prefer not.
Thanks for your help !
Bidy
It works for me. Does $content have a newline character? Try chomp $content;.
use warnings;
use strict;
my $content = '{}';
if($content =~ m/{.+}/){
print "Contains things \n";
} elsif($content eq "{}"){
print "empty \n";
} else {
print "Error \n";
}
__END__
empty
I can replicate the behaviour if I add a newline after the {}:
#!/usr/bin/perl
use strict;
use warnings;
my $content = "{}\n";
if($content =~ m/{.+}/){
print "Contains things \n";
} elsif($content eq "{}"){
print "empty \n";
} else {
print "Error \n";
}
It returns "Error", if I replace eq with ==, it returns empty, because both "{}" and "{}\n" are numerically 0. A warning is thrown as you mentioned.
You might try to chomp the $content before processing it.
A top-level JSON thingy can be an object ({...}) or an array ([...]), but you're only checking for one of those. If you merely want to see if it's empty, I'd check the length of the string:
chomp $possible_json;
if( $length $possible_json >= 3 ) { ... }
You might also consider Randal Schwartz's regex for JSON parsing. It doesn't handle everything, but it's often enough for simple things.
I'd probably end up breaking it up:
unless ($content) {print "Error\n"};
$content =~ /{(.*)}/
my $resp = $1;
if ($resp) {
print "Contains Things ($resp)\n";
} else {
print "Empty\n";
}

Replace character with other character in a text file using perl

I am having problem in parsing the output from the text file. I want to add pipe symbol in between the character to do mutliple search similar to egrep, the text file is as follows
service entered the stopped state,critical
service entered the running state,clear
Code:
open(my $data, '<', $Config_File) or die "Could not open '$Config_File"
my $reg_exp;
my $severity;
my #fields=();
while (my $line = <$data>)
{
chomp $line;
if(!$line =~ /^$/)
{
#fields = split "," , $line;
$reg_exp = $fields[0];
$severity = $fields[1];
print $reg_exp;
}
}
#print $fields[0];
#last unless defined $line;
close($data);
expected output
service entered the stopped state|service entered the running state
You are not far off, you just need to actually concatenate the strings. The simplest way would be to push the $fields[0] to an array, and wait until the input is done to print it. I.e.:
my #data;
while (my $line = <$data>) {
next if $line =~ /^$/; # no need to chomp
my #fields = split /,/, $line;
push #data, $fields[0];
}
print join("|", #data), "\n";
I sense that you are trying to achieve something else with this code, and that this is a so-called XY-problem.

how to compare 2 strings by each characters in perl

basically I want to compare
$a = "ABCDE";
$b = "--(-)-";
and get output CE.
i.e where ever parentheses occur the characters of $a should be taken.
One of the rare uses of the bitwise or-operator.
# magic happens here ↓
perl -E'say (("ABCDE" | "--(-)-" =~ tr/-()/\377\000/r) =~ tr/\377//dr)'
prints CE.
Use this for golfing purposes only, AHA’s solution is much more maintainable.
Simple regex and pos solution:
my $str = "ABCDE";
my $pat = "--(-)-";
my #list;
while ($pat =~ /(?=[()])/g) {
last if pos($pat) > length($str); # Required to prevent matching outside $x
my $char = substr($str, pos($y), 1);
push #list, $char;
}
print #list;
Note the use of lookahead to get the position before the matching character.
Combined with Axeman's use of the #- variable we can get an alternative loop:
while ($pat =~ /[()]/g) {
last if $-[0] > length($str);
my $char = substr($str, $-[0], 1);
push #list, $char;
}
This is pretty much mentioned in the documentation for #-:
After a match against some variable $var :
....
$& is the same as substr($var, $-[0], $+[0] - $-[0])
In other words, the matched string $& equals that substring expression. If you replace $var with another string, you would get the characters matching the same positions.
In my example, the expression $+[0] - $-[0] (offset of end of match minus offset of start of match) would be 1, since that is the max length of the matching regex.
QED.
This uses the idea that you can scan one string for positions and just take the values of the other strings. #s is a reusable product.
use strict;
use warnings;
sub chars {
my $source = shift;
return unless #_;
my #chars = map { substr( $source, $_, 1 ) } #_;
return wantarray ? #chars, join( '', #chars );
}
my $a = "ABCDE";
my $b = "--(-)-";
my #s;
push #s, #- while $b =~ m/[()]/g;
my $res = chars( $a, #s );
Way faster than all the solutions except daxim's, and almost as fast as daxim's without preventing the use of characters 255 and above:
my $pat = $b =~ s/[^()]/.?/gr =~ s/[()]/(.?)/gr
my $c = join '', $a =~ /^$pat/s;
It changes
---(-)-
to
.?.?.?(.?).?(.?).?
Then uses the result as regex pattern to extract the desired characters.
This is easy to accomplish using each_array, each_arrayref or pairwise from List::MoreUtils:
#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw( min );
use List::MoreUtils qw( each_array );
my $string = 'ABCDE';
my $pattern = '--(-)-';
my #string_chars = split //, $string;
my #pattern_chars = split //, $pattern;
# Equalise length
my $min_length = min $#string_chars, $#pattern_chars;
$#string_chars = $#pattern_chars = $min_length;
my $ea = each_array #string_chars, #pattern_chars;
while ( my ( $string_char, $pattern_char ) = $ea->() ) {
print $string_char if $pattern_char =~ /[()]/;
}
Using pairwise:
{
no warnings qw( once );
print pairwise {
$a if $b =~ /[()]/;
} #string_chars, #pattern_chars;
}
Without using List::MoreUtils:
for ( 0 .. $#string_chars ) {
print $string_chars[$_] if $pattern_chars[$_] =~ /[()]/;
}
Thanks to TLP for discovering the set $# technique without which this solution will have been longer and complicated. :-)
#!/usr/bin/perl
use strict;
use warnings;
my $a = "ABCDE";
my $b = "--(-)-";
my ($i, $c, $x, $y) = 0;
$c .= $y =~ /\(|\)/ ? $x : "" while ($x = substr $a, $i, 1) && ($y = substr $b, $i++, 1);
print "$c\n";

Resources