29a9ad3f90
Source DBD files can include Pod blocks, as long as the dbdExpand.pl script doesn't try and include it in expanded DBD output files. This makes it easier to write the Pod, and perldoc can parse most of the result for checking (it complains about the =field directives though, which dbdToHtml.pl handles itself).
107 lines
2.0 KiB
Perl
107 lines
2.0 KiB
Perl
package DBD;
|
|
|
|
use DBD::Base;
|
|
use DBD::Breaktable;
|
|
use DBD::Driver;
|
|
use DBD::Menu;
|
|
use DBD::Recordtype;
|
|
use DBD::Recfield;
|
|
use DBD::Registrar;
|
|
use DBD::Function;
|
|
use DBD::Variable;
|
|
|
|
use Carp;
|
|
|
|
sub new {
|
|
my ($class) = @_;
|
|
my $this = {
|
|
'DBD::Breaktable' => {},
|
|
'DBD::Driver' => {},
|
|
'DBD::Function' => {},
|
|
'DBD::Menu' => {},
|
|
'DBD::Recordtype' => {},
|
|
'DBD::Registrar' => {},
|
|
'DBD::Variable' => {},
|
|
'COMMENTS' => [],
|
|
'POD' => []
|
|
};
|
|
bless $this, $class;
|
|
return $this;
|
|
}
|
|
|
|
sub add {
|
|
my ($this, $obj) = @_;
|
|
my $obj_class = ref $obj;
|
|
confess "DBD::add: Unknown DBD object type '$obj_class'"
|
|
unless $obj_class =~ m/^DBD::/
|
|
and exists $this->{$obj_class};
|
|
my $obj_name = $obj->name;
|
|
if (exists $this->{$obj_class}->{$obj_name}) {
|
|
return if $obj->equals($this->{$obj_class}->{$obj_name});
|
|
dieContext("A different $obj->{WHAT} named '$obj_name' already exists");
|
|
}
|
|
else {
|
|
$this->{$obj_class}->{$obj_name} = $obj;
|
|
}
|
|
}
|
|
|
|
sub add_comment {
|
|
my $this = shift;
|
|
push @{$this->{COMMENTS}}, @_;
|
|
}
|
|
|
|
sub comments {
|
|
return @{shift->{COMMENTS}};
|
|
}
|
|
|
|
sub add_pod {
|
|
my $this = shift;
|
|
push @{$this->{POD}}, @_;
|
|
}
|
|
|
|
sub pod {
|
|
return @{shift->{POD}};
|
|
}
|
|
|
|
sub breaktables {
|
|
return shift->{'DBD::Breaktable'};
|
|
}
|
|
sub breaktable {
|
|
my ($this, $name) = @_;
|
|
return $this->{'DBD::Breaktable'}->{$name};
|
|
}
|
|
|
|
sub drivers {
|
|
return shift->{'DBD::Driver'};
|
|
}
|
|
|
|
sub functions {
|
|
return shift->{'DBD::Function'};
|
|
}
|
|
|
|
sub menus {
|
|
return shift->{'DBD::Menu'};
|
|
}
|
|
sub menu {
|
|
my ($this, $menu_name) = @_;
|
|
return $this->{'DBD::Menu'}->{$menu_name};
|
|
}
|
|
|
|
sub recordtypes {
|
|
return shift->{'DBD::Recordtype'};
|
|
}
|
|
sub recordtype {
|
|
my ($this, $rtyp_name) = @_;
|
|
return $this->{'DBD::Recordtype'}->{$rtyp_name};
|
|
}
|
|
|
|
sub registrars {
|
|
return shift->{'DBD::Registrar'};
|
|
}
|
|
|
|
sub variables {
|
|
return shift->{'DBD::Variable'};
|
|
}
|
|
|
|
1;
|