Changeset 80 for trunk/uribl/URIdb.pm

Timestamp:

09/11/25 16:28:23 (4 days ago)

Author:

Kris Deugau

Message:

/trunk/uribl

Convert module to more proper object with embedded DB bits
Add module-finding blurb

File:

• trunk/uribl/URIdb.pm (modified) (4 diffs)

trunk/uribl/URIdb.pm

@@ -3 +3 @@
 ##
 # $Id$
-# Copyright 2010 Kris Deugau <kdeugau@deepnet.cx>
+# Copyright 2010,2025 Kris Deugau <kdeugau@deepnet.cx>
 # 
 #    This program is free software: you can redistribute it and/or modify
@@ -29 +29 @@
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 
-$VERSION        = 1.0;
+$VERSION        = 2.0;
 @ISA            = qw(Exporter);
-@EXPORT_OK      = qw(
-        );
-
-@EXPORT         = (); # Export nothing by default.
+@EXPORT_OK      = qw( $dbh );
+
+@EXPORT         = ( $dbh );
+
 %EXPORT_TAGS    = ( ALL => [qw(
                 )]
@@ -60 +60 @@
 # basic object subs
 sub new {
-# iff we want to start taking arguments, or doing other things on instantiation
-#  my $self = {};
-#  bless $self, "DNSBL";
-#  return $self;
-  bless {};
+  my $this = shift;
+  my $class = ref($this) || $this;
+  my %args = @_;
+
+  # Prepopulate a basic config.  Note some of these *will* cause errors if left unset.
+  my %defconfig = (
+        dbhost => "localhost",
+        dbname => "dnsbl",
+        dbuser => "dnsbl",
+        dbpass => "spambgone",
+  );
+
+  my %siteconfig;
+  my $dbhost;
+  my $dbname;
+  my $dbuser;
+  my $dbpass;
+  if (defined($args{configfile})) {
+    if (-e $args{configfile} && -f $args{configfile}) {
+      my $ret = eval `cat $args{configfile}`;
+      unless ($ret) {
+        if ($@) { $errstr = "couldn't parse $args{configfile}: $@\n"; return; }
+        if (!defined($ret)) { $errstr = "couldn't load $args{configfile}: $!\n"; return; }
+        if (!$ret) { $errstr = "couldn't load $args{configfile}\n"; return; }
+      }
+      # crossload legacy variables, but prefer new %siteconfig values
+      $siteconfig{dbhost} = $dbhost if !$siteconfig{dbhost} && $dbhost;
+      $siteconfig{dbname} = $dbname if !$siteconfig{dbname} && $dbname;
+      $siteconfig{dbuser} = $dbuser if !$siteconfig{dbuser} && $dbuser;
+      $siteconfig{dbpass} = $dbpass if !$siteconfig{dbpass} && $dbpass;
+    }
+  }
+
+  # Assemble the object.  Apply configuration hashes in order of precedence.
+  my $self = {
+        # Hardcoded defaults
+        %defconfig,
+        # Default config file OR caller-specified one, loaded above
+        %siteconfig,
+        # Caller-specified arguments
+        %args
+        };
+  bless $self, $class;
+
+  return $self;
 }
 
@@ -82 +122 @@
 sub connect {
   my $self = shift;
-  my $dbhost = shift;
-  my $dbname = shift;
-  my $dbuser = shift;
-  my $dbpass = shift;
   ## want to NOT autocommit everything, it's unlikely we'll step on our own toes but...
-  $dbh = DBI->connect("DBI:Pg:host=$dbhost;dbname=$dbname", $dbuser, $dbpass, {
+  $dbh = DBI->connect("DBI:Pg:host=$self->{dbhost};dbname=$self->{dbname}", $self->{dbuser}, $self->{dbpass}, {
         AutoCommit => 0,
         PrintError => 1