Detecting modules in use?

[BBQ]

I have come across a philosofical issue. Is there a good method for detecting if a module has been loaded from within a subroutine?

In more detail: I am planning in writting a common authentication subroutine what will be used across several utilities being implemented on my intranet. Most of these utilities will need to validate a user against a MySQL table, and return true or false. Now, since some of these scripts are already written, and some of then don't use DBI, I was planning on writting something in the lines of:

sub AuthenticateUser {
  my ($username,$password,$service) = @_;

  # this is my question
  if (DBI is not loaded and connected) {
    eval {  use DBI;  };
    if ($@) { die($@); }
  }
  # go on and do stuff with $dbh
  # select warp.username,warp.password,services.service
  # from warp,services where blah blah blah
  return($service);
}

I haven't even looked at perldoc, since I don't know where to start! Any suggestions, pointers?

[mdillon]

use symbol table, luke! print map { $_, $/ } grep { substr($_, -2) eq '::' } keys %::; this gives you all the entries in the main symbol table ending with '::'. this equates to all the loaded top level modules, along with some other perl internal namespaces.

come to think of it, you can just do the following: exists $::{'DBI::'} to check if HTTP::Request is loaded, do the following: exists $::{'HTTP::'} && exists $HTTP::{'Request::'} i think you can do this too:

$DBI_loaded = defined %DBI::;

# or

$HTTP_Request_Loaded = defined %HTTP::Request::;

so, to conclude here is code that loads DBI unless DBI is already loaded (or someone else has a package called DBI, or someone is screwing with the symbol table, or someone is blindly creating variables in the main namespace from CGI variables, etc. don't anyone say i didn't warn them.) unless (defined %DBI::) { use DBI; }

[KM]

Another way, which will also list all modules which modules you use, use:

$ perl -MDBI -e 'print qq{$_ => $INC{$_}\n} for keys %INC';
Carp.pm => /usr/lib/perl5/5.00503/Carp.pm
DBI.pm => /usr/lib/perl5/site_perl/5.005/i386-linux/DBI.pm
AutoLoader.pm => /usr/lib/perl5/5.00503/AutoLoader.pm
strict.pm => /usr/lib/perl5/5.00503/strict.pm
Exporter.pm => /usr/lib/perl5/5.00503/Exporter.pm
DynaLoader.pm => /usr/lib/perl5/5.00503/i386-linux/DynaLoader.pm
vars.pm => /usr/lib/perl5/5.00503/vars.pm

So, you could do:

sub() if exists $INC{'DBI.pm'};

Now, for how to know if the connection is open, I would also suggest Apache::DBI, so you can have a persistent connection.

Cheers,
KM

[BBQ]

Yes Obiwan :) !!

But this takes care of part of my problem. It doesn't tell me if the database has been connected yet... Its a darn good start tho, considering we have standarized $dbh and $sth as our handlers. I guess I could go from there.

Thanks for the tip!

[t0mas]

Don't know if this will help you, but $DBI::lasth remains undef until you touch DBI.

/brother t0mas

[mdillon]

i don't know of any way to figure out programmatically through DBI whether or not any connections have been made. the only way i can think of is a policy oriented way such as you've suggested (standardizing on $dbh and $sth for handler names).

i checked out the source of DBD::Pg, and from the looks of things, connect() doesn't keep track of connections. perhaps DBD::MySql does, i don't know.

[lhoward]

If you're running Apache there is another way to solve your problem (that has lots of other nice benefits). With mod_perl you can run your unmodified perl CGI scripts under Apache::Registry. In the mod_perl config you can pre-load modules that will be available to all your programs w/o each program needing to explicitly use the module. Also your scripts be compiled once and will run within Apache (no expense of forking another process, so they'll run faster) and with Apache::DBI (no code changes necessary to get this benefit once your're running under mod_perl) you will have a persistant cache of DB handles so establishing DB connections will be much faster.

[BBQ]

Sounds awesome! (downloading it as I write this)

But what kind of an effect would this have on apps that load DBI multiple times? Would they all just be "skipped"? Ie:

eval {
  use DBI;
  require 'intranet.pl';
};

and having the code mentioned in my first post inside intranet.pl... I would have two or more 'use DBI' calls consecutively. What kind of penalty (if any) would I suffer from coding this way?

[lhoward]

If you're perl CGI already has a "use Foo;" in it there is no penalty (or even a noticeable effect) from having the module pre-loaded in the mod_perl config.

With a cache of DB handles provided by Apache::DBI you would still probably notice a big performance increase even if your authentication sunroutine has its own DBI connect/disconnect calls. I've several times had to write program that had multiple DBI connections open and never had a problem with any adverse effects from it.

[Adam]

Collecting the better-late-then-never award:

Look for the module in the %INC associative array. According to the docs for require (and use just calls require in a BEGIN block) every module that gets 'used' gets its name put into this hash, where the key is the file name, and the value is the 'real path' to the file. So the answer is:

if( not exists $INC{DBI} )
{
    require DBI;
}

Update: Noticing that KM actually gave this answer here, I return the "better-late-then-never" award. Sigh.

[dchetlin]

Also, require does that automatically. The manpage has this snippet:

Has semantics similar to the following subroutine:

    sub require {
        my($filename) = @_;
        return 1 if $INC{$filename};
        my($realfilename,$result);
        ITER: {
            foreach $prefix (@INC) {
                $realfilename = "$prefix/$filename";
                if (-f $realfilename) {
                    $INC{$filename} = $realfilename;
                    $result = do $realfilename;
                    last ITER;
                }
            }
            die "Can't find $filename in \@INC";
        }
        delete $INC{$filename} if $@ || !$result;
        die $@ if $@;
        die "$filename did not return true value" unless $result;
        return $result;
    }

-dlc