Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid

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
how to extract script output in new text file ?
4 direct replies — Read more / Contribute
by Chris202
on Oct 25, 2014 at 13:19
    Dear all I own nothing but faith in you all because I have tried to find the answer to my question on the internet for long but couldn't get (or understand) it... Here's my problem: I have a script that scans throught a text file and writes all line except those starting with an A.
    #!/usr/bin/perl use strict; use warnings; open (my $file, "<", "/file.txt") or die "cannot open < file.txt $!"; while (<$file>) { unless (/^A/) { print; } }
    That works, but I get the results of this script in the terminal. What I want is just to get these results to be saved in a new text file. Can somebody help me ? Please light my path amid the darkness with the wisdom that is yours Thanks a lot ! Chris
Sorting/Cleansing a Duplicate File
4 direct replies — Read more / Contribute
by perlron
on Oct 25, 2014 at 09:24
    With a desire to write elegant/optimal code in perl,i want to know any suggestions the monks might have to spare me.
    A customer gave me a word document with country (duplicates due to multiple commitees per country)names.
    I need to create a drop down in html showing country names. Hence my trivial code below to read a list of duplicate country names , identify unique names and write them to a file in alphabetical order. Basic stuff.
    #!/usr/bin/perl use strict; my ($key,$name,%countries); open (my $fh1,"<","files/country_listv1.txt") or die $!; while(<$fh1>){ if (!exists $countries{$_}){ $countries{$_} = '1'; } } open (my $fh2,">","files/country_listv2.txt") or die $!; foreach $key (sort keys %countries){ print $fh2 $key; } close($fh1,$fh2);

    Also if there is any glaring mistake pls let me know im getting back to perl after many years.. Even better, do we have some perl code checker available for us to validate scripts / modules ?
    Do not wait to strike when the iron is hot! Make it hot by striking - WB Yeats
Making PDF Tables
2 direct replies — Read more / Contribute
by Anonymous Monk
on Oct 24, 2014 at 15:13
    Hi Monks!
    I need to create a PDF document with a few tables in it, from the code sample of the module PDF::Table its simple to have one table in the same page of a PDF, but I canít figure it out how I would add another table into the same PDF page. Has any of you tried or had to do the same thing using the same module?
    Code Sample
    use PDF::API2; use PDF::Table; my $pdftable = new PDF::Table; my $pdf = new PDF::API2(-file => "table_of_lorem.pdf"); my $page = $pdf->page; # some data to layout my $some_data =[ ["1 Lorem ipsum dolor", "Donec odio neque, faucibus vel", "consequat quis, tincidunt vel, felis."], ["Nulla euismod sem eget neque.", "Donec odio neque", "Sed eu velit."], #... and so on ]; $left_edge_of_table = 50; # build the table layout $pdftable->table( # required params $pdf, $page, $some_data, x => $left_edge_of_table, w => 495, start_y => 750, next_y => 700, start_h => 300, next_h => 500, # some optional params padding => 5, padding_right => 10, background_color_odd => "gray", background_color_even => "lightblue", #cell background color for +even rows ); # second table in the same PDF page $pdftable->table( # required params $pdf, $page, $some_data, x => $left_edge_of_table, w => 500, start_y => 755, next_y => 705, start_h => 305, next_h => 505, # some optional params padding => 5, padding_right => 10, background_color_odd => "navy", background_color_even => "red", #cell background color for even r +ows ); # do other stuff with $pdf $pdf->saveas();

    Thanks for looking!
compare always true in grep
5 direct replies — Read more / Contribute
by RonW
on Oct 24, 2014 at 14:05

    The following worked fine on Linux, but is not working on Win7 Pro (Strawberry Perl 5.18.2 64bit)

    (This uses the expression form of grep)

    #!perl -w use warnings; use strict; my @times = ( 1, 2, 3, 4); print STDERR "Times: @times\n"; if (grep ((0 + $_) >= 99999999), @times) { die('Time values must be < +99999999'); }


    >perl Times: 1 2 3 4 Time values must be < 99999999 at line 9. >
