Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"

The Monastery Gates

( #131=superdoc: print w/replies, xml ) Need Help??

Donations gladly accepted

If you're new here please read PerlMonks FAQ
and Create a new user.

New Questions
Simple search and output
3 direct replies — Read more / Contribute
by rvaughans
on Oct 20, 2018 at 10:39
    Hello... VERY new to Perl. I have a test file that I need to do a search (STDIN) and display ALL the lines found with the inputted string/variable. MUCH thanks in advance!!!
OK to Include CHI File Data in module Tests ?
1 direct reply — Read more / Contribute
by localshop
on Oct 20, 2018 at 00:52
    Trying to refine WebService::GoogleAPI::Client which uses CHI to cache resources pulled from Google API Discovery. In the package tests I'd like to maximise the coverage but don't wish to impose a whole bunch of HTTP requests every time tests are run. I was thinking that by bundling in a CHI::Driver::File directory for use by the tests I could default to using this and perhaps provide a switch to allow live requests for local dev testing where needed.

    I am concerned that the cache files won't be portable across platforms but I can probably catch that out.

    1. is this approach missing any obvious bad practice
    2. are any CPAN modules that do this that I could review?
    3. any advice on testing against network resources or cached data appreciated.

    Another option that occurred to me after posting this question is to create my own CHI::Driver subclass and use that for testing with some hard coded values.

    Many thanks for any advice.

glob an array?
2 direct replies — Read more / Contribute
by morgon
on Oct 19, 2018 at 21:10

    just for curiosity...

    If I have an array of filenames and a glob-pattern (as e.g. "*.hubba"), is there a way to "glob" the array (i.e. get the list of all elements matching the glob-pattern) using the same logic "glob" would use, or would I have to translate the gob-pattern into a regex and do a grep?

    Many thanks!

First attempt at bringing in file for input/output
7 direct replies — Read more / Contribute
by catfish1116
on Oct 19, 2018 at 15:48
    I am taking baby steps to understanding out to read in, modify file(s) and then send modified file to output. Here is my attempt to just read in a file and send it to output.
    #!/bin/perl use v5.12; use warnings; my $in = $ARGV[0]; if (! defined $in) { die "Usage: $0 filename"; } my $out = $in; $out =~ s/(\.\w+)?$/out/; if (! open $in_fh, '<', $in ) { die "Can't open '$in': $!"; } if (! open $out_fh, '>', $out) { die "Can't write '$out': $!"; }

    Here is the errors that I received:

    Global symbol "$in_fh" requires explicit package name at ./exer_9_2 li +ne 14. Global symbol "$out_fh" requires explicit package name at ./exer_9_2 l +ine 1

    What 'package' am I missing?

Solved! I would have expected a syntax error here
6 direct replies — Read more / Contribute
by roboticus
on Oct 19, 2018 at 12:05

    Thanks, guys! That was a quick resolution. Indirect Object syntax was what tripped me up. As haukex suggests, I'll have to start using the Yadda, Yadda operator ... to ensure that I don't miss that in the future.

    Using that operator and a comment, I can either let the program run and execute and die only if I reach unfinished code:

    sub find_symbol { ... # got to here today! (20180520) }
    $ perl Foo! Unimplemented at line 13.

    Or if I'd rather have the program just fail without running, I can prefix my original comment with the operator (so long as I don't use a semicolon as the first character in my comment:

    sub find_symbol { ... got to here today! (20180520) }
    $ perl syntax error at line 12, near "... got to " Execution of aborted due to compilation errors.

    Really, though, not one Monty Python reference? 8^)

    Original post follows:

    Hello, gang:

    When I write experimental bits of code and don't get a chance to finish, I'll frequently mark my position with a few words and no comment marker with the intent that if I run the program, perl will tell me that bit(s) of my code are unfinished, and let me know where the unfinished bits are. This morning I decided to adapt a working program I've been using all week to add some new functionality, and when I looked at the code, I saw this bit:

    sub find_symbol { got to here today! (20180520) }

    What the heck? The code is working, but that subroutine just can't be right. So I looked over the program--It doesn't look like the code is commented out anywhere (I normally use "=h1 foo" and "=cut" to comment out blocks of code I don't want to use). I ran:

    $ perl -c syntax OK

    OK, then, *something* has to be masking this syntax error, right? So I copied the code to and started removing chunk after chunk, eventually coming up with:

    $ cat #!env perl use strict; use warnings; find_symbol(); sub find_symbol { got to here today } $ perl -c syntax OK $ perl -MO=Concise 6 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 2 <;> nextstate(main 5 v:*,&,{,x*,x&,x$,$ ->3 5 <1> entersub[t2] vKS/TARG,STRICT ->6 - <1> ex-list K ->5 3 <0> pushmark s ->4 - <1> ex-rv2cv sK/STRICT,1 ->- 4 <#> gv[*find_symbol] s/EARLYCV ->5 - <;> ex-nextstate(main 7 v:*,&,{,x*,x&,x$,$ ->6 syntax OK

    So consider me baffled, I don't know what's going on here. Can anyone tell me what I'm not seeing?

    For the record:

    $ perl -version This is perl 5, version 26, subversion 2 (v5.26.2) built for x86_64-cy +gwin-threads-multi (with 7 registered patches, see perl -V for more detail)

    Interesting ... one more bit of information before I hit the preview button. I changed the contents of the subroutine to:

    sub find_symbol { I got to here today }

    and now I get what I expected to see:

    $ perl -c Bareword "today" not allowed while "strict subs" in use at li +ne 8. had compilation errors.

    Does anyone know what's happening here? My only (ill-informed) guess would be something to do with parsing the GOTO statement.


    When your only tool is a hammer, all problems look like your thumb.

diff vs diff -y
5 direct replies — Read more / Contribute
by MissPerl
on Oct 19, 2018 at 11:16
    I am not sure if anyone have the similar issue,
    $a = "/path/to/a/file"; $b = "/path/to/b/file"; $difference = system("$diff $a $b"); $difference2 = system("$diff -y $a $b");
    The $difference printed in html file only shows the difference - top & bottom (maybe 2 or 3 lines from 1000 lines).

    But the $difference2 printed in html file shows all the difference in 2 columns -left & right (1000 lines from 1000 lines).

    The output is actually fine, since I dont want to compare line by line, as sometime one has some extra lines while the other dont,

    So i want those extra lines which is in a and in b at the same file same time.

    Here, I am wondering if it is possible to have the sort of combination of both $diff and $diff -y, having 2 left/right columns of difference in some lines only (not showing every lines)
    if ($difference eq ''){ $difference = "Exactly Same.\n"; } push @table1, "<table id =\"Table1\">"; push @table1, "<tr><th>path A</th><th>A</th><th>path B</th><th>B</th>< +/tr>"; push @table1, "<tr><td colspan =\"4\">$difference</td></tr>";
    So that, $difference will shown in 2 columns with the line of differences in file.

    Any idea guys ?

Question about tr
3 direct replies — Read more / Contribute
by harangzsolt33
on Oct 19, 2018 at 01:17

    I am trying to learn how tr really works, and I think I still don't get it. I remember, reading the said that the character following tr is a separator character, and everything between the separators are characters that will get replaced with a new set of characters defined in the second group. Anyway, I am trying to write a little program that replaces the first 52 bytes of a character map with letters. In other words, in this programming exercise, I am trying to replace binary codes with tr, but tr is not handling these codes very well. For example, it gives an error when I try to convert chr(8) to "I"

    Here is my sample code:

    #!/usr/bin/perl use strict; use warnings; for (my $i = 0; $i < 52; $i++) { $a = chr($i); $a =~ tr|\0\1\2\3\4\5\6\7\8\t\n\0x0B\r\0x0D\0x0E\0x0F\0x10\0x11\0x12 +\0x13\0x14\0x15\0x16\0x17\0x18\0x19\0x1A\0x1B\0x1C\0x1D\0x1E\0x1F !"# +$%&'()*+,-./0123456789|ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrst +uvwxyz|; print "chr $i -> $a \n"; } exit;
regex not matching how I want it to :(
3 direct replies — Read more / Contribute
by glwa
on Oct 18, 2018 at 15:27
    usually I managed with regexes myself, but this time I am lost, so I decided to ask wiser people the question is why the following code:
    while ( $line=~/<a href=\"(.*?)\.htm\">/ig ) {
    on $line being
    <a href="test1.htm"> test1</a><br> <a href="test2.htm"> test2</a><br> +<a href="test3.htm"> test3</a><br>
    is matching
    test1"> test1</a><br> <a href="test2
    and not just
Loop through all directory and files and lines
4 direct replies — Read more / Contribute
by MissPerl
on Oct 18, 2018 at 09:25
    Hi fellow monks! CODE EDITED

    I want to go into first directory/i/j/*, then read all the files and all the lines inside every file. Eg, /somewhere/1/2/*

    Currently the script gave me no error, but the output was surprisingly all from the (else condition).

    I couldnt make sure, since there are a lot of files inside it, but there should at least have some cases match the (if ) condition.

    Can anyone have a look at the script i wrote and tell me if anything i have overlooked ?

    Each file, I want to find if any three of the strings exists, if it does, I'll store its filepath in store_location.

    Also the (i, j), was from an array with even number contents, odd number will be i; while even is j.
    # !/usr/bin/perl use strict; use warnings; use File::Glob 'bsd_glob'; my $store_location = '/path/to/file'; my $Dir1 = "/somewhere"; my $Dir2 = "/somewhereelse"; my @first_directory = ( bsd_glob("$Dir1/"), bsd_glob("$Dir2/") ); my @store_array = qw (1 2 3 4 5 6); foreach my $first (@first_directory){ while(my ($i,$j) = splice(@store_array,0,2)){ my $second_directory = "$first/$i/$j"; if (-e $second_directory and -d $second_directory){ my @third_directory = bsd_glob("$first/$i/$j/*"); foreach my $file (@third_directory){ open(FILE, "<" , $file) or die "Can't open file '$file +': $!"; while (<FILE>){ if (($_ =~ /TbhODK/) or ($_ =~ /octuov/) or ($_ =~ + /qas_uop/)) { open(my $filehand, '>>', $store_location) or d +ie "Fail to open file '$store_location' $!"; print $filehand "$first/$i/$j/$file \n"; close $filehand; } } } close FILE; } else{ open(my $filehand, '>>', $store_location) or die "Fail to +open file '$store_location' $!"; print $filehand "$first/$i/$j (fail to exist)\n"; close $filehand; } } }#first_directory
    Kindly let me know if it's unclear,I will improve the sentence.thank you perlmonks !

Date::Calc in years?
4 direct replies — Read more / Contribute
by Anonymous Monk
on Oct 18, 2018 at 05:13
    Hi Monks!
    My code below:
    use strict; use warnings; use Date::Calc qw(:all); my $date_birth = '1999-12-13'; my $date_death = '2080-05-21'; my @array_birth = split(/-/, $date_birth); my @array_death = split(/-/, $date_death); my $dd = Delta_Days(@array_birth, @array_death); my $years_alive = sprintf("%.1f", $dd/365); print $years_alive,"\n";
    works ok I would say, but I guess it is not 100% accurate (since I assume years of 365 days and I do not take into account months and days of birth and death.
    Can you help me fix it?
how to push multiples row of values into hash and do comparison
5 direct replies — Read more / Contribute
by darkmoon
on Oct 18, 2018 at 02:11

    Hi, I am new to perl. I have two files, I need to do comparison to find out the matching and non-matching data. I got two problems now: Question 1: one of my hashes can only capture the 2nd row of the 'num', i tried to use `push @{hash1{name1}},$x1,$y1,$x2,$y2` , but it still returning the 2nd row of the 'num'.

    File1 :
    name foo num 111 222 333 444 name jack num 999 111 222 333 num 333 444 555 777
    name jack num 999 111 222 333 num 333 444 555 777 name foo num 666 222 333 444
    This is my code:
    #!/usr/bin/perl use strict; use warnings; use Data::Dumper; my $input1=$ARGV[0]; my $input2=$ARGV[1]; my %hash1; my %hash2; my $name1; my $name2; my $x1; my $x2; my $y2; my $y1; open my $fh1,'<', $input1 or die "Cannot open file : $!\n"; while (<$fh1>) { chomp; if(/^name\s+(\S+)/) { $name1 = $1; } if(/^num\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/) { $x1 = $1; $y1 = $2; $x2 = $3; $y2 = $4; } $hash1{$name1}=[$x1,$y1,$x2,$y2]; } close $fh1; print Dumper (\%hash1); open my $fh2,'<', $input2 or die "Cannot open file : $!\n"; while (<$fh2>) { chomp; if(/^name\s+(\S+)/) { $name2 = $1; } if(/^num\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/) { $x1 = $1; $y1 = $2; $x2 = $3; $y2 = $4; } $hash2{$name2}=[$x1,$y1,$x2,$y2]; } close $fh2; print Dumper (\%hash2);
    My output:
    $VAR1 = { 'jack' => [ '333', '444', '555', '777' ], 'foo' => [ '111', '222', '333', '444' ] }; $VAR1 = { 'jack' => [ '333', '444', '555', '777' ], 'foo' => [ '666', '222', '333', '444' ] };
    My expected Output:
    $VAR1 = { 'jack' => [ '999', '111', '222', '333', '333', '444', '555', '777' ], 'foo' => [ '111', '222', '333', '444' ] }; $VAR1 = { 'jack' => [ '999', '111', '222', '333', '333', '444', '555', '777' ], 'foo' => [ '666', '222', '333', '444' ] };

    Question 2: I tried to use this foreach loop to do the matching of keys and values and print out in a table format. I tried this :

    print "\t\tFIle1\t\t\t\t\tFile2\n"; print "Name\tX1\tY1\tX2\tY2\t\t\tX1\tY1\tX2\tY2\n"; foreach my $k1(keys %hash1) { foreach my $k2(keys %hash2) { if($hash1{$name} eq $hash2{$name2}) { if($hash1{$x1}{$y1}{$x2}{$y2} == $hash2 +{$x1}{$y1}{$x2}{$y2}) { print "$name\$x1\$y1\$x +2\$y2\n"; } } } }

    but Im getting the header only.

    File1 File2 Name X1 Y1 X2 Y2 X1 Y1 X2 Y2
    my desired output for matching :
    File1 File2 Name x1 y1 x2 y2 x1 y1 x2 y2 jack 999 111 222 333 999 111 222 333 333 444 555 777 333 444 555 777
    Any help?
Is use of a simple DSL for a configuration a good idea?
2 direct replies — Read more / Contribute
by nysus
on Oct 17, 2018 at 20:30

    I've been studying the Rex module. Rex allows you to manage remote servers over ssh using a configuration file. It uses a crude "DSL," or "domain specific language" for adding tasks through a configuration file. Here's a sample of the configuration file:

    set user => "root"; group "frontend" => "server1", "server2", "server3", "server4"; group "local" => "mango", "debian01"; desc "Show uptime"; task "uptime", group => "local", sub { run "uptime"; }; desc "Show free space"; task "show_disk_free", sub { run "df -h"; }; desc "Upload file"; task "upload", "mango", sub { upload "/tmp/test.txt", "/tmp/test.txt"; };

    The idea behind this DSL is straightforward. Each keyword is a call to a function and the arguments are separated by commas. I'm not even sure if this is the true definition of a DSL but that's what they call it in their documentation.

    Anyway, I've never seen anything like this before and I'm wondering if there are any advantages to this approach to a configuration file. Are there any big advantages/disadvantages to this approach? And why not just use something more universal like JSON? My experience with config files is limited to writing my own Simple::Config files and .ini files with Dist::Zilla. So I'm interested in learning more about best practices for setting up config files. Thanks.

    $PM = "Perl Monk's";
    $MCF = "Most Clueless Friar Abbot Bishop Pontiff Deacon Curate Priest";
    $nysus = $PM . ' ' . $MCF;
    Click here if you love Perl Monks

New Cool Uses for Perl
Resistor network simplifier
1 direct reply — Read more / Contribute
by roboticus
on Oct 13, 2018 at 18:41

    Hello, fellow monks!

    This isn't really all that cool, but I'm posting it just in case someone might be interested. I'm trying to get back to my QRP transmitter/receiver project and had just wanted to convince myself that Pi attenuators properly reduced to the expected input and output impedance. Rather than do a couple by hand, I went full nerd and wrote code to do it instead.

    Essentially, the code lets you create a network of resistors (via the build_impedance() function) and pi_pads (via build_pad()) and attach them together via the named ports. Once you've got the network built, remove all named nodes you don't care about and then tell it to generate the simplified network.

    The code, as it is now, should give you:

    $ perl ********************************************************************** +********** 10dB Attenuator terminated w/ 50 ohms ********************************************************************** +********** 10dB Pad N: in_neg(1) in_pos(2) out_neg(3) out_pos(4) (1 3 0.05), (2 1 100), (2 4 75), (4 3 100) 50 ohm terminator N: in_neg(5) in_pos(6) (6 5 50) 10dB Pad + terminator N: in_neg(1) in_pos(2) (1 3 0.05), (2 1 100), (2 4 75), (4 3 50), (4 3 100) Simplified network N: in_neg(1) in_pos(2) (1 2 52) ********************************************************************** +********** Two pads cascaded and terminated ********************************************************************** +********** PAD 10dB N: in_neg(1) in_pos(2) out_neg(3) out_pos(4) (1 3 0.05), (2 1 100), (2 4 75), (4 3 100) PAD 20dB N: in_neg(5) in_pos(6) out_neg(7) out_pos(8) (5 7 0.05), (6 5 68), (6 8 270), (8 7 68) TERM 50ohm N: in_neg(9) in_pos(10) (10 9 50) PAD 20dB + TERM 50ohm N: in_neg(5) in_pos(6) (5 7 0.05), (6 5 68), (6 8 270), (8 7 50), (8 7 68) PAD 10dB + PAD 20dB + TERM 50ohm N: in_neg(1) in_pos(2) (1 3 0.05), (2 1 100), (2 4 75), (3 7 0.05), (4 3 68), (4 3 100), ( +4 8 270), (8 7 50), (8 7 68) RESULT! N: in_neg(1) in_pos(2) (1 2 52.5)

    I just hardcode the commands to build the networks up front, and then let it do its thing.

    Comments about my coding style are always welcome, as I'm typically the only person who ever reads my code. Questions about it are just as welcome.


    When your only tool is a hammer, all problems look like your thumb.

Log In?

What's my password?
Create A New User
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (2)
As of 2018-10-20 20:58 GMT
Find Nodes?
    Voting Booth?
    When I need money for a bigger acquisition, I usually ...

    Results (119 votes). Check out past polls.