PerlMonks - The Monastery Gates
Description: A community committed to sharing Perl knowledge and coding tips. The site contains questions and answers, useful snippets, and a library of code.
Keywords: perl, mod_perl, regular expressions, regexp, xp whoring, CGI, programming, learning, tutorials, questions, answers, examples, vroom, tim, node, experience, votes, code

good chemistry is complicated, and a little bit messy -LW
| PerlMonks

### The Monastery Gates | Log in Create a new user The Monastery Gates Super Search Seekers of Perl Wisdom Meditations PerlMonks Discussion Obfuscation Reviews Cool Uses For Perl Perl News Q&A Tutorials Poetry Recent Threads Newest Nodes Donate What's New

( #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
What does return() mean? 4 direct replies — Read more / Contribute | by yistaaa on Oct 27, 2014 at 17:12
I'm quite new to perl and there are some confusing things about it that I can't seem to find any information on For example: sub some_thing { return (); } What does that return statement do? Is it a ref to something?
Dive data with automatic array indexing 1 direct reply — Read more / Contribute | by peterp on Oct 26, 2014 at 22:33
Hi, I have a large dataset in a configuration file which I plan on eventually porting to a more practical format, but for various reasons this will be complex, therefore for now I have to deal with it. Historically, multidimensional data structures have been stored as sets of selector style keys and values. For example:
    0.foo.bar = 0foobar
    0.foo.baz = 0foobaz
    1.foo     = 1foo

    equates to:

    [
        {
            foo =>
            {
                bar => '0foobar',
                baz => '0foobaz'
            }
        },
        {
            foo => '1foo'
        }
    ]
    [download]
The data is parsed by splitting the key into its individual components then running them through Data::Diver. The problem is I sometimes need to add data into the middle of the dataset and as a result have to increment index components within keys below this, which can be tedious to say the least. I decided the easiest quick fix would be to pre-process the keys beforehand and automatically calculate the array indexes. Thus the above dataset would look:
    >.foo.bar = 0foobar
    <.foo.baz = 0foobaz
    >.foo     = 1foo
    [download]
Where '>' means "next index // 0" and '<' means "last index // 0", within scope of the dimension. I wrote the following demo:
    use strict;
    use warnings;
    use Data::Diver  qw#DiveVal DiveError#;
    use Data::Dumper qw#Dumper#;

    $/ = qq#\r\n#;

    my $state = { };
    my $ref   = undef;

    while ( my $line = <DATA> )
    {
        next if ( $line =~ qr#^(\#|\s*$)# ); # ignore line if comment or b
    +lank.

        chomp $line; # remove newline.

        my ( $selector, $value ) = split qr#\s*=\s*#, $line; # (selector)=
    +(value). todo: unless escaped.

        next if ( not defined $selector ); # ignore line if no selector.

        my @selector = split qr#\.#, $selector; # (one).(two).(three)... t
    +odo: unless escaped.

        $ref //= ( $selector[0] =~ qr#^([><]|\d+)$# ) ? [ ] : { } ;

        _dive( $ref, \@selector, $value );
    }

    print Dumper $state, $ref;

    sub _dive
    {
        my ( $ref, $selector, $value ) = @_;

        return if ( not defined $ref or not defined $selector or not scala
    +r @$selector ); # return if no ref or no selectees.

        my @selector_b = qw##;

        for my $selectee ( @$selector )
        {
            if ( $selectee =~ qr#^([><])$# ) # if incognito selectee. todo
    +: unless escaped.
            {
                my $selector_b = join q#.#, @selector_b;

                if ( $1 eq q#># ) # incognito selectee is of increment typ
    +e.
                {
                    if ( defined $state->{$selector_b} ) # we have seen th
    +is state before.
                    {
                        push @selector_b, $state->{$selector_b} += 1; # pu
    +sh current index + 1.
                    }
                    else
                    {
                        push @selector_b, $state->{$selector_b} = 0; # pus
    +h 0 (first) index.
                    }
                }
                elsif ( $1 eq q#<# ) # incognito selectee is of maintain t
    +ype.
                {
                    push @selector_b, $state->{$selector_b} //= 0; # push
    +current index or 0 (first) index.
                }
            }
            else # else non inconito selectee.
            {
                push @selector_b, $selectee; # push selectee.
            }
        }

        DiveVal( $ref, @selector_b ) = $value;
        my ( $error ) = DiveError( );
        $error and warn $error;

        return 1;
    }

    __DATA__

    >.name          = john
    <.location      = uk
    <.interests.>   = programming
    <.interests.>   = cycling

    >.name          = laura
    <.location      =
    <.interests.>   = knitting
    <.interests.>   = tennis
    <.interests.>   = dancing

    >.name
    <.location      = canada
    <.interests.>.> = dogs
    <.interests.<.> = horses
    <.interests.>   = cars

    # test.error = blah
    [download]
Output:
    $VAR1 = {
              '2.interests' => 1,
              '' => 2,
              '2.interests.0' => 1,
              '0.interests' => 1,
              '1.interests' => 2
            };
    $VAR2 = [
              {
                'interests' => [
                               'programming',
                               'cycling'
                             ],
                'location' => 'uk',
                'name' => 'john'
              },
              {
                'interests' => [
                               'knitting',
                               'tennis',
                               'dancing'
                             ],
                'location' => '',
                'name' => 'laura'
              },
              {
                'interests' => [
                               [
                                 'dogs',
                                 'horses'
                               ],
                               'cars'
                             ],
                'location' => 'canada',
                'name' => undef
              }
            ];
    [download]
Is this a good approach, or is there a better alternative? Perhaps I should look into extending Data::Diver's DiveRef function? Can my code be improved, I don't mind a bit of golfing, but I'm concerned there could be a particular scenario that I've missed where my code could break? Chris
Perl version issue? 3 direct replies — Read more / Contribute | by T-Fen on Oct 25, 2014 at 22:06
Hello perl monks- I'm on a Mac and recently upgraded from Mavericks to Yosemite which might be the cause of my current issue. I am using mutt with t-prot and getting the following error when attempting to view a message in mutt (which invokes t-prot) `'Can't locate Locale/gettext.pm in @INC (you may need to install the Locale::gettext module) (@INC contains: /Library/Perl/5.12 /Library/Perl/5.18/darwin-thread-multi-2level /Library/Perl/5.18 /Network/Library/Perl/5.18/darwin-thread-multi-2level /Network/Library/Perl/5.18 /Library/Perl/Updates/5.18.2 /System/Library/Perl/5.18/darwin-thread-multi-2level /System/Library/Perl/5.18 /System/Library/Perl/Extras/5.18/darwin-thread-multi-2level /System/Library/Perl/Extras/5.18 .) at /usr/local/bin/t-prot line 1147.` When i do a search for getttext, I see the following:
    /Library/Perl/5.16/darwin-thread-multi-2level/Locale/gettext.pm
    /Library/Perl/5.16/darwin-thread-multi-2level/auto/Locale/gettext
    /Library/Perl/5.16/darwin-thread-multi-2level/auto/Locale/gettext/.pac
    +klist
    /Library/Perl/5.16/darwin-thread-multi-2level/auto/Locale/gettext/gett
    +ext.bs
    /Library/Perl/5.16/darwin-thread-multi-2level/auto/Locale/gettext/gett
    +ext.bundle
    /Previous System/Library/Perl/5.16/darwin-thread-multi-2level/auto/Loc
    +ale/gettext
    /Previous System/usr/local/Cellar/gettext/0.19.3/share/doc/gettext/exa
    +mples/hello-perl
    /Previous System/usr/local/Cellar/gettext/0.19.3/share/doc/gettext/exa
    +mples/hello-perl/m4
    /Previous System/usr/local/Cellar/gettext/0.19.3/share/doc/gettext/exa
    +mples/hello-perl/po
    /usr/local/Cellar/gettext/0.19.3/share/doc/gettext/examples/hello-perl
    /usr/local/Cellar/gettext/0.19.3/share/doc/gettext/examples/hello-perl
    +/INSTALL
    /usr/local/Cellar/gettext/0.19.3/share/doc/gettext/examples/hello-perl
    +/Makefile.am
    /usr/local/Cellar/gettext/0.19.3/share/doc/gettext/examples/hello-perl
    +/autoclean.sh
    [download]
So seeing that @INC doesn't appear to look in /Library/Perl/5.16/ I then added the path using: `$ PERL5LIB=/Library/Perl/5.16/darwin-thread-multi-2level/; export PERL5LIB` Doing that, I now get this error when trying to view a message with mutt/t-prot:
    'Perl API version v5.16.0 of v5.16.0 does not match v5.18.0 at /System
    +/Library/Perl/5.18/darwin-thread-multi-2level/DynaLoader.pm line 217.

    +
    +
    +                                            Compilation failed in req
    +uire at /usr/local/bin/t-prot line 1147.
    [download]
/Library/Perl/ contains a /5.16 and a /5.18 directory but looks like anything related to gettext is only in /5.16. Looking for guidance on how to fix this so that the needed files are found. Thanks!
how to extract script output in new text file ? 5 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;
        }
    }
    [download]
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
Hi, 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);
    [download]
update I still have one issue the comma character appears as TM. I suspect its a encoding issue of my text file. I am using textedit on a mac which doesnt seem to have a save as UTF8 option.strange. Im just updating this query than create a new one. Im going to try some options but please tell me which is the best way out, as this problem seems a generic one. use utf8 encoding in my perl script. recreate the text file in vim any other options ? Do we have some perl code checker available for us to validate scripts / modules ? Thanks 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 cant 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();

    [download]
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'); }
    [download]
Output:
    >perl ptest.pl
    Times: 1 2 3 4
    Time values must be < 99999999 at ptest.pl line 9.
    >
    [download]
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";
        }
    [download]
Error-
    Folder: \Folders\1Folder\1aFolder

    Invalid argument at c:\temp\dir1A9A.tmp\read.pl line ...##.
    Press any key to continue . . .
    [download]
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. Tom
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);

    [download]
