view release on metacpan or  search on metacpan

lib/DBD/Sys.pm  view on Meta::CPAN

        foreach my $plugin_attr ( keys %{$sys_plugin_attrs} )
        {
            $dbh->{sys_valid_attrs}->{$plugin_attr} = 1;
        }

        foreach my $plugin_attr ( keys %{ $dbh->{sys_plugin_attrs} } )
        {
            unless ( exists( $sys_plugin_attrs->{$plugin_attr} ) )
            {
                exists $dbh->{$plugin_attr} and delete $dbh->{$plugin_attr};
                delete $dbh->{sys_valid_attrs}->{$plugin_attr};
            }
        }

        $dbh->{sys_plugin_attrs} = $sys_plugin_attrs;
    }

    return $dbh;
}

sub get_sys_versions
{
    my ( $dbh, $table ) = @_;

    my $class = $dbh->{ImplementorClass};

    return $dbh->{sys_version};    # sprintf "%s using %s", $dbh->{sys_version}, $dtype;
}

sub get_avail_tables
{
    my ($dbh) = @_;
    my @tables =
      ( $dbh->SUPER::get_avail_tables(), $dbh->selectrow_array("SELECT * FROM alltables"), );
    return @tables;
}

sub disconnect ($)
{
    return $_[0]->SUPER::disconnect();
}

package DBD::Sys::st;

use strict;
use warnings;

use vars qw(@ISA $imp_data_size);

@ISA                         = qw(DBI::DBD::SqlEngine::st);
$DBD::Sys::st::imp_data_size = 0;

package DBD::Sys::Statement;

use strict;
use warnings;

use vars qw(@ISA);

use Scalar::Util qw(weaken);

@ISA = qw(DBI::DBD::SqlEngine::Statement);

sub open_table($$$$$)
{
    my ( $self, $data, $table, $createMode, $lockMode ) = @_;

    my $attr_prefix = 'sys_' . lc($table) . '_';
    my $attrs       = {};
    my $meta        = {};
    my $dbh         = $data->{Database};
    foreach my $attr ( keys %{$dbh} )
    {
        next unless ( $attr =~ m/^$attr_prefix(.+)$/ );
        $meta->{$1} = $dbh->{$attr};
    }
    $attrs->{meta}     = $meta;
    $attrs->{database} = $dbh;
    $attrs->{owner}    = $self;
    weaken( $attrs->{owner} );
    weaken( $attrs->{database} );

    my $tbl = $dbh->{sys_pluginmgr}->get_table( $table, $attrs );

    return $tbl;
}

#################### main pod documentation start ###################

=head1 NAME

DBD::Sys - System tables interface via DBI

=head1 SYNOPSIS

  use DBI;
  my $dbh = DBI->connect('DBI::Sys:');
  my $st  = $dbh->prepare('select distinct * from filesystems join filesysdf on mountpoint');
  my $num = $st->execute();
  if( $num > 0 )
  {
      while( my $row = $st->fetchrow_hashref() )
      {
          # ...
      }
  }

=head1 DESCRIPTION

DBD::Sys is a so called database driver for L<DBI> designed to request
information from system tables using SQL. It's based on L<SQL::Statement> as
SQL engine and allows to be extended by L<DBD::Sys::Plugins>.

=head2 Prerequisites

Of course, a DBD requires L<DBI> to run. Further, L<SQL::Statement> as SQL
engine is required, L<Module::Pluggable> to manage the plugin's and
L<Module::Build> for installation. Finally, to speed up some checks,
L<Params::Util> is needed.

All these modules are mandatory and DBD::Sys will fail when they are not
available.

To request system information, existing modules from CPAN are used - there
are available ones to provide access to some system tables. These modules are
optional, but recommended. It wouldn't make much sense to use DBD::Sys without
the ability to access the tables from the (operating) system.

To get an overview which dependencies are there, please check the plugins
or take a look into META.yml.

=head1 USAGE

=head2 Installation

We chose C<Module::Build> installation, because not every system has a
suitable make utility - but at least everyone who's using perl modules has
a running perl. So installing can be done after extracting

  gzip -dc DBD-Sys-${VERSION}.tar.gz | tar xvf -