1# ====================================================================
2# Copyright (C) 1997,1998 Stephen Farrell <stephen@farrell.org>
3#
4# All rights reserved.  This program is free software; you can
5# redistribute it and/or modify it under the same terms as Perl
6# itself.
7#
8# ====================================================================
9# File: Symbols.pm
10# Author: Stephen Farrell
11# Created: August 1997
12# Locations: http://www.palefire.org/~sfarrell/TableLayout/
13# CVS $Id: Symbols.pm,v 1.16 1998/09/20 21:07:40 sfarrell Exp $
14# ====================================================================
15
16package HTML::TableLayout::Symbols;
17use Carp;
18use Exporter;
19@ISA=qw(Exporter);
20@EXPORT=qw(
21
22	   parameters
23	   window
24	   win_header
25	   table
26	   cell
27	   cell_header
28	   text
29	   image
30	   link
31	   list
32	   pre
33	   comment
34	   script
35	   hrule
36	   container
37	   font
38
39	   _anchor
40	   _row
41	   _scell
42
43	   form
44	   form_base
45	   choice
46	   button
47	   checkbox
48	   textarea
49	   hidden
50	   faux
51	   input_text
52	   password
53	   submit
54	   radio
55
56	   $NOTER
57	   $OOPSER
58
59	   sum
60	   max
61	   min
62	   params
63
64	  );
65
66
67##
68## magic constructors
69##
70
71
72# :DEFAULT
73sub parameters { return HTML::TableLayout::Parameters->new(@_) }
74sub window { return HTML::TableLayout::Window->new(@_) }
75sub table { return HTML::TableLayout::Table->new(@_) }
76sub cell { return HTML::TableLayout::Cell->new(@_) }
77sub cell_header { return HTML::TableLayout::CellHeader->new(@_) }
78sub win_header { return HTML::TableLayout::WindowHeader->new(@_) }
79sub script { return HTML::TableLayout::Script->new(@_) }
80sub text { return HTML::TableLayout::Component::Text->new(@_) }
81sub image { return HTML::TableLayout::Component::Image->new(@_) }
82sub link { return HTML::TableLayout::Component::Link->new(@_) }
83sub list { return HTML::TableLayout::Component::List->new(@_) }
84sub pre { return HTML::TableLayout::Component::Preformat->new(@_) }
85sub comment { return HTML::TableLayout::Component::Comment->new(@_) }
86sub hrule { return HTML::TableLayout::Component::HorizontalRule->new(@_) }
87sub container { return HTML::TableLayout::ComponentContainer->new(@_) }
88sub font { return HTML::TableLayout::Component::Font->new(@_) }
89
90# :FORM
91sub form { return HTML::TableLayout::Form->new(@_) }
92sub radio { return HTML::TableLayout::FormComponent::Radio->new(@_) }
93sub checkbox { return HTML::TableLayout::FormComponent::Checkbox->new(@_) }
94sub textarea { return HTML::TableLayout::FormComponent::Textarea->new(@_) }
95sub choice { return HTML::TableLayout::FormComponent::Choice->new(@_) }
96sub button { return HTML::TableLayout::FormComponent::Button->new(@_) }
97sub hidden { return HTML::TableLayout::FormComponent::Hidden->new(@_) }
98sub faux { return HTML::TableLayout::FormComponent::Faux->new(@_) }
99sub input_text { return HTML::TableLayout::FormComponent::InputText->new(@_) }
100sub password { return HTML::TableLayout::FormComponent::Password->new(@_) }
101sub submit { return HTML::TableLayout::FormComponent::Submit->new(@_) }
102
103
104##
105## These are callbacks for debugging.  Currently, most calls to the
106## NOTER() are removed.  However, the OOPSER() is very much alive.
107## The OOPSER can be pretty much any code reference that takes, as
108## its first argument, a string explaining what the "oops" was about.
109## By default this is warn(full_trace()); croak(@_);, but you may wish
110## to override this behavior for your application.  I have a
111## database-app that needs to do stuff like rollback the transaction
112## if an error occurs, so I have an exception handler mechanism (aka
113## "goto") which I use to override this behavior.  Just do
114## HTML::TableLayout::Symbols::OOPSER = sub { do_whatever_then_die(@_) };
115##
116$NOTER = sub { carp(@_,"\n")  };
117$OOPSER = sub { warn(full_trace()); croak(@_) };
118
119
120
121##
122## max();min();sum(): Some package-wide utility functions.
123##
124sub max { my ($a, $b) = @_; ($a > $b) ? $a : $b };
125sub min { my ($a, $b) = @_; ($a < $b) ? $a : $b };
126sub sum { my $s=0; foreach (@_) { $s += $_ }; return $s };
127
128##
129## params(): Internally I represent HTML parameters as a hash; this
130## function transforms that hash into a string as appropriate for HTML
131##
132sub params {
133  my (%params) = @_;
134  my ($r, $p);
135  foreach $p (keys %params) {
136    if ($p =~ /^Anchor/) {	# capitalized=>only compare 1 letter (I hope!)
137      $r .= params(HTML::TableLayout::_Anchor->new($params{$p})->value());
138    }
139    elsif (defined $params{$p}) {
140      unless (($p eq "colspan" or $p eq "rowspan") and $params{$p} == 1) {
141	$r .= " $p=\"$params{$p}\"";
142      }
143    }
144    else {
145      $r .= " $p";
146    }
147  }
148  return $r;
149}
150
151
152
153##
154## full_trace(): This is ripped out of Carp.pm--in fact, it is very
155## much like longmess()--I don't just call Carp::longmess (presently)
156## b/c it seems to be "private"-ish, so it would seem to be a mistake
157## to rely upon its existence.
158##
159sub full_trace {
160  my $CarpLevel = 0;		# How many extra package levels to skip on carp.
161  my $MaxEvalLen = 0;		# How much eval '...text...' to show. 0 = all.
162  my $error = shift;
163  my $mess = "";
164  my $i = 1 + $CarpLevel;
165  my ($pack,$file,$line,$sub,$eval,$require);
166  while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) {
167    if ($error =~ m/\n$/) {
168      $mess .= $error;
169    } else {
170      if (defined $eval) {
171	if ($require) {
172	  $sub = "require $eval";
173	} else {
174	  $eval =~ s/([\\\'])/\\$1/g;
175	  if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
176	    substr($eval,$MaxEvalLen) = '...';
177	  }
178	  $sub = "eval '$eval'";
179	}
180      } elsif ($sub eq '(eval)') {
181	$sub = 'eval {...}';
182      }
183      $mess .= "\t$sub " if $error eq "called";
184      $mess .= "$error at $file line $line\n";
185    }
186    $error = "called";
187  }
188  $mess || $error;
189}
190
191
1921;
193