Windows folder access error
4 direct replies — Read more / Contribute
by ArifS
on Oct 24, 2014 at 10:31
    I am getting the following error when try to execute the following code-
    # c:\Folders\1Folder\1aFolder my $directory = "\\Folders\\1Folder\\1aFolder"; print "Folder: ", $directory, "\n"; opendir (DIR, $directory) or die $!; while (my $fldr = readdir(DIR)) { print "Files & Folders: ", $fldr, "\n"; }
    Folder: \Folders\1Folder\1aFolder Invalid argument at c:\temp\dir1A9A.tmp\ line ...##. Press any key to continue . . .
    Pointing to line - opendir (DIR, $directory) or die $!;

    Please let me know
Net::LDAP, Active Directory, Move accounts across domain in forest?
No replies — Read more | Post response
by TomJ_SC
on Oct 24, 2014 at 10:25

    I am not new to Net::LDAP but I am unsure how to approach this problem.

    I have no issues using moddn to move accounts within a domain. However, I have a need to move users from one domain to another in the same Active Directory Forest (2008R2 functional).

    My initial plan was to delete the account from one domain and then create the account in the new domain. This brings up obvious issues (need to migrate emails, password reset to generated default, etc).

    I see that there is an option to move accounts within the same forest. It also appears that moddn does not support this and I do not see any help from Net::LDAP::Extra::AD (although reset_ADpassword and change_ADpassword are awesome-THANKS!). ,/p>

    Any guidance pointers?

    Thanks for your time and reading this.


refine output of Dumper
5 direct replies — Read more / Contribute
by kaka_2
on Oct 24, 2014 at 06:04
    Hello Monks, i have following code which works well. only problem is output does not looks good.
    use strict; use warnings; use Data::Dumper; $Data::Dumper::Terse=1; my $StatChk="cat /tmp/teststatus.txt | grep -v OK"; my $GoodStat="OK"; my @SChk_Out; open (DChk, "$StatChk |") || die "Failed: $!\n"; @SChk_Out = <DChk>; close (DChk); print "Output of command is =".Dumper(@SChk_Out);
    and Output is:
    [ 'Station 7777: Not good. ', 'Station 7778: Not Good ' ]
    how can i have output just
    Station 7777: Not good. Station 7778: Not good.

    it is important that i use the Dumper. in my actual program i cant just print array. (kind of limitation)

    any help in this regard will be appriciated.
Output to STDOUT and print last line to console
4 direct replies — Read more / Contribute
by waytoperl
on Oct 24, 2014 at 00:31

    I have a situation to write output to a file and also print on console or CMD. Need feedback on my non-working code. Thanks.

    #!/usr/bin/env perl -w use strict; use warnings; use Fcntl; use Tie::File; #-- saving result to output.txt open STDOUT, ">", "output.txt" or die "$0: open: $!"; #-- write to output.txt and print on console print "##Start of SCRIPT.PL##\n"; my $run = ""; system($run); #-- open the file tie my @rows, 'Tie::File', 'output.txt', autochomp => 0 or die "error: + $!\n"; #-- print last line of output.txt on console print "$rows[-1]";
