Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Re^3: Loading modules remotely

by clueless newbie (Deacon)
on Jul 21, 2018 at 01:01 UTC ( #1218973=note: print w/replies, xml ) Need Help??


in reply to Re^2: Loading modules remotely
in thread Loading modules remotely

This loads module source from a database.

package dbLoader; use Carp; use Data::Dumper; use DBI; use English qw(-no_match_vars); use Fcntl qw(:flock); use Scalar::Util qw(blessed); use strict; use warnings; my ($BUFFER,$LOGNAME,$VFH); # Default prefix (preference) order my $PREFIX_ORDER_AREF=['Deployed']; sub import { my $self=shift; # set up $PREFIX_ORDER_AREF $PREFIX_ORDER_AREF=[@_] if (@_); return; }; # import: my $KNOWN_PACKAGES_HREF; my ($DBH,$STH); { # INTERNALS: # Yes, you can use caller in a @INC coderef! sub _dbLoader { # warn Data::Dumper->Dump([\[caller(0)]],[qw(*call +er)]),' '; print $VFH "Seeking '$_[1]'.\n"; return # unless there's a prefix order sequence unless (@{$PREFIX_ORDER_AREF}); print $VFH Data::Dumper->Dump([\@_],[qw(*_)]); my (undef,$path_S)=@_; s{[/\\]}{::}g, s{\.pm$}{} for (my $package_s=$path_S); print $VFH Data::Dumper->Dump([\$path_S,\$package_s],[qw(*path +_S *package_s)]); return # unless the package is in the this library && we have +a prefix match unless (exists $KNOWN_PACKAGES_HREF->{$package_s} && grep { + exists $KNOWN_PACKAGES_HREF->{$package_s}{$_} } @{$PREFIX_ORDER_AREF +}); #my $body_sref; my $body_s; eval { print $VFH Data::Dumper->Dump([\$PREFIX_ORDER_AREF],[qw(*P +REFIX_ORDER_AREF)]); for my $prefix_s (@{$PREFIX_ORDER_AREF}) { if (exists $KNOWN_PACKAGES_HREF->{$package_s}{$prefix_ +s}) { # Found one ... get its body and stash a reference + to that body print $VFH Data::Dump([\$prefix_s],[qw(*prefix_s)] +); $STH->execute($package_s,$prefix_s); my $value_aref=$STH->fetchrow_arrayref(); $body_s=$value_aref->[0]; #print $VFH Data::Dumper->Dump([\$body_s],[qw(*bod +y_s)]); # Mark it as this rather than as CODE() $INC{$path_S}="DBI:Pg:$prefix_s:$path_S"; # And our work is done last; }; }; }; if (my $error=$@) { Carp::confess $@; }; ## Each of the following will work! return \$body_s; ## ## or #open my $fh,'<',\$body_s # or die "Couldn't open '\$body_ref' for reading. $!"; #return $fh; ## ## or #open my $fh,'<',\$body_s # or Carp::confess "Couldn't open string for reading! $!+"; #return ( # sub { # if ($_=<$fh>) { # return 1; # } # else { # return 0; # }; # } # Anonymous sub: # ); ## }; # _dbLoader: } # INTERNALS: BEGIN { # warn Data::Dumper->Dump([\[caller()]],[qw(*caller)]),' '; #NB: $INC{"$LOGNAME.pm"} will be defined only when the package is +use'd. ($LOGNAME=__PACKAGE__)=~ s{::}{/}g; $LOGNAME=qq{$INC{"$LOGNAME.pm"}.log}; # warn Data::Dumper->Dump([\$LOGNAME],[qw(*LOGNAME)]),' '; }; UNITCHECK { # warn Data::Dumper->Dump([\[caller()]],[qw(*caller)]),' ' +; local $Data::Dumper::Terse=1; local $Data::Dumper::Indent=1; # Pre-allocate vec($BUFFER,64*1_024,8)=0; $BUFFER = ""; open $VFH,'>',\$BUFFER or die "Couldn't open in-memory-file for writing. $!"; my $configuration_href; # Load the configuration $ENV{HOME}//="$ENV{HOMEDRIVE}$ENV{HOMEPATH}"; my $filename; # The preference is an eval and a Data::Dumper .dmp file # otherwise use Config::General and save the configuration to a Da +ta::Dumper .dmp for subsequent uses if (-f ($filename="$ENV{HOME}/config.dmp")) { # We can use eval. my $string=do {open my $fh,'<',$filename or die "Couldn't open + '$filename' for reading. $!"; local $/; <$fh>; }; print $VFH Data::Dumper->Dump([\$string],[qw(*string)]); $configuration_href=eval $string or die "Deserialization failed: $@"; } elsif (-f ($filename="$ENV{HOME}/config.ini")) { # Needs Config::G +eneral. require Config::General; $configuration_href={Config::General->new($filename)->getall}; my $fh; open $fh,'>',$filename="$ENV{HOME}/config.dmp" and do { require Data::Dumper; print {$fh} Data::Dumper->Dump([$configuration_href]); close $fh; } or warn "Couldn't open '$filename' for writing. $!"; } else { # WTF die "There is neither a config.dmp nor an config.ini file."; }; print $VFH Data::Dumper->Dump([\$configuration_href],[qw(*configur +ation_href)]); my $db='pg'; print $VFH Data::Dumper->Dump([\$db],[qw(*db)]); eval { $DBH=DBI->connect( @{$configuration_href->{db}{$db}}{qw(dsn username pass +word)} ,{ PrintError=>1, RaiseError=>1 } ); # Create a (global) hashref of packages/prefixes $STH=$DBH->prepare(<<"__SQL__"); SELECT package,prefix FROM packages; __SQL__ $STH->execute(); my $field_aref=$STH->{NAME_lc}; while (my $value_aref=$STH->fetchrow_arrayref()) { my %_h; @_h{@$field_aref}=@$value_aref; $KNOWN_PACKAGES_HREF->{$_h{package}}{$_h{prefix}}=undef; }; $STH->finish(); print $VFH Data::Dumper->Dump([\$KNOWN_PACKAGES_HREF],[qw(*KNO +WN_PACKAGES_HREF)]); # Statement handle for fetching source(s) $STH=$DBH->prepare(<<"__SQL__"); SELECT body FROM packages WHERE package = ? and prefix = ? +; __SQL__ print $VFH "SELECT prepared.\n"; # prepend the loader unshift @INC,\&_dbLoader; print $VFH "Prepended \@INC.\n"; }; die $@ if ($@); }; # UNITCHECK: #CHECK { # warn Data::Dumper->Dump([\[caller()]],[qw(*caller)]),' '; # }; # CHECK: #INIT { # warn Data::Dumper->Dump([\[caller()]],[qw(*caller)]),' '; # }; # INIT: END { # warn Data::Dumper->Dump([\[caller()]],[qw(*caller)]),' '; # Modules loaded by _dbLoader printf $VFH ("%40s\t%s\n",$_,$INC{$_}) for (sort grep { $INC{$_}=~ m{DBI:Pg:} } keys %INC); return # if there's nothing to do. unless (tell $VFH); # Open our log open(my $fh,'>>',$LOGNAME) or die "Could not open '$LOGNAME' for appending. $!"; # Get lock flock($fh,LOCK_EX) or die "Could not lock '$LOGNAME'. $!"; # and write $BUFFER to the log file print $fh "\n<< $PROCESS_ID\n", substr($BUFFER,0,tell $VFH), "\n$PROCESS_ID >>\n"; # and close close $fh or die "Could not write '$LOGNAME' - $!"; }; END; 1; __END__

Replies are listed 'Best First'.
Re^4: Loading modules remotely
by bliako (Vicar) on Jul 21, 2018 at 08:12 UTC

    that's great! thanks.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1218973]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (6)
As of 2019-12-11 07:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?