/[cvs]/nfo/perl/libs/Data/Storage.pm
ViewVC logotype

Diff of /nfo/perl/libs/Data/Storage.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by cvsjoko, Thu Oct 10 03:43:12 2002 UTC revision 1.2 by joko, Thu Oct 17 00:04:29 2002 UTC
# Line 3  Line 3 
3  #  $Id$  #  $Id$
4  #  #
5  #  $Log$  #  $Log$
6    #  Revision 1.2  2002/10/17 00:04:29  joko
7    #  + sub createDb
8    #  + sub isConnected
9    #  + bugfixes regarding "deep recursion" stuff
10    #
11  #  Revision 1.1  2002/10/10 03:43:12  cvsjoko  #  Revision 1.1  2002/10/10 03:43:12  cvsjoko
12  #  + new  #  + new
13  #  #
# Line 15  use strict; Line 20  use strict;
20  use warnings;  use warnings;
21    
22  use Data::Storage::Locator;  use Data::Storage::Locator;
 use Data::Storage::Handler::DBI;  
 use Data::Storage::Handler::Tangram;  
23    
24  # get logger instance  # get logger instance
25  my $logger = Log::Dispatch::Config->instance;  my $logger = Log::Dispatch::Config->instance;
# Line 37  sub new { Line 40  sub new {
40    
41  sub AUTOLOAD {  sub AUTOLOAD {
42        
43      # since this is a core function acting as dispatcher to $self->{STORAGEHANDLE},
44      # some sophisticated handling and filtering is needed to avoid things like
45      #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"
46      #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"
47      #     - Deep recursion on anonymous subroutine at [...]
48      # we also might filter log messages caused by logging itself in "advanced logging of AUTOLOAD calls"
49      
50    my $self = shift;    my $self = shift;
51    our $AUTOLOAD;    our $AUTOLOAD;
52        
# Line 46  sub AUTOLOAD { Line 56  sub AUTOLOAD {
56    my $method = $AUTOLOAD;    my $method = $AUTOLOAD;
57    $method =~ s/^.*:://;    $method =~ s/^.*:://;
58    
59    #$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method . "(@_)" . " (AUTOLOAD)" );    # advanced logging of AUTOLOAD calls
60        my $logstring = __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method . "(@_)";
61        my $tabcount = int( (80 - length($logstring)) / 10 );
62        $logstring .= "\t" x $tabcount . "(AUTOLOAD)";
63        # TODO: only ok if logstring doesn't contain
64        #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"
65        # but that would be way too specific as long as we don't have an abstract handler for this  ;)
66        $logger->debug( $logstring );
67    
68      # filtering AUTOLOAD calls
69    if ($self->_filter_AUTOLOAD($method)) {    if ($self->_filter_AUTOLOAD($method)) {
70      $self->_accessStorage();      $self->_accessStorage();
71      $self->{STORAGEHANDLE}->$method(@_);      $self->{STORAGEHANDLE}->$method(@_);
# Line 96  sub _createStorageHandle { Line 114  sub _createStorageHandle {
114    # propagate args to handler    # propagate args to handler
115    # needs some more thoughts! (not only "dbi" to Tangram, when (in future) db is not more the common case)    # needs some more thoughts! (not only "dbi" to Tangram, when (in future) db is not more the common case)
116    if ($type eq 'DBI') {    if ($type eq 'DBI') {
117        use Data::Storage::Handler::DBI;
118      #my @args = %{$self->{locator}->{dbi}};      #my @args = %{$self->{locator}->{dbi}};
119      my @args = %{$self->{locator}};      my @args = %{$self->{locator}};
120      $self->{STORAGEHANDLE} = $pkg->new( @args );      $self->{STORAGEHANDLE} = $pkg->new( @args );
121    }    }
122    if ($type eq 'Tangram') {    if ($type eq 'Tangram') {
123        use Data::Storage::Handler::Tangram;
124      #$self->{STORAGEHANDLE} = $pkg->new( dsn => $self->{locator}->{dbi}->{dsn} );      #$self->{STORAGEHANDLE} = $pkg->new( dsn => $self->{locator}->{dbi}->{dsn} );
125      #my @args = %{$self->{locator}->{dbi}};      #my @args = %{$self->{locator}->{dbi}};
126      my @args = %{$self->{locator}};      my @args = %{$self->{locator}};
# Line 167  sub testDsn { Line 187  sub testDsn {
187      $dbh->disconnect();      $dbh->disconnect();
188      return 1;      return 1;
189    } else {    } else {
190      $logger->error( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . DBI::errstr );      $logger->error( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
191      }
192    }
193    
194    sub createDb {
195      my $self = shift;
196      my $dsn = $self->{locator}->{dbi}->{dsn};
197      $dsn =~ s/database=(.+?);//;
198      my $database_name = $1;
199    
200      my $ok;
201      
202      if ( my $dbh = DBI->connect($dsn, '', '', {
203                                                          PrintError => 0,
204                                                          } ) ) {
205        if ($database_name) {
206          if ($dbh->do("CREATE DATABASE $database_name;")) {
207            $ok = 1;
208          }
209        }
210        $dbh->disconnect();
211    }    }
212      
213      return $ok;
214      
215    }
216    
217    sub isConnected {
218      my $self = shift;
219      return 1 if $self->{STORAGEHANDLE};
220  }  }
221    
222  1;  1;
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed