--- /dev/null
+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-01-20 09:30:36 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-01-20 09:30:36 ivan
+skeletal cross-UI UI code.
+
+
+=cut
+
+1;
+
--- /dev/null
+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 ( "<BR>", map $_->sprint, @{ $self->{'Widgets'} } ),
+ $self->_footer,
+ ;
+}
+
+=item _header
+
+=cut
+
+sub _header {
+ my $self = shift;
+ my $cgi = $self->{'_cgi'};
+
+ $cgi->header( '-expires' => 'now' ), '<HTML>',
+ '<HEAD><TITLE>', $self->title, '</TITLE></HEAD>',
+ '<BODY BGCOLOR="#ffffff">',
+ '<FONT COLOR="#ff0000" SIZE=7>', $self->title, '</FONT><BR><BR>',
+ ;
+}
+
+=item _footer
+
+=cut
+
+sub _footer {
+ "</BODY></HTML>";
+}
+
+=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(<A HREF="$BASE_URL/$method/$table.cgi?$yuck">). $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<FS::UI::Base>
+
+=head1 HISTORY
+
+$Log: CGI.pm,v $
+Revision 1.1 1999-01-20 09:30:36 ivan
+skeletal cross-UI UI code.
+
+
+=cut
+
+1;
+
--- /dev/null
+package FS::UI::Gtk;
+
+use strict;
+use Gtk;
+use FS::UID qw(adminsuidsetup);
+
+die "Can't initialize Gtk interface; $FS::UI::Base::_lock used"
+ if $FS::UI::Base::_lock;
+$FS::UI::Base::_lock = "FS::UI::Gtk";
+
+=head1 NAME
+
+FS::UI::Gtk - Base class for Gtk user-interface objects
+
+=head1 SYNOPSIS
+
+ use FS::UI::Gtk;
+ 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::Gtk object represents a Gtk user interface object.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = { @_ };
+
+ bless ( $self, $class );
+
+ $self->{'_user'} = 'ivan'; #Pop up login window?
+ $self->{'_dbh'} = FS::UID::adminsuidsetup $self->{'_user'};
+
+
+
+ $self;
+}
+
+sub activate {
+ my $self = shift;
+
+ my $vbox = new Gtk::VBox ( 0, 4 );
+
+ foreach my $widget ( @{ $self->{'Widgets'} } ) {
+ $widget->_gtk->show;
+ $vbox->pack_start ( $widget->_gtk, 1, 1, 4 );
+ }
+ $vbox->show;
+
+ my $window = new Gtk::Window "toplevel";
+ $self->{'_gtk'} = $window;
+ $window->set_title( $self->title );
+ $window->add ( $vbox );
+ $window->show;
+ main Gtk;
+}
+
+=item interface
+
+Returns the string `Gtk'. Useful for the author of a table-specific UI class
+to conditionally specify certain behaviour.
+
+=cut
+
+sub interface { 'Gtk'; }
+
+=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 _gtk {
+ my $self = shift;
+ $self->{'_gtk'};
+}
+
+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->{'_gtk'} = new Gtk::Label ( shift );
+ bless ( $self, $class );
+}
+
+package FS::UI::_Link;
+
+use vars qw ( @ISA );
+
+@ISA = qw ( FS::UI::_Widget );
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = { @_ };
+ $self->{'_gtk'} = new_with_label Gtk::Button ( $self->{'text'} );
+ $self->{'_gtk'}->signal_connect( 'clicked', sub {
+ print "STUB: (Gtk) FS::UI::_Link";
+ }, "hi", "there" );
+ bless ( $self, $class );
+}
+
+
+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 = { @_ };
+ bless ( $self, $class );
+
+ $self->{'_gtk'} = new Gtk::Table (
+ $self->rows,
+ $self->columns,
+ 0, #homogeneous
+ );
+
+ $self;
+}
+
+sub attach {
+ my $self = shift;
+ my ( $row, $column, $widget, $rowspan, $colspan ) = @_;
+ $rowspan ||= 1;
+ $colspan ||= 1;
+ $self->_gtk->attach_defaults(
+ $widget->_gtk,
+ $column,
+ $column + $colspan,
+ $row,
+ $row + $rowspan,
+ );
+ $widget->_gtk->show;
+}
+
+package FS::UI::_Tableborder;
+
+use vars qw ( @ISA );
+
+@ISA = qw ( FS::UI::_Table );
+
+=head1 VERSION
+
+$Id: Gtk.pm,v 1.1 1999-01-20 09:30:36 ivan Exp $
+
+=head1 BUGS
+
+This documentation is incomplete.
+
+_Tableborder is just a _Table now. _Tableborders should scroll (but not the
+headers) and need and need more decoration. (data in white section ala gtksql
+and sliding field widths) headers should be buttons that callback to sort on
+their fields.
+
+There should be a persistant, per-(freeside)-user store for window positions
+and sizes and sort fields etc (see L<FS::UI::CGI/BUGS>.
+
+Still some small bits of widget code same as FS::UI::CGI.
+
+=head1 SEE ALSO
+
+L<FS::UI::Base>
+
+=head1 HISTORY
+
+$Log: Gtk.pm,v $
+Revision 1.1 1999-01-20 09:30:36 ivan
+skeletal cross-UI UI code.
+
+
+=cut
+
+1;
+
--- /dev/null
+package FS::UI::agent;
+
+use strict;
+use vars qw ( @ISA );
+use FS::UI::Base;
+use FS::Record qw( qsearchs );
+use FS::agent;
+use FS::agent_type;
+
+@ISA = qw ( FS::UI::Base );
+
+sub db_table { 'agent' };
+
+sub db_name { 'Agent' };
+
+sub db_description { <<END;
+Agents are resellers of your service. Agents may be limited to a subset of your
+full offerings (via their type).
+END
+}
+
+sub list_fields {
+ 'agentnum',
+ 'typenum',
+# 'freq',
+# 'prog',
+; }
+
+sub list_header {
+ 'Agent',
+ 'Type',
+# 'Freq (n/a)',
+# 'Prog (n/a)',
+; }
+
+sub db_callback {
+ 'agentnum' =>
+ sub {
+ my ( $agentnum, $record ) = @_;
+ my $agent = $record->agent;
+ new FS::UI::_Link (
+ 'table' => 'agent',
+ 'method' => 'edit',
+ 'arg' => [ $agentnum ],
+ 'text' => "$agentnum: $agent",
+ );
+ },
+ 'typenum' =>
+ sub {
+ my $typenum = shift;
+ my $agent_type = qsearchs( 'agent_type', { 'typenum' => $typenum } );
+ my $atype = $agent_type->atype;
+ new FS::UI::_Link (
+ 'table' => 'agent_type',
+ 'method' => 'edit',
+ 'arg' => [ $typenum ],
+ 'text' => "$typenum: $atype"
+ );
+ },
+}
+
+1;
projects / freeside.git / commitdiff