/[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.3 by joko, Fri Oct 25 11:40:37 2002 UTC
# Line 3  Line 3 
3  #  $Id$  #  $Id$
4  #  #
5  #  $Log$  #  $Log$
6    #  Revision 1.3  2002/10/25 11:40:37  joko
7    #  + enhanced robustness
8    #  + more logging for debug-levels
9    #  + sub dropDb
10    #
11    #  Revision 1.2  2002/10/17 00:04:29  joko
12    #  + sub createDb
13    #  + sub isConnected
14    #  + bugfixes regarding "deep recursion" stuff
15    #
16  #  Revision 1.1  2002/10/10 03:43:12  cvsjoko  #  Revision 1.1  2002/10/10 03:43:12  cvsjoko
17  #  + new  #  + new
18  #  #
19  #  #
20  #################################  #################################
21    
22    # aim_V1: should encapsulate Tangram, DBI, DBD::CSV and LWP:: to access them in an unordinary way ;)
23    # aim_V2: introduce a generic layered structure, refactor *SUBLAYER*-stuff, make (e.g.) this possible:
24    #               - Perl Data::Storage[DBD::CSV]  ->  Perl LWP::  ->  Internet HTTP/FTP/*  ->  Host Daemon  ->  csv-file
25    
26  package Data::Storage;  package Data::Storage;
27    
28  use strict;  use strict;
29  use warnings;  use warnings;
30    
31  use Data::Storage::Locator;  use Data::Storage::Locator;
 use Data::Storage::Handler::DBI;  
 use Data::Storage::Handler::Tangram;  
32    
33  # get logger instance  # get logger instance
34  my $logger = Log::Dispatch::Config->instance;  my $logger = Log::Dispatch::Config->instance;
# Line 37  sub new { Line 49  sub new {
49    
50  sub AUTOLOAD {  sub AUTOLOAD {
51        
52      # since this is a core function acting as dispatcher to $self->{STORAGEHANDLE},
53      # some sophisticated handling and filtering is needed to avoid things like
54      #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"
55      #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"
56      #     - Deep recursion on anonymous subroutine at [...]
57      # we also might filter log messages caused by logging itself in "advanced logging of AUTOLOAD calls"
58      
59    my $self = shift;    my $self = shift;
60    our $AUTOLOAD;    our $AUTOLOAD;
61        
# Line 46  sub AUTOLOAD { Line 65  sub AUTOLOAD {
65    my $method = $AUTOLOAD;    my $method = $AUTOLOAD;
66    $method =~ s/^.*:://;    $method =~ s/^.*:://;
67    
68    #$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method . "(@_)" . " (AUTOLOAD)" );    # advanced logging of AUTOLOAD calls
69        my $logstring = "";
70        $logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;
71        #print "count: ", $#_, "\n";
72        #$logstring .= Dumper(@_) if ($#_ != -1);
73        my $tabcount = int( (80 - length($logstring)) / 10 );
74        $logstring .= "\t" x $tabcount . "(AUTOLOAD)";
75        # TODO: only ok if logstring doesn't contain
76        #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"
77        # but that would be way too specific as long as we don't have an abstract handler for this  ;)
78        $logger->debug( $logstring );
79    
80      # filtering AUTOLOAD calls
81    if ($self->_filter_AUTOLOAD($method)) {    if ($self->_filter_AUTOLOAD($method)) {
82      $self->_accessStorage();      $self->_accessStorage();
83      $self->{STORAGEHANDLE}->$method(@_);      $self->{STORAGEHANDLE}->$method(@_);
# Line 79  sub normalizeArgs { Line 109  sub normalizeArgs {
109  sub _accessStorage {  sub _accessStorage {
110    my $self = shift;    my $self = shift;
111    # TODO: to some tracelevel!    # TODO: to some tracelevel!
112    #$logger->debug( __PACKAGE__ .  "[$self->{type}]" . "->_accessStorage()" );    $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorage()" );
113    if (!$self->{STORAGEHANDLE}) {    if (!$self->{STORAGEHANDLE}) {
114      $self->_createStorageHandle();      $self->_createStorageHandle();
115    }    }
# Line 96  sub _createStorageHandle { Line 126  sub _createStorageHandle {
126    # propagate args to handler    # propagate args to handler
127    # 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)
128    if ($type eq 'DBI') {    if ($type eq 'DBI') {
129        use Data::Storage::Handler::DBI;
130      #my @args = %{$self->{locator}->{dbi}};      #my @args = %{$self->{locator}->{dbi}};
131      my @args = %{$self->{locator}};      my @args = %{$self->{locator}};
132        # create new storage handle
133      $self->{STORAGEHANDLE} = $pkg->new( @args );      $self->{STORAGEHANDLE} = $pkg->new( @args );
134    }    }
135    if ($type eq 'Tangram') {    if ($type eq 'Tangram') {
136        use Data::Storage::Handler::Tangram;
137      #$self->{STORAGEHANDLE} = $pkg->new( dsn => $self->{locator}->{dbi}->{dsn} );      #$self->{STORAGEHANDLE} = $pkg->new( dsn => $self->{locator}->{dbi}->{dsn} );
138      #my @args = %{$self->{locator}->{dbi}};      #my @args = %{$self->{locator}->{dbi}};
139      my @args = %{$self->{locator}};      my @args = %{$self->{locator}};
140        # create new storage handle
141      $self->{STORAGEHANDLE} = $pkg->new( @args );      $self->{STORAGEHANDLE} = $pkg->new( @args );
142    
143      #$self->{STORAGEHANDLE_UNDERLYING} = $self->{STORAGEHANDLE}->getUnderlyingStorage();      #$self->{STORAGEHANDLE_UNDERLYING} = $self->{STORAGEHANDLE}->getUnderlyingStorage();
144      #$self->{STORAGEHANDLE_UNDERLYING}->_configureCOREHANDLE();      #$self->{STORAGEHANDLE_UNDERLYING}->_configureCOREHANDLE();
145    }    }
# Line 116  sub addLogDispatchHandler { Line 151  sub addLogDispatchHandler {
151        my $self = shift;        my $self = shift;
152        my $name = shift;        my $name = shift;
153        my $package = shift;        my $package = shift;
154        my $logger = shift;        my $logger1 = shift;
155        my $objectCreator = shift;        my $objectCreator = shift;
156                
157        #$logger->add( Log::Dispatch::Tangram->new( name => $name,        #$logger->add( Log::Dispatch::Tangram->new( name => $name,
# Line 143  sub removeLogDispatchHandler { Line 178  sub removeLogDispatchHandler {
178    
179        my $self = shift;        my $self = shift;
180        my $name = shift;        my $name = shift;
181        my $logger = shift;        #my $logger = shift;
182    
183        $logger->remove($name);        $logger->remove($name);
184    
# Line 167  sub testDsn { Line 202  sub testDsn {
202      $dbh->disconnect();      $dbh->disconnect();
203      return 1;      return 1;
204    } else {    } else {
205      $logger->error( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . DBI::errstr );      $logger->error( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
206    }    }
207  }  }
208    
209    sub createDb {
210      my $self = shift;
211      my $dsn = $self->{locator}->{dbi}->{dsn};
212    
213      $logger->debug( __PACKAGE__ .  "->createDb( dsn $dsn )" );
214    
215      $dsn =~ s/database=(.+?);//;
216      my $database_name = $1;
217    
218      my $ok;
219      
220      if ( my $dbh = DBI->connect($dsn, '', '', {
221                                                          PrintError => 0,
222                                                          } ) ) {
223        if ($database_name) {
224          if ($dbh->do("CREATE DATABASE $database_name;")) {
225            $ok = 1;
226          }
227        }
228        $dbh->disconnect();
229      }
230      
231      return $ok;
232      
233    }
234    
235    sub dropDb {
236      my $self = shift;
237      my $dsn = $self->{locator}->{dbi}->{dsn};
238    
239      $logger->debug( __PACKAGE__ .  "->dropDb( dsn $dsn )" );
240    
241      $dsn =~ s/database=(.+?);//;
242      my $database_name = $1;
243    
244      my $ok;
245      
246      if ( my $dbh = DBI->connect($dsn, '', '', {
247                                                          PrintError => 0,
248                                                          } ) ) {
249        if ($database_name) {
250          if ($dbh->do("DROP DATABASE $database_name;")) {
251            $ok = 1;
252          }
253        }
254        $dbh->disconnect();
255      }
256      
257      return $ok;
258    }
259    
260    sub isConnected {
261      my $self = shift;
262      return 1 if $self->{STORAGEHANDLE};
263    }
264    
265  1;  1;
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed