view release on metacpan or  search on metacpan

lib/Catalyst/Model/DBI/SQL/Library.pm  view on Meta::CPAN

        $self->_load_instance( $source );
      } else {
        $self->sql( $source_cached->{sql} );
        $log->debug(
          qq/cached SQL::Library instance with path: "$source" and mtime: "$mtime_current" found/
        ) if $debug && $loglevel == $self->LOG_LEVEL_FULL;
      }
    } else {
      $self->sql( $source_cached->{sql} );
      $log->debug(
        qq/cached SQL::Library instance with path: "$source" found/
      ) if $debug && $loglevel == $self->LOG_LEVEL_FULL;
    }
  } else {
    $self->_load_instance( $source );
  }
  return $self->sql;
}

sub _load_instance {
  my ( $self, $source ) = @_;
  
  my $log = $self->{log};
  my $debug = $self->{debug};
  my $loglevel = $self->{loglevel};
  
  eval { $self->sql( SQL::Library->new( { lib => $source } ) ); };
  if ( $@ ) {
    $log->debug(
      qq/couldn't create SQL::Library instance with path: "$source" error: "$@"/
    ) if $debug && $loglevel >= $self->LOG_LEVEL_BASIC;
  } else {
    $log->debug(
      qq/SQL::Library instance created with path: "$source"/
    ) if $debug && $loglevel >= $self->LOG_LEVEL_BASIC;
    if ( $self->{sqlcache} && ref $source ne 'ARRAY' ) {
      if ( $self->{sqlcache_use_mtime} ) {
        my $mtime = $self->_extract_mtime( $source );
        $self->{obj_cache}->{$source} = {
          sql => $self->sql,
          mtime => $mtime
        }; 
        $log->debug(
          qq/caching SQL::Library instance with path: "$source" and mtime: "$mtime"/
        ) if $debug && $loglevel >= $self->LOG_LEVEL_INTERMEDIATE;
      } else {
        $self->{obj_cache}->{$source} = { sql => $self->sql };
        $log->debug(
          qq/caching SQL::Library instance with path: "$source"/
        ) if $debug && $loglevel >= $self->LOG_LEVEL_INTERMEDIATE;
      }
    }
  }
}

sub _extract_mtime {
  my ( $self, $source ) = @_;
  
  my $mtime;
  if (-r $source) {
    $mtime = return (stat(_))[9];
  } else {
    $self->{log}->debug(
      qq/couldn't extract modification time for path: "$source"/
    ) if $self->{debug} && $self->{loglevel} >= $self->LOG_LEVEL_BASIC;
  }
  return $mtime;
}

=item $self->dbh

Returns the current database handle.

=item $self->sql

Returns the current C<SQL::Library> instance

=back

=head1 SEE ALSO

L<Catalyst>, L<DBI>

=head1 AUTHOR

Alex Pavlovic, C<alex.pavlovic@taskforce-1.com>

=head1 COPYRIGHT

This program is free software, you can redistribute it and/or modify it 
under the same terms as Perl itself.

=cut

1;