5 #use CGI::Switch; #when FS::UID user and preference callback stuff is fixed
6 use CGI::Carp qw(fatalsToBrowser);
8 use FS::UID qw(adminsuidsetup);
9 #use FS::Record qw( qsearch fields );
11 die "Can't initialize CGI interface; $FS::UI::Base::_lock used"
12 if $FS::UI::Base::_lock;
13 $FS::UI::Base::_lock = "FS::UI::CGI";
17 FS::UI::CGI - Base class for CGI user-interface objects
22 use FS::UI::some_table;
24 $interface = new FS::UI::some_table;
26 $error = $interface->browse;
27 $error = $interface->search;
28 $error = $interface->view;
29 $error = $interface->edit;
30 $error = $interface->process;
34 An FS::UI::CGI object represents a CGI interface object.
46 my $class = ref($proto) || $proto;
49 $self->{'_cgi'} = new CGI;
50 $self->{'_user'} = $self->{'_cgi'}->remote_user;
51 $self->{'_dbh'} = FS::UID::adminsuidsetup $self->{'_user'};
53 bless ( $self, $class);
59 join ( "<BR>", map $_->sprint, @{ $self->{'Widgets'} } ),
70 my $cgi = $self->{'_cgi'};
72 $cgi->header( '-expires' => 'now' ), '<HTML>',
73 '<HEAD><TITLE>', $self->title, '</TITLE></HEAD>',
74 '<BODY BGCOLOR="#ffffff">',
75 '<FONT COLOR="#ff0000" SIZE=7>', $self->title, '</FONT><BR><BR>',
89 Returns the string `CGI'. Useful for the author of a table-specific UI class
90 to conditionally specify certain behaviour.
94 sub interface { 'CGI'; }
100 package FS::UI::_Widget;
102 use vars qw( $AUTOLOAD );
106 my $class = ref($proto) || $proto;
108 bless ( $self, $class );
114 my($field)=$AUTOLOAD;
116 if ( defined($value) ) {
117 $self->{$field} = $value;
123 package FS::UI::_Text;
125 use vars qw ( @ISA );
127 @ISA = qw ( FS::UI::_Widget);
131 my $class = ref($proto) || $proto;
133 $self->{'_text'} = shift;
134 bless ( $self, $class );
142 package FS::UI::_Link;
144 use vars qw ( @ISA $BASE_URL );
146 @ISA = qw ( FS::UI::_Widget);
147 $BASE_URL = "http://rootwood.sisd.com/freeside";
151 my $table = $self->{'table'};
152 my $method = $self->{'method'};
154 # i will be cleaned up when we're done moving from the old webinterface!
155 my @arg = @{$self->{'arg'}};
156 my $yuck = join( "&", @arg);
157 qq(<A HREF="$BASE_URL/$method/$table.cgi?$yuck">). $self->{'text'}. "<\A>";
160 package FS::UI::_Table;
162 use vars qw ( @ISA );
164 @ISA = qw ( FS::UI::_Widget);
168 my $class = ref($proto) || $proto;
169 my $self = $class eq $proto ? { @_ } : $proto;
170 bless ( $self, $class );
171 $self->{'_table'} = new HTML::Table ( $self->rows, $self->columns );
177 my ( $row, $column, $widget, $rowspan, $colspan ) = @_;
178 $self->{"_table"}->setCell( $row+1, $column+1, $widget->sprint );
179 $self->{"_table"}->setCellRowSpan( $row+1, $column+1, $rowspan ) if $rowspan;
180 $self->{"_table"}->setCellColSpan( $row+1, $column+1, $colspan ) if $colspan;
185 $self->{'_table'}->getTable;
188 package FS::UI::_Tableborder;
190 use vars qw ( @ISA );
192 @ISA = qw ( FS::UI::_Table );
196 my $class = ref($proto) || $proto;
197 my $self = $class eq $proto ? { @_ } : $proto;
198 bless ( $self, $class );
199 $self->SUPER::new(@_);
200 $self->{'_table'}->setBorder;
206 $Id: CGI.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
210 This documentation is incomplete.
212 In _Tableborder, headers should be links that sort on their fields.
214 _Link uses a constant $BASE_URL
216 _Link passes the arguments as a manually-constructed GET string instead
217 of POSTing, for compatability while the web interface is upgraded. Once
218 this is done it should pass arguements properly (i.e. as a POST, 8-bit clean)
220 Still some small bits of widget code same as FS::UI::Gtk.
229 Revision 1.1 1999-08-04 09:03:53 ivan
230 initial checkin of module files for proper perl installation
232 Revision 1.1 1999/01/20 09:30:36 ivan
233 skeletal cross-UI UI code.