and Output is:
    [
              'Station 7777: Not good.
    ',
              'Station 7778: Not Good
    '
            ]
    [download]
how can i have output just
    Station 7777: Not good.
    Station 7778: Not good.
    [download]
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 = "SCRIPT.pl";
    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]";

    [download]
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
    [download]
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

    [download]
New Meditations
Reanimating regular issue: Indirect Object Notation 2 direct replies — Read more / Contribute | by McA on Oct 27, 2014 at 06:22
Hi all, as a regular reader of the Perlweekly newsletter I stumbled on this entry in Edition #170: Stop using indirect object notation. In the same moment I thought: Didn't I ask something related some time ago? Yes, I did. And I found it: Reference needed. So, I bring this to awareness once again. The reactions on twitter are interesting. IMHO the very first action that could be taken: Change all (changeable) documentation where `new Class` is used. Because most people don't care. They're copy&pasting the examples and synopsis of CPAN modules. And you can find this indirect notation on CPAN. Regards McA
Refactoring Perl5 with Lua 1 direct reply — Read more / Contribute | 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: Read more... (3 kB)
Log In?
Username: |
Password: |
remember me What's my password? Create A New User
Chatterbox?
and the web crawler heard nothing... How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (15) GrandFather davido toolic talexb Athanasius atcroft Tux MidLifeXis dorko poj GotToBTru Loops mandarin chusqui perlron As of 2014-10-28 15:20 GMT
Sections?
Seekers of Perl Wisdom Cool Uses for Perl Meditations PerlMonks Discussion Categorized Q&A Tutorials Obfuscated Code Perl Poetry Perl News about
Information?
PerlMonks FAQ Guide to the Monastery What's New at PerlMonks Voting/Experience System Tutorials Reviews Library Perl FAQs Other Info Sources
Find Nodes?
Nodes You Wrote Super Search List Nodes By Users Newest Nodes Recently Active Threads Selected Best Nodes Best Nodes Worst Nodes Saints in our Book
Leftovers?
The St. Larry Wall Shrine Buy PerlMonks Gear Offering Plate Awards Random Node Quests Craft Snippets Code Catacombs Editor Requests blogs.perl.org Perlsphere Perl Ironman Blog Perl Weekly Perl.com Perl 5 Wiki Perl Jobs Perl Mongers Perl Directory Perl documentation MetaCPAN CPAN
Voting Booth?
#### For retirement, I am banking on: My savings account My retirement account My investments Social Security Winning the lottery A Post-scarcity economy Retirement?! You'll have to pull the keyboard from my cold, dead hands I'm independently wealthy Other Results (181 votes), past polls