Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW

Seekers of Perl Wisdom

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

If you have a question on how to do something in Perl, or you need a Perl solution to an actual real-life problem, or you're unsure why something you've tried just isn't working... then this section is the place to ask. Post a new question!

However, you might consider asking in the chatterbox first (if you're a registered user). The response time tends to be quicker, and if it turns out that the problem/solutions are too much for the cb to handle, the kind monks will be sure to direct you here.

User Questions
Critique of my "WebServerRemote" module
No replies — Read more | Post response
by nysus
on Feb 27, 2017 at 07:37

    If you are bored and looking for someone to beat some sense into, read on. Note: this post is somewhat of a followup to my question yesterday.

    First, a little background to put this in context. I started learning Perl in the late 90s. I'm a very on again/off again programmer. I don't code for a living and I write some hellacious spaghetti code. But every year or two I get the programming bug but usually end up biting off more than I can chew and/or get sidetracked with other stuff. But the last couple of weeks I've decided to pour my heart into getting as good as I can get at programming with perl so I can take on some larger projects I'd like to work on. First, to sharpen my chops, I decided to work on a smaller project, a family of modules and roles to manipulate my webserver from my local machine. The primary purpose of this project is not to write the best possible mechanism for issuing commands to a remote server. While I want this program to be useful, its primary purpose is to help me cut my teeth more with Moose, seeing what it can do, and getting more adept with it and other tools (like testing, vim, etc.).

    So anyway, what I'm looking for is a critique of what I have to see if I'm way out to lunch. I'm particularly concerned with how I'm using roles, which seems very convoluted. I'll explain in more detail as I show the code below. I have more to code but I'm far enough along to have enough shape to it. What I have written so far works and has been tested. Feel free to bash me. I can take it.

    So first I have my WebServerRemote class. It is intended to be the kind of glue that holds my family of my modules together and does odd tasks and delegates other tasks out to other modules and subclasses:
    package WebServerRemote 0.000001; use Carp; use Moose; use Data::Dumper; use Modern::Perl; use Params::Validate; use MyWebsite; use namespace::autoclean; with 'MyOpenSSH'; with 'Apache2Info'; sub get_file { validate_pos(@_, 1, 1); my $self = shift; my $file_path = shift; return $self->capture("cat $file_path"); } # get website objects based on domain name sub get_websites { validate_pos(@_, 1, 1); my ($self, $domain) = @_; my @websites = (); # website o +bjects my $config_files = $self->lookup_config_files($domain); # list of c +onfig files croak 'No config files found with ' . $domain if !@$config_files; foreach my $file (@$config_files) { my $config = $self->get_file($file); #my @cmds = qw( servername, suexecusergroup, customlog, serveralia +s ); foreach my $docroot (@{$self->get_docroots_from_string($config)}) +{ my $vh = $self->get_vh_context($config, 'documentroot' +, $docroot); my @aliases = (); my $aliases = ''; while (my $alias = $vh->cmd_config('serveralias')) { push @aliases, $alias; } $aliases = join ', ', @aliases; my $suexec = $vh->cmd_config('suexecusergroup') || ''; my $servername = $vh->cmd_config('servername') || ''; my $errorlog = $vh->cmd_config('errorlog') || ''; push @websites, MyWebsite->new ( docroot => $docroot, apache_config_path => $file, domain => $servername, suexecgroup => $suexec, aliases => $aliases, error_log => $errorlog, ssh => $self->ssh->get_user . '@' . $self +->ssh->get_host, ); } } return \@websites; } sub check_dir_for_files { validate_pos(@_, 1, 1, 1); my $self = shift; my $dir = shift; my $files = shift; my $listing = $self->capture('ls -1 ' . $dir); my %files = map { $_ => 1 } split /\n/, $listing; my @fail = (); # $files can be a scalar or an array if (ref $files) { push @fail, grep { !exists $files{$_} } @$files; return !@fail; } else { return $files{$files}; } } ##########################################

    The module above consumes two roles. First, there is MyOpenSSH which is just a wrapper for Net::OpenSSH:

    package MyOpenSSH 0.000001; use Carp; use Data::Dumper; use Moose::Role; use Modern::Perl; use Net::OpenSSH; use Params::Validate; has 'ssh' => (is => 'rw', isa => 'Net::OpenSSH', required => 1, lazy = +> 0, handles => qr/[^(capture)]/, ); around BUILDARGS => sub { my $orig = shift; my $class = shift; my %args = ref $_[0] ? %{$_[0]} : @_; croak 'a host must be supplied for ssh: ssh => (\'<user>@<host>\', % +opts)' if !%args; my ($host, %opts) = $args{ssh}; return $class->$orig( %args) if ref $host eq 'Net::OpenSSH'; delete $args{ssh}; my $ssh = Net::OpenSSH->new($host, %opts); $ssh->error and croak "could not connect to host: $ssh->error"; return $class->$orig( ssh => $ssh, %args ); }; # wrapper for system method sub exec { validate_pos(@_, 1, 1); my $self = shift; my $cmd = shift; $self->ssh->system($cmd) || carp 'Command failed: ' . $self->ssh->er +ror; } # wrapper for capture method sub capture { validate_pos(@_, 1, 1); my $self = shift; my $cmd = shift; $self->ssh->capture($cmd) || carp 'Command failed: ' . $self->ssh->e +rror; } ###########################################

    Now, I'm sure the first question will be, "Why is he using Net::OpenSSH and not just doing it directly on the machine?" Well, mostly because I wanted to get familiar with it and also because I want to be able to develop everything on my local machine to see if it can be done. I'm sure the other question will be "Why a wrapper for Net::OpenSSH?" The answer to that is twofold: I wanted to see how it might be done and two, I don't want to have to remember how to construct a Net::OpenSSH object. I can now create a WebServerRemote object with something as simple as $wsr = WebServerRemote(ssh => me@host). Yeah, I'm that lazy.

    I found some nice side benefits to wrapping Net::OpenSSH. For example, I can automatically check for errors every time I run a command on the remote server.

    Now, the BUILDARGS is the most interesting (convoluted?) feature of the Net::OpenSSH role. It was hacked together with trial and error until I got it to work. I will get back to this later. It's a doozy.

    So, the other role I have is called Apache2Info. Its job is to do boring things related to retrieving information from Apache config files. So far, it mostly has methods I will use for reporting. I've left out a lot of the code of this role because it's not very interesting or pertinent to this post:

    package Apache2Info 0.000001; use Carp; use Try::Tiny; use File::Spec; use File::Util; use Moose::Role; use Data::Dumper; use Modern::Perl; use File::Listing; use File::Basename; use Params::Validate; use Apache::ConfigFile; requires 'ssh'; # get document roots of a config file sub get_docroots_from_string { --snip-- } # searches a config file string for a command and returns virtual host + config # if a match is found sub get_vh_context { --snip-- } # Apache::ConfigParser requires a path to a file as an argument # so we save contents to a file first and then read it sub _read { --snip-- } # get list of absolute, non-canonical paths to all apache configuratio +n file sub get_enabled_apache_config_filenames { --snip-- } # get a listing of all directories where config files reside sub get_config_file_dirs { --snip-- } # get all docroots sub get_all_docroots { --snip-- } # find the config files for a given domain name sub lookup_config_files { --snip-- ###############################################

    The only really interesting thing here is the requires 'ssh' bit because this role needs a Net::OpenSSH functionality to get stuff from the server. I satisfy that in my consumers by having an ssh attribute. You'll notice the ssh attribute is supplied by the MyOpenSSH role. This is also where stuff gets kind of convoluted.

    The last piece of the puzzle is the MyWebsite class which extends WebServerRemote. I'm not sure if this is a good idea or not but in the interest of experimenting I decided to try it and see what happens. My thinking on this was that since I want my website objects to use the MyOpenSSH role and Apache2Info, that I could just extend WebServerRemote and have those features automatically included. Also, there are methods in WebServerRemote that will be used by my MyWebsite. So, anyway, here is the code:

    package MyWebsite 0.000001; use Carp; use Moose; use Modern::Perl; use Drupal; use WordPress; extends 'WebServerRemote'; with 'MyOpenSSH'; use namespace::autoclean; has 'db' => (is => 'rw', isa => 'Str', required => 0, +lazy => 1, default => '', ); has 'ver' => (is => 'rw', isa => 'Str', required => 0, +lazy => 1, default => '', ); has 'type' => (is => 'ro', isa => 'Str', required => 0, +lazy => 1, builder => '_set_type'); has 'domain' => (is => 'rw', isa => 'Str', required => 0, +lazy => 1, default => '', ); has 'aliases' => (is => 'rw', isa => 'Str', required => 0, +lazy => 1, default => '', ); has 'docroot' => (is => 'rw', isa => 'Str', required => 1, +lazy => 0 ); has 'db_user' => (is => 'ro', isa => 'Str', required => 0, +lazy => 1, default => '', writer => '_set_dbuser', ); has 'db_pass' => (is => 'rw', isa => 'Str', required => 0, +lazy => 1, default => '', ); has 'root_dir' => (is => 'rw', isa => 'Str', required => 0, +lazy => 1, default => '', ); has 'error_log' => (is => 'rw', isa => 'Str', required => 0, +lazy => 1, default => '', ); has 'site_config' => (is => 'rw', isa => 'Str', required => 0, +lazy => 1, default => '', ); has 'suexecgroup' => (is => 'rw', isa => 'Str', required => 0, +lazy => 1, default => '', ); has 'apache_config' => (is => 'rw', isa => 'Str', required => 0, +lazy => 1, default => '', ); has 'site_config_path' => (is => 'rw', isa => 'Str', required => 0, +lazy => 1, default => '', ); has 'apache_config_path' => (is => 'rw', isa => 'Str', required => 0, +lazy => 1, default => '', ); sub _set_type { my $self = shift; # check for drupal multi site if ($self->check_dir_for_files($self->docroot, ['sites', 'includes', + 'modules'])) { $self = Drupal->meta->rebless_instance($self); return 'drupal'; } if ($self->check_dir_for_files($self->docroot, 'wp-config.php')) { $self = WordPress->meta->rebless_instance($self); return 'wordpress'; } if ($self->check_dir_for_files($self->docroot, 'settings.php')) { $self = Drupal->meta->rebless_instance($self); return 'drupal'; } } ##############################################

    So, I have to have the with 'MyOpenSSH'; bit in there. I thought by extending MyWebsite I wouldn't need that. However, when I remove that line, things break when the _set_type method gets run. I get an error saying there is no capture method which is found in MyOpenSSH. But putting this line wreaked all other kinds of havoc. I think the ssh attribute was trying to get set twice. I'm not sure. Anyway, after fiddling with the BUILDARGS method of MyOpenSSH and playing with the order of the with statements, I was able to get it to work somehow. I feel in my bones this is a horrible hack but I don't know how to fix it properly.

    The other thing I do is apparently what's called an "object factory" where the MyWebsite object detects what kind of website it is and then subclasses itself when the _set_type method is called. Perhaps this is a bad idea. I'm not sure if there's a real good reason to do it except to see if it can be done. But I'm thinking it may come in handy because different kinds of websites will have different methods.

    Alright, that's it. Feel free to beat on me if this is a ridiculous mess. :)

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

Recursive Module Dependencies
1 direct reply — Read more / Contribute
by 13gurpreetsingh
on Feb 27, 2017 at 06:03
    Hi Monks,

    Tried searching many a times, but couldn't find. I believe there isn't a real solution to my problem, but might be !!

    So, I am working on Company Servers where I deploy modules in separate directory due to root permission issues and use them via PERL5LIB or 'use lib'.

    But problem comes when installing each module goes up and up with recursive dependencies. I have proxy restrictions due to which I can't connect to internet on shell and directly install via cpan. Each module, and thereafter its parent module, I have to download, unzip and install manually.

    Is there a way I can view all the dependencies of a module I am going to install on browser itself and view the order of installation?

    If it is possible, I will go and download them one by one and install it in that manner instead of opening multiple sessions to a server, multiple browser windows, doing scp from my local windows machine, unzip and blah blah. Although this is also a manual work, but atleast a bit better.

    Thanks for your help in advance.

Design question for berrybrew update
No replies — Read more | Post response
by stevieb
on Feb 26, 2017 at 17:36

    Hey all,

    So thankfully, Strawberry Perl is in the beginning stages of providing a JSON document with all of their releases. Here is their first example/mockup.

    Currently, in berrybrew, I hand pick releases, add them into an existing JSON file within the install, and allow others to manually edit this file as they see fit.

    The entire list is quite long, even using just the portable editions. For instance, each version has a 32-bit and a 64-bit cut, and each 32-bit cut has both a "with USE_64_BIT_INT" and "without USE_64_BIT_INT". I like the entire default list to show up in one cmd window without scrolling.

    My question is essentially looking for assistance on how I should decide which versions to include. First, the list file will be included in each distribution as it currently was when that release is done. The user will have to manually run a command line command to fetch any updates.

    I'm thinking about including only all 32 and 64 bit portable editions in the berrybrew available command, with some options to include others:

    berrybrew update_perls # only look for new default includes berrybrew update_perls include PDL berrybrew update_perls include 64_BIT_INT berrybrew update_perls all

    etc. After the new JSON data is fetched, we'll run a routine that will reformat everything to how it is used internally.

    What are your thoughts on this? If you use Perlbrew, is there anything you wish was/wasn't being done?

    All suggestions welcome, as I'm in the extremely early stages of drumming up a design on how this will be approached (and hopefully, make decent decisions early on, as to minimize work after if it needs to be modified).

    berrybrew is developed in C#. It is currently being reviewed for porting to C++ because I desire to get rid of the .Net requirement, if possible. However, that doesn't affect the outcome of this particular question. That said, any and all suggestions to how the software operates or acts is welcome, as I'm a *nix person by default, and would love feedback of all sorts from my fellow Monks who use Windows.

UP-TO-DATE Comparison of CGI Alternatives
5 direct replies — Read more / Contribute
by iaw4
on Feb 26, 2017 at 17:18

    A comparison of tradeoffs using various web technologies should probably be a FAQ and updated once a year. The web is important, and unlike ruby and rails (or python and django?), there is really not one recommended dominating web framework in perl to start with.

    I am going to start this post with what I understand.

    • was a simple low- or mid-level framework. It has been deprecated. It is still supported for existing projects, but no one should start a new web project with it.
    • PSGI/Plack is expressly middleware. While powerful and stable, it really is not designed for writing websites, but designed for use in higher-level frameworks. The authors are not too happy with (or equipped to) handle large number of noobie requests on how to use it, and the examples in the documentation are modest.
    • The two primary choices for new modest-size websites are Dancer2 and Mojolicious. They have good documentation and are suitable for newbies. (Both frameworks are or can be users of PSGI/Plack, but this is transparent to the user programmer.) They are good high-level, but not stable. In particular, I know that Mojolicious is evolving---projects can break upon M updates. I don't know about Dancer2.
    • For large projects, Catalyst becomes a third alternative.

    So, for someone new who wants to learn how to code a website, there seem to be two primary perl choices. If my reading of the landscape is not correct, then please correct it. And if someone could please post the pros and cons of Dancer2 and Mojolicious---so that one does not have to learn both first to start with one---it would be helpful.

    Personal Observation: What I liked about and Plack/PSGI over the frameworks was that lower-level code makes it easier to determine what perl code was responsible for displaying a given web page. With the frameworks, by the time all routes, templates, injections, etc., are considered, it becomes hard to trace how the given web page has been built. Where web programs are one's primary responsibility and used every day for years, the linkage within the frameworks is not a problem. One remembers instantly what was where. Where web programs are occasional tasks, separated by long periods of neglect, this becomes more difficult.

    thanks in advance to the experts for illuminating the issues.

Converting Moose object to a subclass of itself
3 direct replies — Read more / Contribute
by nysus
on Feb 26, 2017 at 14:42

    I have a Moose class which represents websites on a server, call it the Website class. This is a parent class of two subclasses: Website::Drupal and Website::WordPress. Website objects start out as a generic. Once the object "learns" which type of object it is, I'd like it to subclass itself as Website::WordPress or Website::Drupal. I believe that "coercion" is what I need to do. I read this but I couldn't really make heads or tails of it and so I'm not sure if I'm on the right track. If someone could give me some hints to steer me in the right direction, I'd appreciate it.

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

Open an application from windows registry
2 direct replies — Read more / Contribute
by ElAlx
on Feb 26, 2017 at 09:36
    Hello Monks, I'm writing a script which could automatically open a specific version of programm by using the path in windows registry using Win32::TieRegistry. How can i place a variable into the string so that will work?
    use Win32::TieRegistry (Delimiter => '/'); my $version=2.1; my $mykey = $Registry->{'HKEY_LOCAL_MACHINE/Software/SPS/$version'}; my $mykeyval = $mykey->{'/AppsDir'}; $mykeyval2="$mykeyval"."\\start.exe"; system("$mykeyval2");
    I tried to find something for my problem but with no luck. I would appreciate your help! Thank you!
Testing my tests
3 direct replies — Read more / Contribute
by szabgab
on Feb 26, 2017 at 08:52
    Devel::Cover can easily show if a certain function or expression was executed during the test run, but it cannot tell if there was an assertion checking the validity of the result.

    One could randomly change the code under test (e.g. replace a + by a - ) and run the tests again. If they still pass, we have a problem. The tests do not check that code properly.

    Is there a tool for Perl that would automate this process?

    For further clarification, I'd like to change the source code of the module or application under test and leave my tests unchanged.

    Update: Use Case

    To further elaborate assume you have a huge code-base with a huge test suite. You pick a module that has 100% coverage and wonder can I safely refactor this? Will the test suite catch if I make a mistake? Lanx gave an excellent and very simple example of code with a problematic test
    sub foo { my ($x, $y) = @_; return $x + $y; }
    The test:
    is foo(2, 0), 2
    How can I estimate the risk of changing this code? One possible way is to change the code in a way that should break it and see if the tests fail. So I'd have a tool that can introspect the source code of my application and change the code at a random place. e.g. it would change the + in the above function to -. (No mocking, really changing the code on the disk.)

    The tests would still pass.

    This is an indication that the tests don't protect me at that point.

Not Coder reference error - when i pass function by Refernce
2 direct replies — Read more / Contribute
by pks283
on Feb 25, 2017 at 17:07

    Hi, i need help with below implementation of passing function by reference. I am passing add function to multiply function. It executes first time correctly, but fails next time executing function passed by reference. I have played with code and not able to figure out what i am missing. Below is my code.

    use strict; use warnings; our $static_counter = 1; sub add{ my ($x, $y) = @_; my $sum = $x + $y; print "Sum within function: $sum\n"; return ($sum); } sub counter { my $cnt = $static_counter++; print "Value of count in subroutine $cnt\n"; return($cnt); } sub multiply{ my ($x, $y, $add_ref, $counter_ref) = @_; my $cnt_in; my $add_in; my $mul = 1; $mul = ($x * $y * $$add_ref * $counter_ref->()); print "Multi : $mul\n"; $add_in = $add_ref->(20,5); ### Getting Error Here ### Not a Code Reference $mul = ($x * $y * $add_in * $counter_ref->()); print "Multi : $mul\n"; return $mul; } sub a { my $z; $z = multiply(4,5, \&add(10,1), \&counter); $z = multiply(4,5, \&add(10,1), \&counter); } a();
Can't get progress bar or main window to update using Tkx
1 direct reply — Read more / Contribute
by Anonymous Monk
on Feb 25, 2017 at 16:41

    Hi monks, I have a main window update question. I have a simple but long script that runs as a subroutine when the user makes some selections in the main window. I'm having an update issue with the progress bar. I tried using fork by I got an error due to an line using SMTP in the subroutine. I'm thinking fork may not be he best solution and that I'm missing something. Here's a stripped down example of my code:

    use strict; use warnings; #use Mozilla::CA; use Tkx; use Tcl::Tk; #set window geometry and options my $mw = Tkx::widget->new("."); $mw->g_wm_minsize(400, 500); $mw->g_wm_title(my $title); my $b; $b = $mw->new_button( -text => "Run", -command => \&run, #); #Tkx::after(500, sub { $mw->g_destroy }); #}, ); $b->g_pack( -padx => 10, -pady => 10, ); #Quit button my $b2; $b2 = $mw->new_button( -text => "Quit", -command => sub { $b2->m_configure( -text => "Quit", ); CORE::exit; Tkx::after(500, sub { $mw->g_destroy }); }, ); $b2->g_pack( -padx => 10, -pady => 10, ); #Table Output Tkx::package_require("Tktable"); $mw = Tkx::widget->new("."); my $t = $mw->new_table( -rows => 5, -cols => 3, ); $t->g_pack; #Progress Bar my $progress = "10"; my $overall_progress_bar = $mw->new_ttk__progressbar( -orient => "horizontal", -mode => "determinate", -length => "100", #-maximum => $file_count, #-value => $progress, -maximum => "400", -value => $progress, ); $overall_progress_bar->g_pack; Tkx::MainLoop(); exit; sub run { #First block of code #define links my $keywordsfile="keywords.txt"; ##a lot more happens here print "Test!!"; }

    I've tried adding to the $progressbar value as well and using Tkx::update(); with no luck. Any guidance for this novice would be greatly appreciate. Another thing that I've seen that I'd like to fix is the main window, when I run on a PC, is unresponsive. I know it's all the same issue. Thank you

making a regex work with Unicode
6 direct replies — Read more / Contribute
by Anonymous Monk
on Feb 25, 2017 at 15:30

    I have a Russian article (Unicode) that I pasted into a plain-text file from a website, meaning each paragraph takes up one "line", and i'd like to be able to read it comfortably in a terminal, i.e. with wrapping on word boundaries instead of the teminal edge. fold does not handle the Unicode characters correctly - word boundaries are ignored and some characters are mangled by the line breaks. I then tried a perl one-liner that works fine with ASCII:

    perl -pe's/(.{0,60})\b/$1\n/g' <text-file

    This produced output where most lines were not wrapped and the ones that were were before Latin characters, and both before and after numerals. I looked up perldoc regex and tried this:

    perl -pe's/(.{1,60}\b)/$1\n/ug' <text-file

    This produced output that was wrapped variably between ~33-40 columns, depending on the number of spaces/Latin characters in the line (in other words, the . was couning bytes, not characters). Word boundaries were ignored. I tried many permutations of use utf8 and use feature "unicode_strings" and s///u and s///a and s///aa and \b{wb} but the result is always one of these two cases. What, if not anything I've tried so far, is the correct way to make . and \b work properly with Unicode, and if I am doing the "right thing", why isn't it working?

Add your question
Your question:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others drinking their drinks and smoking their pipes about the Monastery: (8)
    As of 2017-02-27 14:58 GMT
    Find Nodes?
      Voting Booth?
      Before electricity was invented, what was the Electric Eel called?

      Results (388 votes). Check out past polls.