view release on metacpan or  search on metacpan

DBI.pm  view on Meta::CPAN

# --- Driver Specific Prefix Registry ---

my $dbd_prefix_registry = {
  ad_      => { class => 'DBD::AnyData',	},
  ado_     => { class => 'DBD::ADO',		},
  amzn_    => { class => 'DBD::Amazon',		},
  best_    => { class => 'DBD::BestWins',	},
  csv_     => { class => 'DBD::CSV',		},
  db2_     => { class => 'DBD::DB2',		},
  dbi_     => { class => 'DBI',			},
  dbm_     => { class => 'DBD::DBM',		},
  df_      => { class => 'DBD::DF',		},
  f_       => { class => 'DBD::File',		},
  file_    => { class => 'DBD::TextFile',	},
  ib_      => { class => 'DBD::InterBase',	},
  ing_     => { class => 'DBD::Ingres',		},
  ix_      => { class => 'DBD::Informix',	},
  jdbc_    => { class => 'DBD::JDBC',		},
  msql_    => { class => 'DBD::mSQL',		},
  mysql_   => { class => 'DBD::mysql',		},
  mx_      => { class => 'DBD::Multiplex',	},
  nullp_   => { class => 'DBD::NullP',		},
  odbc_    => { class => 'DBD::ODBC',		},
  ora_     => { class => 'DBD::Oracle',		},
  pg_      => { class => 'DBD::Pg',		},
  proxy_   => { class => 'DBD::Proxy',		},
  rdb_     => { class => 'DBD::RDB',		},
  sapdb_   => { class => 'DBD::SAP_DB',		},
  solid_   => { class => 'DBD::Solid',		},
  sponge_  => { class => 'DBD::Sponge',		},
  sql_     => { class => 'SQL::Statement',	},
  syb_     => { class => 'DBD::Sybase',		},
  tdat_    => { class => 'DBD::Teradata',	},
  tmpl_    => { class => 'DBD::Template',	},
  tmplss_  => { class => 'DBD::TemplateSS',	},
  tuber_   => { class => 'DBD::Tuber',		},
  uni_     => { class => 'DBD::Unify',		},
  xbase_   => { class => 'DBD::XBase',		},
  xl_      => { class => 'DBD::Excel',		},
  yaswi_   => { class => 'DBD::Yaswi',		},
};

sub dump_dbd_registry {
    require Data::Dumper;
    local $Data::Dumper::Sortkeys=1;
    local $Data::Dumper::Indent=1;
    print Data::Dumper->Dump([$dbd_prefix_registry], [qw($dbd_prefix_registry)]);
}

# --- Dynamically create the DBI Standard Interface

my $keeperr = { O=>0x0004 };

