FS/FS/UI/Base.pm

   1 package FS::UI::Base;
   2
   3 use strict;
   4 use vars qw ( @ISA );
   5 use FS::Record qw( fields qsearch );
   6
   7 @ISA = ( $FS::UI::Base::_lock );
   8
   9 =head1 NAME
  10
  11 FS::UI::Base - Base class for all user-interface objects
  12
  13 =head1 SYNOPSIS
  14
  15   use FS::UI::SomeInterface;
  16   use FS::UI::some_table;
  17
  18   $interface = new FS::UI::some_table;
  19
  20   $error = $interface->browse;
  21   $error = $interface->search;
  22   $error = $interface->view;
  23   $error = $interface->edit;
  24   $error = $interface->process;
  25
  26 =head1 DESCRIPTION
  27
  28 An FS::UI::Base object represents a user interface object.  FS::UI::Base
  29 is intended as a base class for table-specfic classes to inherit from, i.e.
  30 FS::UI::cust_main.  The simplest case, which will provide a default UI for your
  31 new table, is as follows:
  32
  33   package FS::UI::table_name;
  34   use vars qw ( @ISA );
  35   use FS::UI::Base;
  36   @ISA = qw( FS::UI::Base );
  37   sub db_table { 'table_name'; }
  38
  39 Currently available interfaces are:
  40   FS::UI::Gtk, an X-Windows UI implemented using the Gtk+ toolkit
  41   FS::UI::CGI, a web interface implemented using CGI.pm, etc.
  42
  43 =head1 METHODS
  44
  45 =over 4
  46
  47 =item new
  48
  49 =cut
  50
  51 =item browse
  52
  53 =cut
  54
  55 sub browse {
  56   my $self = shift;
  57
  58   my @fields = $self->list_fields;
  59
  60   #begin browse-specific stuff
  61
  62   $self->title( "Browse ". $self->db_names ) unless $self->title;
  63   my @records = qsearch ( $self->db_table, {} );
  64
  65   #end browse-specific stuff
  66
  67   $self->addwidget ( new FS::UI::_Text ( $self->db_description ) );
  68
  69   my @header = $self->list_header;
  70   my @headerspan = $self->list_headerspan;
  71   my %callback = $self->db_callback;
  72
  73   my $columns;
  74
  75   my $table = new FS::UI::_Tableborder (
  76     'rows' => 1 + scalar(@records),
  77     'columns' => $columns || scalar(@fields),
  78   );
  79
  80   my $c = 0;
  81   foreach my $header ( @header ) {
  82     my $headerspan = shift(@headerspan) || 1;
  83     $table->attach(
  84       0, $c, new FS::UI::_Text ( $header ), 1, $headerspan
  85     );
  86     $c += $headerspan;
  87   }
  88
  89   my $r = 1;
  90
  91   foreach my $record ( @records ) {
  92     $c = 0;
  93     foreach my $field ( @fields ) {
  94       my $value = $record->getfield($field);
  95       my $widget;
  96       if ( $callback{$field} ) {
  97         $widget = &{ $callback{$field} }( $value, $record );
  98       } else {
  99         $widget = new FS::UI::_Text ( $value );
 100       }
 101       $table->attach( $r, $c++, $widget, 1, 1 );
 102     }
 103     $r++;
 104   }
 105
 106   $self->addwidget( $table );
 107
 108   $self->activate;
 109
 110 }
 111
 112 =item title
 113
 114 =cut
 115
 116 sub title {
 117   my $self = shift;
 118   my $value = shift;
 119   if ( defined($value) ) {
 120     $self->{'title'} = $value;
 121   } else {
 122     $self->{'title'};
 123   }
 124 }
 125
 126 =item addwidget
 127
 128 =cut
 129
 130 sub addwidget {
 131   my $self = shift;
 132   my $widget = shift;
 133   push @{ $self->{'Widgets'} }, $widget;
 134 }
 135
 136 #fallback methods
 137
 138 sub db_description {}
 139
 140 sub db_name {}
 141
 142 sub db_names {
 143   my $self = shift;
 144   $self->db_name. 's';
 145 }
 146
 147 sub list_fields {
 148   my $self = shift;
 149   fields( $self->db_table );
 150 }
 151
 152 sub list_header {
 153   my $self = shift;
 154   $self->list_fields
 155 }
 156
 157 sub list_headerspan {
 158   my $self = shift;
 159   map 1, $self->list_header;
 160 }
 161
 162 sub db_callback {}
 163
 164 =back
 165
 166 =head1 VERSION
 167
 168 $Id: Base.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
 169
 170 =head1 BUGS
 171
 172 This documentation is incomplete.
 173
 174 There should be some sort of per-(freeside)-user preferences and the ability
 175 for specific FS::UI:: modules to put their own values there as well.
 176
 177 =head1 SEE ALSO
 178
 179 L<FS::UI::Gtk>, L<FS::UI::CGI>
 180
 181 =head1 HISTORY
 182
 183 $Log: Base.pm,v $
 184 Revision 1.1  1999-08-04 09:03:53  ivan
 185 initial checkin of module files for proper perl installation
 186
 187 Revision 1.1  1999/01/20 09:30:36  ivan
 188 skeletal cross-UI UI code.
 189
 190
 191 =cut
 192
 193 1;
 194