X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;ds=sidebyside;f=site_perl%2FUI%2FCGI.pm;fp=site_perl%2FUI%2FCGI.pm;h=0000000000000000000000000000000000000000;hb=be415b1dd6b788a2fe2071093b404ff10cfd4654;hp=e02e3d35af9ff41d9811e4904d157e26ca775d8f;hpb=c4534c2eb63a4eadfb588cefef0007e85c057036;p=freeside.git diff --git a/site_perl/UI/CGI.pm b/site_perl/UI/CGI.pm deleted file mode 100644 index e02e3d35a..000000000 --- a/site_perl/UI/CGI.pm +++ /dev/null @@ -1,236 +0,0 @@ -package FS::UI::CGI; - -use strict; -use CGI; -#use CGI::Switch; #when FS::UID user and preference callback stuff is fixed -use CGI::Carp qw(fatalsToBrowser); -use HTML::Table; -use FS::UID qw(adminsuidsetup); -#use FS::Record qw( qsearch fields ); - -die "Can't initialize CGI interface; $FS::UI::Base::_lock used" - if $FS::UI::Base::_lock; -$FS::UI::Base::_lock = "FS::UI::CGI"; - -=head1 NAME - -FS::UI::CGI - Base class for CGI user-interface objects - -=head1 SYNOPSIS - - use FS::UI::CGI; - 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::CGI object represents a CGI interface object. - -=head1 METHODS - -=over 4 - -=item new - -=cut - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = { @_ }; - - $self->{'_cgi'} = new CGI; - $self->{'_user'} = $self->{'_cgi'}->remote_user; - $self->{'_dbh'} = FS::UID::adminsuidsetup $self->{'_user'}; - - bless ( $self, $class); -} - -sub activate { - my $self = shift; - print $self->_header, - join ( "
", map $_->sprint, @{ $self->{'Widgets'} } ), - $self->_footer, - ; -} - -=item _header - -=cut - -sub _header { - my $self = shift; - my $cgi = $self->{'_cgi'}; - - $cgi->header( '-expires' => 'now' ), '', - '', $self->title, '', - '', - '', $self->title, '

', - ; -} - -=item _footer - -=cut - -sub _footer { - ""; -} - -=item interface - -Returns the string `CGI'. Useful for the author of a table-specific UI class -to conditionally specify certain behaviour. - -=cut - -sub interface { 'CGI'; } - -=back - -=cut - -package FS::UI::_Widget; - -use vars qw( $AUTOLOAD ); - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = { @_ }; - bless ( $self, $class ); -} - -sub AUTOLOAD { - my $self = shift; - my $value = shift; - my($field)=$AUTOLOAD; - $field =~ s/.*://; - if ( defined($value) ) { - $self->{$field} = $value; - } else { - $self->{$field}; - } -} - -package FS::UI::_Text; - -use vars qw ( @ISA ); - -@ISA = qw ( FS::UI::_Widget); - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = {}; - $self->{'_text'} = shift; - bless ( $self, $class ); -} - -sub sprint { - my $self = shift; - $self->{'_text'}; -} - -package FS::UI::_Link; - -use vars qw ( @ISA $BASE_URL ); - -@ISA = qw ( FS::UI::_Widget); -$BASE_URL = "http://rootwood.sisd.com/freeside"; - -sub sprint { - my $self = shift; - my $table = $self->{'table'}; - my $method = $self->{'method'}; - - # i will be cleaned up when we're done moving from the old webinterface! - my @arg = @{$self->{'arg'}}; - my $yuck = join( "&", @arg); - qq(). $self->{'text'}. "<\A>"; -} - -package FS::UI::_Table; - -use vars qw ( @ISA ); - -@ISA = qw ( FS::UI::_Widget); - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = $class eq $proto ? { @_ } : $proto; - bless ( $self, $class ); - $self->{'_table'} = new HTML::Table ( $self->rows, $self->columns ); - $self; -} - -sub attach { - my $self = shift; - my ( $row, $column, $widget, $rowspan, $colspan ) = @_; - $self->{"_table"}->setCell( $row+1, $column+1, $widget->sprint ); - $self->{"_table"}->setCellRowSpan( $row+1, $column+1, $rowspan ) if $rowspan; - $self->{"_table"}->setCellColSpan( $row+1, $column+1, $colspan ) if $colspan; -} - -sub sprint { - my $self = shift; - $self->{'_table'}->getTable; -} - -package FS::UI::_Tableborder; - -use vars qw ( @ISA ); - -@ISA = qw ( FS::UI::_Table ); - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = $class eq $proto ? { @_ } : $proto; - bless ( $self, $class ); - $self->SUPER::new(@_); - $self->{'_table'}->setBorder; - $self; -} - -=head1 VERSION - -$Id: CGI.pm,v 1.1 1999-01-20 09:30:36 ivan Exp $ - -=head1 BUGS - -This documentation is incomplete. - -In _Tableborder, headers should be links that sort on their fields. - -_Link uses a constant $BASE_URL - -_Link passes the arguments as a manually-constructed GET string instead -of POSTing, for compatability while the web interface is upgraded. Once -this is done it should pass arguements properly (i.e. as a POST, 8-bit clean) - -Still some small bits of widget code same as FS::UI::Gtk. - -=head1 SEE ALSO - -L - -=head1 HISTORY - -$Log: CGI.pm,v $ -Revision 1.1 1999-01-20 09:30:36 ivan -skeletal cross-UI UI code. - - -=cut - -1; -