%DBI::DBI_methods = ( # Define the DBI interface methods per class:

    common => {		# Interface methods common to all DBI handle classes
	'DESTROY'	=> $keeperr,
	'CLEAR'  	=> $keeperr,
	'EXISTS' 	=> $keeperr,
	'FETCH'		=> { O=>0x0404 },
	'FIRSTKEY'	=> $keeperr,
	'NEXTKEY'	=> $keeperr,
	'STORE'		=> { O=>0x0418 | 0x4 },
	_not_impl	=> undef,
	can		=> { O=>0x0100 }, # special case, see dispatch
	debug 	 	=> { U =>[1,2,'[$debug_level]'],	O=>0x0004 }, # old name for trace
	dump_handle 	=> { U =>[1,3,'[$message [, $level]]'],	O=>0x0004 },
	err		=> $keeperr,
	errstr		=> $keeperr,
	state		=> $keeperr,
	func	   	=> { O=>0x0006	},
	parse_trace_flag   => { U =>[2,2,'$name'],	O=>0x0404, T=>8 },
	parse_trace_flags  => { U =>[2,2,'$flags'],	O=>0x0404, T=>8 },
	private_data	=> { U =>[1,1],			O=>0x0004 },
	set_err		=> { U =>[3,6,'$err, $errmsg [, $state, $method, $rv]'], O=>0x0010 },
	trace		=> { U =>[1,3,'[$trace_level, [$filename]]'],	O=>0x0004 },
	trace_msg	=> { U =>[2,3,'$message_text [, $min_level ]' ],	O=>0x0004, T=>8 },
	swap_inner_handle => { U =>[2,3,'$h [, $allow_reparent ]'] },
    },
    dr => {		# Database Driver Interface
	'connect'  =>	{ U =>[1,5,'[$db [,$user [,$passwd [,\%attr]]]]'], H=>3 },
	'connect_cached'=>{U=>[1,5,'[$db [,$user [,$passwd [,\%attr]]]]'], H=>3 },
	'disconnect_all'=>{ U =>[1,1], O=>0x0800 },
	data_sources => { U =>[1,2,'[\%attr]' ], O=>0x0800 },
	default_user => { U =>[3,4,'$user, $pass [, \%attr]' ] },
    },
    db => {		# Database Session Class Interface
	data_sources	=> { U =>[1,2,'[\%attr]' ], O=>0x0200 },
	take_imp_data	=> { U =>[1,1], },
	clone   	=> { U =>[1,1,''] },
	connected   	=> { O=>0x0100 },
	begin_work   	=> { U =>[1,2,'[ \%attr ]'], O=>0x0400 },
	commit     	=> { U =>[1,1], O=>0x0480|0x0800 },
	rollback   	=> { U =>[1,1], O=>0x0480|0x0800 },
	'do'       	=> { U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x3200 },
	last_insert_id	=> { U =>[5,6,'$catalog, $schema, $table_name, $field_name [, \%attr ]'], O=>0x2800 },
	preparse    	=> {  }, # XXX
	prepare    	=> { U =>[2,3,'$statement [, \%attr]'],                    O=>0x2200 },
	prepare_cached	=> { U =>[2,4,'$statement [, \%attr [, $if_active ] ]'],   O=>0x2200 },
	selectrow_array	=> { U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
	selectrow_arrayref=>{U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
	selectrow_hashref=>{ U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
	selectall_arrayref=>{U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
	selectall_hashref=>{ U =>[3,0,'$statement, $keyfield [, \%attr [, @bind_params ] ]'], O=>0x2000 },
	selectcol_arrayref=>{U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
	ping       	=> { U =>[1,1], O=>0x0404 },
	disconnect 	=> { U =>[1,1], O=>0x0400|0x0800 },
	quote      	=> { U =>[2,3, '$string [, $data_type ]' ], O=>0x0430 },
	quote_identifier=> { U =>[2,6, '$name [, ...] [, \%attr ]' ],    O=>0x0430 },
	rows       	=> $keeperr,

	tables          => { U =>[1,6,'$catalog, $schema, $table, $type [, \%attr ]' ], O=>0x2200 },
	table_info      => { U =>[1,6,'$catalog, $schema, $table, $type [, \%attr ]' ],	O=>0x2200|0x0800 },
	column_info     => { U =>[5,6,'$catalog, $schema, $table, $column [, \%attr ]'],O=>0x2200|0x0800 },
	primary_key_info=> { U =>[4,5,'$catalog, $schema, $table [, \%attr ]' ],	O=>0x2200|0x0800 },
	primary_key     => { U =>[4,5,'$catalog, $schema, $table [, \%attr ]' ],	O=>0x2200 },
	foreign_key_info=> { U =>[7,8,'$pk_catalog, $pk_schema, $pk_table, $fk_catalog, $fk_schema, $fk_table [, \%attr ]' ], O=>0x2200|0x0800 },
	type_info_all	=> { U =>[1,1], O=>0x2200|0x0800 },
	type_info	=> { U =>[1,2,'$data_type'], O=>0x2200 },
	get_info	=> { U =>[2,2,'$info_type'], O=>0x2200|0x0800 },
    },
    st => {		# Statement Class Interface
	bind_col	=> { U =>[3,4,'$column, \\$var [, \%attr]'] },
	bind_columns	=> { U =>[2,0,'\\$var1 [, \\$var2, ...]'] },
	bind_param	=> { U =>[3,4,'$parameter, $var [, \%attr]'] },
	bind_param_inout=> { U =>[4,5,'$parameter, \\$var, $maxlen, [, \%attr]'] },
	execute		=> { U =>[1,0,'[@args]'], O=>0x1040 },

	bind_param_array  => { U =>[3,4,'$parameter, $var [, \%attr]'] },
	bind_param_inout_array => { U =>[4,5,'$parameter, \\@var, $maxlen, [, \%attr]'] },
	execute_array     => { U =>[2,0,'\\%attribs [, @args]'],         O=>0x1040 },
	execute_for_fetch => { U =>[2,3,'$fetch_sub [, $tuple_status]'], O=>0x1040 },

	fetch    	  => undef, # alias for fetchrow_arrayref
	fetchrow_arrayref => undef,
	fetchrow_hashref  => undef,
	fetchrow_array    => undef,
	fetchrow   	  => undef, # old alias for fetchrow_array

	fetchall_arrayref => { U =>[1,3, '[ $slice [, $max_rows]]'] },
	fetchall_hashref  => { U =>[2,2,'$key_field'] },

	blob_read  =>	{ U =>[4,5,'$field, $offset, $len [, \\$buf [, $bufoffset]]'] },
	blob_copy_to_file => { U =>[3,3,'$field, $filename_or_handleref'] },
	dump_results => { U =>[1,5,'$maxfieldlen, $linesep, $fieldsep, $filehandle'] },
	more_results => { U =>[1,1] },
	finish     => 	{ U =>[1,1] },
	cancel     => 	{ U =>[1,1], O=>0x0800 },
	rows       =>	$keeperr,

	_get_fbav	=> undef,
	_set_fbav	=> { T=>6 },
    },
);

while ( my ($class, $meths) = each %DBI::DBI_methods ) {
    while ( my ($method, $info) = each %$meths ) {
	my $fullmeth = "DBI::${class}::$method";
	DBI->_install_method($fullmeth, 'DBI.pm', $info);
    }
}

{
    package DBI::common;
    @DBI::dr::ISA = ('DBI::common');
    @DBI::db::ISA = ('DBI::common');