unknown-monk has asked for the wisdom of the Perl Monks concerning the following question:

Dear Monks,
let's start with my first question regarding Perl/Tk.

I have a Perl command and need to put it in my Perl/Tk application into a sub-routine, but I don't know how to do that.
I've played with system() but it won't work. The Perl command looks like following:

$ perl -lne 'foreach (glob "$_/*"){print if !/Makefile[.inc]*$/}' zz.lis

sub scan {
  $listbox->insert('end', "Scanning...");
# the mentioned perl command should be placed here
  $listbox->insert('end', "Done.");
}

In my second question I'd need a Perl equivalent for this shell command:

ls -l | grep ^d | grep -v Mk | grep -v Templates | grep -v Tools | grep -v distfiles | cut -c57-69

I can put this command in system(), and it works, but it does not look clean.
Besides it might not work on another machine(s), bcs. of the cut command?
In fact it will print a list of directories and skip directories, which names are "Mk", "Templates", "Tools" and "distfiles".

Kind regards,
unknown-monk

Replies are listed 'Best First'.
Re: 2 questions about Perl/Tk and Perl
by Corion (Patriarch) on Apr 03, 2010 at 17:31 UTC

    Maybe you want to inform yourself what these snippets do respectively, and then write the Perl code to do each of the snippets?

    For the first snippet, I recommend looking at the B::Deparse output:

    perl -MO=Deparse -lne 'foreach (glob "$_/*"){print if !/Makefile[.inc] +*$/}'

    For the second snippet, look at the following functions:

    1. opendir, readdir
    2. grep

    Of course, you could instead opt for just running these commands from Perl, but then you will need to have grep and cut installed on the target machines.

      Hi,
      first of all I want to say that I could fairly easy replace my second snippet with the opendir/readdir thing. Great!

      -MO=Deparse is a very useful thing. Thanks for that.
      I was trying to adapt it for my needs but it didn't work as it should.
      It simply processes the first record (accessibility) and than hangs.
      sub scan { $lb1->insert('end', "Scanning..."); my $counter = '0'; my $file = '/usr/ports/y.lis'; my $outf = '/usr/ports/yyy.lis'; open(ARGV,$file) or die $!; open(OUTF,">$outf") or die $!; BEGIN { $/ = "\n"; $\ = "\n"; } LINE: while (defined($_ = <ARGV>)) { chomp $_; use File::Glob (); foreach $_ (glob("$_/*")) { if (!/Makefile(.inc|)$/) { printf OUTF "$_\n"; } else { $counter++; } } close(ARGV); close(OUTF); print "processed $counter records."; $lb1->insert('end', "Done."); } }
      The content of the /usr/ports/y.lis file is as following:
      accessibility arabic archivers astro audio ...and about 70 more.
      The content of the /usr/ports/yyy.lis file (produced by the code above) is as following:
      accessibility/accerciser accessibility/at-poke accessibility/at-spi accessibility/at-spi-reference accessibility/atk accessibility/atk-reference accessibility/dasher accessibility/eflite accessibility/gail accessibility/gail-reference accessibility/gir-repository-atk accessibility/gnome-mag accessibility/gnome-speech accessibility/gnopernicus accessibility/gok accessibility/java-access-bridge accessibility/kdeaccessibility accessibility/kdeaccessibility4 accessibility/linux-atk accessibility/linux-f10-atk accessibility/linux-f8-atk accessibility/mousetweaks accessibility/orca accessibility/py-papi accessibility/qt4-accessible accessibility/ruby-atk accessibility/speech-dispatcher accessibility/yasr
      Anybody has an idea why it hangs?

      Besides I need $lb1->insert('end', "Scanning..."); to take effect before the processing starts, instead the Scanning... and Done. line appear at the same time after all is done, at least in my second code which works, but needs two sub-routines:

      sub scan { $lb1->insert('end', "Scanning..."); my $counter = '0'; my $file = '/usr/ports/y.lis'; my $outf = '/usr/ports/yy.lis'; open(ARGV,$file) or die $!; open(OUTF,">$outf") or die $!; BEGIN { $/ = "\n"; $\ = "\n"; } LINE: while (defined($_ = <ARGV>)) { chomp $_; use File::Glob (); foreach $_ (glob("$_/*")) { printf OUTF "$_\n"; $counter++; } } close(ARGV); close(OUTF); print "processed $counter records."; $lb1->insert('end', "Done."); clean(); } sub clean { $portscount = '0'; $ifile = '/usr/ports/yy.lis'; $ofile = '/usr/ports/yyy.lis'; open(IFILE, $ifile) or die $!; open(OFILE,">$ofile") or die $!; while (<IFILE>) { $_ =~ s/\s+//g; if (!/Makefile(.inc|)$/) { printf OFILE "$_\n"; } else { $portscount++; } } close(IFILE); close(OFILE); print "processed $portscount records."; }
      I've tried to merge (not only append!) these two sub-routines all night long without success.

      Kind regards,
      unknown-monk

      P.S.: I wonder if it's too "noobish" to simply live with this two sub-routines.
Re: 2 questions about Perl/Tk and Perl
by BrowserUk (Patriarch) on Apr 03, 2010 at 19:37 UTC
    1. Something like this might work:
      sub scan { $listbox->insert('end', "Scanning..."); open CMD, qq[perl -lne "foreach (glob '$_/*'){print if !/Makefile[.inc]*$/}" + zz.lis] or die $!; while( <CMD> ) { chomp; $listbox->insert( 'end', $_ ); DoOneEvent(); } $listbox->insert('end', "Done."); }

      Though you should probably look at Tk::Event and/or Tk::fileevent

    2. On win you could use dir /b /a:d | find /v "Mk" | find /v "Templates" |find /v "Tools" | find /v "distfiles"

    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
      Hi,
      1. It didn't work. I've tried it exactly as you have suggested and I've modified it in every single way. No success.
      2. It's good to know, but currently i code on/for FreeBSD.

      Best regards,
      unknown-monk
Re: 2 questions about Perl/Tk and Perl
by toolic (Bishop) on Apr 03, 2010 at 18:03 UTC
      Thanks!

      Kind regards,
      unknown-monk