Doc/perl/SynopsisTable.pm

   1 package SynopsisTable;
   2
   3 sub new{
   4     return bless {names=>'', info=>{}, file=>''};
   5 }
   6
   7 sub declare{
   8     my($self,$name,$key,$type) = @_;
   9     if ($self->{names}) {
  10         $self->{names} .= ",$name";
  11     }
  12     else {
  13         $self->{names} .= "$name";
  14     }
  15     $self->{info}{$name} = "$key,$type,";
  16 }
  17
  18 # The 'file' attribute is used to store the filename of the node in which
  19 # the table will be presented; this assumes that each table will be presented
  20 # only once, which works for the current use of this object.
  21
  22 sub set_file{
  23     my($self, $filename) = @_;
  24     $self->{file} = "$filename";
  25 }
  26
  27 sub get_file{
  28     my $self = shift;
  29     return $self->{file};
  30 }
  31
  32 sub set_synopsis{
  33     my($self,$name,$synopsis) = @_;
  34     my($key,$type,$unused) = split ',', $self->{info}{$name}, 3;
  35     $self->{info}{$name} = "$key,$type,$synopsis";
  36 }
  37
  38 sub get{
  39     my($self,$name) = @_;
  40     return split /,/, $self->{info}{$name}, 3;
  41 }
  42
  43 sub show{
  44     my $self = shift;
  45     my $name;
  46     print "names: ", $self->{names}, "\n\n";
  47     foreach $name (split /,/, $self->{names}) {
  48         my($key,$type,$synopsis) = $self->get($name);
  49         print "$name($key) is $type: $synopsis\n";
  50     }
  51 }
  52
  53 sub tohtml{
  54     my $self = shift;
  55     my $data = "<table class='synopsistable'>\n";
  56     my $name;
  57     foreach $name (split /,/, $self->{names}) {
  58         my($key,$type,$synopsis) = $self->get($name);
  59         my $link = "<a href='module-$key.html'>";
  60         $data .= ('  <tr>'
  61                   . "<td><b><tt class='module'>$link$name</a></tt></b></td>\n"
  62                   . "      <td class='synopsis'>$synopsis</td></tr>\n");
  63     }
  64     $data .= "</table>\n";
  65     $data;
  66 }
  67
  68
  69 package testSynopsisTable;
  70
  71 sub test{
  72     # this little test is mostly to debug the stuff above, since this is
  73     # my first Perl "object".
  74     my $st = SynopsisTable->new();
  75     $st->declare("sample", "sample", "standard");
  76     $st->set_synopsis("sample", "This is a little synopsis....");
  77     $st->declare("copy_reg", "copyreg", "standard");
  78     $st->set_synopsis("copy_reg", "pickle support stuff");
  79     $st->show();
  80
  81     print "\n\n";
  82
  83     my $st2 = SynopsisTable->new();
  84     $st2->declare("st2module", "st2module", "built-in");
  85     $st2->set_synopsis("st2module", "silly little synopsis");
  86     $st2->show();
  87 }
  88
  89 1;      # This must be the last line -- Perl is bogus!