split (grep)
2 direct replies — Read more / Contribute
by tbone654
on Oct 23, 2014 at 15:52

    This is driving me crazy... I'm ultimately trying to read in two lists, one with a single column of ordered names... The second list is a column of names with a comma separated (this test script is using semi-colons) value after the name...
    If I were able to do this in unix I would be:

    grep -f file1 file2
    Which is ok, but file1 loses it's order to file2, and what I really want to do is print values from file2 next to the order in file1... so I need to split off values and print the results next to the members of file1 where there is a match...
    But it seems like today I'm too stupid to figure out how to do the split command correctly... Or, other... I could just print the line from list2, but there could be many values and I need to split them out to do math on them after I figure out the problem with split... perldoc -f split tells me it's returning the number of times each line succeeds, where I need to be able to manipulate the results. I've been searching the site for something similar, with no success. Thank you for any help in advance.

    my $a; my @foo = qw/tom steve bill roger bob/; my @bar = qw/roger;99 steve;56 ted;88 tom;54/; for($a=0;$a<@foo;$a++) { printf("%s %s\n",$foo[$a],grep(/$foo[$a]/,@bar)); } print "----\n"; for($a=0;$a<@foo;$a++) { # printf("%s\n", grep(/$foo[$a]/,@bar) ); printf("%s\n", (split /;/, grep(/$foo[$a]/,@bar))[0] ); } --output before split-- tom tom;54 steve steve;56 bill roger roger;99 bob ---- tom;54 steve;56 roger;99 --output using split-- tom tom;54 steve steve;56 bill roger roger;99 bob ---- 1 1 0 1 0
Word OLE add Comments
3 direct replies — Read more / Contribute
by Anonymous Monk
on Oct 23, 2014 at 12:27

    Dear Monks

    I know that my question is not so relevant for Perl, but I really can't find any other information on the Web, so I hope to fine a monk wanting to help me out.

    I need to insert in a Word document comments for words matching a RegExp. So far I put together the following script which is working fine. It highlight all instances of that word in the document. What I'd like to do is to add a comment for that words. I don't find any info for that. Can you point me to the right direction?

    #!/usr/bin/perl use strict; use warnings; use Win32::OLE; use Win32::OLE::Const 'Microsoft Word'; $Win32::OLE::Warn = 3; my $word = get_word(); $word->{Visible} = 1; my $doc=$word->Documents->Open('D:/test.docx'); my $WordToLookup="xy"; FindAndReplace(); sub FindAndReplace{ $word->Selection->HomeKey(wdStory); $word->Selection->Find->{'Text'}=$WordToLookup; $word->Selection->Find->Replacement->{'Highlight'}=1; $word->Selection->Find->Execute({Replace=>wdReplaceAll}); } sub get_word { my $word; eval { $word = Win32::OLE->GetActiveObject('Word.Application'); }; die "$@\n" if $@; unless(defined $word) { $word = Win32::OLE->new('Word.Application', sub { $_[0]->Quit +}) or die "Oops, cannot start Word: ", Win32::OLE->LastError, "\n"; } return $word; }
count down with while loop
4 direct replies — Read more / Contribute
by rshoe
on Oct 23, 2014 at 11:51
    My program should display multiples of a chosen integer between 200 and 100, For example, if a user enters 5, the results would be 200 195 190 etc... The program must use a while loop If anyone can help me I would appreciate it. Thanks. Here is my code
    #!c:\Dwimperl\perl\bin\perl.exe use strict; use warnings; #### prompt a user to enter an integer print "Enter an integer "; my $integer = <STDIN>; chomp $integer; my $i = 199; ### use either a while loop or an until loop to count down from 199 to + 99 while($i >= 99){ ### display all multiples of the integer print $i - $integer . "\n"; --$i; }
perl threads & memory
5 direct replies — Read more / Contribute
by FrankyGT
on Oct 23, 2014 at 07:32

    What's wrong with perl threads?

    If I run this code :

    use threads; sub my_sub() { return 1; } while (1) { my $thr=threads->create(\&my_sub); my @res=$thr->join(); }

    Within 5 minutes my heap has grown to over 50MB and keeps growing...

New Meditations
Refactoring Perl5 with Lua
No replies — Read more | Post response
by rje
on Oct 21, 2014 at 14:31

    WARNING: It may be that I'm simply thinking about Parrot in a different way...

    If you've read my previous post on microperl, then you're sufficiently prepared to take this post with a grain of salt. As a brief summary, I'll re-quote something Chromatic wrote to start me thinking about this problem in general:

    "If I were to implement a language now, I'd write a very minimal core suitable for bootstrapping. ... Think of a handful of ops. Think very low level. (Think something a little higher than the universal Turing machine and the lambda calculus and maybe a little bit more VMmy than a good Forth implementation, and you have it.) If you've come up with something that can replace XS, stop. You're there. Do not continue. That's what you need." (Chromatic, January 2013)

    Warning: I've never written a VM or a bytecode interpreter. I have written interpreters and worked with bytecodes before (okay, a 6502 emulator, but that's basically a bytecode interpreter, right?) Just remember that I'm not posting from a position of strength.

    So I found the Lua opcode set, and it seems a good starting point for talking about a small, though perhaps not minimal, Turing machine that seems to do much of what Chromatic was thinking about... except for XS, which I still haven't wrapped my head around.

    Lua has a register-based 35 opcode VM with flat closures, threads, coroutines, incremental garbage collection... and manages to shoehorn in a tail call, a "for" loop, and a CLOSURE for goodness' sake. And some of those opcodes could be "macros" built on top of other opcodes, rather than atomic opcodes (only if speed were unimportant): SUB, MUL, DIV, POW, LE.

    Again, a disclaimer: I haven't been in a compiler construction class for 25 years, and my career has typically been enterprise coding, data analysis, and tool scripting. Regardless, a small opcode set seems to me to be important for portability. And... 35 codes... well, that's dinky.

    I don't assume that Lua's codes are sufficient for Perl... things are likely missing or just not quite right for Perl. But I have to start somewhere, right? And I figure some of you have the right Domain Knowledge to shed some light on the subject. Right?

    There's lots of neat notes in the aforementioned Lua design doc, written in a clear and concise manner. And now for a brief glance at Lua's opcodes:

