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