mirror of
https://github.com/python/cpython.git
synced 2025-11-02 22:51:25 +00:00
75 lines
1.8 KiB
Perl
75 lines
1.8 KiB
Perl
package SynopsisTable;
|
|
|
|
sub new{
|
|
return bless {names=>'', info=>{}};
|
|
}
|
|
|
|
sub declare{
|
|
my($self,$name,$key,$type) = @_;
|
|
if ($self->{names}) {
|
|
$self->{names} .= ",$name";
|
|
}
|
|
else {
|
|
$self->{names} .= "$name";
|
|
}
|
|
$self->{info}{$name} = "$key,$type,";
|
|
}
|
|
|
|
sub set_synopsis{
|
|
my($self,$name,$synopsis) = @_;
|
|
my($key,$type,$unused) = split ',', $self->{info}{$name}, 3;
|
|
$self->{info}{$name} = "$key,$type,$synopsis";
|
|
}
|
|
|
|
sub get{
|
|
my($self,$name) = @_;
|
|
return split /,/, $self->{info}{$name}, 3;
|
|
}
|
|
|
|
sub show{
|
|
my $self = shift;
|
|
my $name;
|
|
print "names: ", $self->{names}, "\n\n";
|
|
foreach $name (split /,/, $self->{names}) {
|
|
my($key,$type,$synopsis) = $self->get($name);
|
|
print "$name($key) is $type: $synopsis\n";
|
|
}
|
|
}
|
|
|
|
sub tohtml{
|
|
my $self = shift;
|
|
my $data = "<table class=\"synopsistable\">\n";
|
|
my $name;
|
|
foreach $name (split /,/, $self->{names}) {
|
|
my($key,$type,$synopsis) = $self->get($name);
|
|
my $link = "<a href=\"module-$key.html\">";
|
|
$data .= (" <tr>"
|
|
. "<td><b><tt class=module>$link$name</a></tt></b></td>\n"
|
|
. " <td class=synopsis>$synopsis</td></tr>\n");
|
|
}
|
|
$data .= "</table>\n";
|
|
$data;
|
|
}
|
|
|
|
|
|
package testSynopsisTable;
|
|
|
|
sub test{
|
|
# this little test is mostly to debug the stuff above, since this is
|
|
# my first Perl "object".
|
|
my $st = SynopsisTable->new();
|
|
$st->declare("sample", "sample", "standard");
|
|
$st->set_synopsis("sample", "This is a little synopsis....");
|
|
$st->declare("copy_reg", "copyreg", "standard");
|
|
$st->set_synopsis("copy_reg", "pickle support stuff");
|
|
$st->show();
|
|
|
|
print "\n\n";
|
|
|
|
my $st2 = SynopsisTable->new();
|
|
$st2->declare("st2module", "st2module", "built-in");
|
|
$st2->set_synopsis("st2module", "silly little synopsis");
|
|
$st2->show();
|
|
}
|
|
|
|
1; # This must be the last line -- Perl is bogus!
|