On optimizing nested loops
3 direct replies — Read more / Contribute
by FloydATC
on Oct 19, 2014 at 06:05

    While working on a complex script doing lookups and searches on a dozen arrays of hashes (each array representing a relational database table) I stumbled across an extremely simple improvement that instantly gave almost twice the performance.

    The original loop looked like this:

    sub filter { my $where = shift; my @in = @_; # This class method is used to filter an array of hashrefs against a + set of criteria defined in $where. # Example: # @matching_hosts = filter( { site => 56, type => 4 }, @all_hosts) +; # In this example, @matching_hosts will only contain those hashrefs +that would return TRUE for the following code: # ($_->{'site'} eq '56' && $_->{'type'} eq '4') # Note that the "eq" and "&&" are implied; no other operators are su +pported. # The order of the array is not affected. my @out = (); foreach my $record (@in) { my $keep = 1; foreach my $field (keys %{$where}) { unless ($record->{$field} eq $where->{$field}) { $keep = 0; last; } push @out, $record if $keep; } } return @out; }

    The rewritten loop looks like this:

    sub filter { my $where = shift; my @in = @_; # This class method is used to filter an array of hashrefs against a + set of criteria defined in $where. # Example: # @matching_hosts = filter( { site => 56, type => 4 }, @all_hosts) +; # In this example, @matching_hosts will only contain those hashrefs +that would return TRUE for the following code: # ($_->{'site'} eq '56' && $_->{'type'} eq '4') # Note that the "eq" and "&&" are implied; no other operators are su +pported. # The order of the array is not affected. my @out = (); # Make one pass per match term foreach my $field (keys %{$where}) { my $value = $where->{$field}; @out = grep { $_->{$field} eq $value } @in; @in = @out; # Prepare for next pass (if any) } return @out; }

    The running times of actual reports dropped from over 4 seconds to less than 2 seconds. Some of that improvement obviously came from using the built-in grep{} function instead of manually checking each value and push()'ing hashrefs to the @out array, but I didn't expect that much of an improvement.

    There had to be a different explanation, and that got me thinking about the cost of setting up and executing a foreach() loop:

    $ cat foreach_inner #!/usr/bin/perl use strict; use warnings; foreach my $foo (1 .. 3) { foreach my $bar (1 .. 10000000) { my $pointless = "$foo.$bar"; } }
    $ time ./foreach_inner real 0m8.975s user 0m8.954s sys 0m0.013s
    $ cat foreach_outer #!/usr/bin/perl use strict; use warnings; foreach my $foo (1 .. 10000000) { foreach my $bar (1 .. 3) { my $pointless = "$foo.$bar"; } }
    $ time ./foreach_outer real 0m14.106s user 0m14.092s sys 0m0.003s

    Both test scripts do the exact same amount of (pointless) work, the difference between the two scripts is that 'foreach_inner' has to execute 9999997 more foreach() loops than 'foreach_outer'.

    Sometimes, even a seemingly pointless improvement can make a significant difference if made in the right place.

    Now, the way filters are specified in $where is pretty much nailed down because that hashref is built and used in a lot of different contexts. I am still looking for a way to express the whole thing as a single grep{} block to eliminate the looping altogether. Maybe tomorrow.

    -- FloydATC

    Time flies when you don't know what you're doing

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 surveying the Monastery: (3)
As of 2014-10-26 07:25 GMT
Find Nodes?
    Voting Booth?

    For retirement, I am banking on:

    Results (152 votes), past polls