[AppWrap-cvs] AppWrap/Apache/AppWrap Doorknob.pm,1.16,1.17 Pager.pm,1.20,1.21 Subs.pm,1.38,1.39

[<pla...@us...>]

Update of /cvsroot/appwrap/AppWrap/Apache/AppWrap
In directory sc8-pr-cvs1:/tmp/cvs-serv21271

Modified Files:
	Doorknob.pm Pager.pm Subs.pm 
Log Message:
Many undocumented robustness and refactoring changes.

Index: Doorknob.pm
===================================================================
RCS file: /cvsroot/appwrap/AppWrap/Apache/AppWrap/Doorknob.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -d -r1.16 -r1.17
*** Doorknob.pm	25 Aug 2003 14:00:35 -0000	1.16
--- Doorknob.pm	2 Nov 2003 07:53:58 -0000	1.17
***************
*** 41,46 ****
      # bug out immediately on images and CGI (Apache::Registry modules 
      # in /perl)
!     return DECLINED if $r->uri =~ m!^/images!;
!     return DECLINED if $r->uri =~ m!^/includes!;
      if ($r->uri =~ m!^/perl!) {
        return DECLINED unless $r->uri eq "/perl-status";
--- 41,48 ----
      # bug out immediately on images and CGI (Apache::Registry modules 
      # in /perl)
!     return DECLINED if $r->uri =~ m!^/$config{images}!;
! #    return DECLINED if $r->uri =~ m!^/images!;
!     return DECLINED if $r->uri =~ m!^/$config{includes}!;
! #    return DECLINED if $r->uri =~ m!^/includes!;
      if ($r->uri =~ m!^/perl!) {
        return DECLINED unless $r->uri eq "/perl-status";
***************
*** 50,71 ****
      my $test;
  
  	# get the table and phase. This site presently defines no 
  	# path components beyond the phase: http://domain/$table/$phase
!     my (undef, $table, $phase, undef) = split('/', $r->uri);
      return DECLINED unless $table;
  #$log->debug("\nDoorknob: got table: $table") if $table;
- #$log->debug("\nDoorknob: got phase: $phase") if $phase;
  
      # use %opts to pass info between subs. &Verify might have set 
!     # $r->notes if fields were missing from user input.
      my %opts;
  
  	# load my_defaults before my_tables so that we have default 
  	# values when required.
!     $opts{my_defaults} = Apache::AppWrap::Subs::get_my_defaults();
  
      # get the contents of table:my_tables. Its OK that %opts is 
      # currently empty, my_tables stores a ref in it
      my $my_tables = Apache::AppWrap::Subs::get_my_tables(\%opts);
  
      # bug out if request is not a valid table name
--- 52,94 ----
      my $test;
  
+ 	# Experimental. Attempt to capture the location of 
+ 	# this particular place in URI space used by AppWrap tables
+ 	my $aw_dir = $r->dir_config('AppWrap_Directory');
+ 
+ 
  	# get the table and phase. This site presently defines no 
  	# path components beyond the phase: http://domain/$table/$phase
!     my $uri = $r->uri;
! #$log->debug("\nDoorknob: uri: $uri.");
!     $uri =~ s/^$aw_dir// if $aw_dir;
!     my (undef, $table, $phase, undef) = split('/', $uri);
! #    my (undef, $table, $phase, undef) = split('/', $r->uri);
      return DECLINED unless $table;
  #$log->debug("\nDoorknob: got table: $table") if $table;
  
      # use %opts to pass info between subs. &Verify might have set 
!     # $r->pnotes if fields were missing from user input.
      my %opts;
  
+ 	# preload data commonly used by downstream handlers and subs
  	# load my_defaults before my_tables so that we have default 
  	# values when required.
!     my $my_defaults = Apache::AppWrap::Subs::get_my_defaults();
! 	unless ($my_defaults) {
! 		my $msg = qq{Doorknob: no data from Subs::get_my_defaults()};
! 		$r->log_error($msg);
! 		return SERVER_ERROR;
! 	}
!     $opts{my_defaults} = $my_defaults;
  
      # get the contents of table:my_tables. Its OK that %opts is 
      # currently empty, my_tables stores a ref in it
      my $my_tables = Apache::AppWrap::Subs::get_my_tables(\%opts);
+ 	unless ($my_tables) {
+ 		my $msg = qq{Doorknob: no data from Subs::get_my_tables()};
+ 		$r->log_error($msg);
+ 		return SERVER_ERROR;
+ 	}
+     $opts{my_tables} = $my_tables;
  
      # bug out if request is not a valid table name
***************
*** 79,86 ****
  	# focus audit calendar generate_form verify confirm]
  
! 	# preload data commonly used by downstream handlers and subs
!     $opts{my_tables} = $my_tables;
!     $opts{my_columns} = Apache::AppWrap::Subs::get_my_columns(\%opts);
! #    $opts{my_exceptions}= Apache::AppWrap::Subs::get_my_exceptions();
  
  	# enforce some rules for tables. These are directives 
--- 102,112 ----
  	# focus audit calendar generate_form verify confirm]
  
!     my $my_columns = Apache::AppWrap::Subs::get_my_columns(\%opts);
! 	unless ($my_columns) {
! 		my $msg = qq{Doorknob: no data from Subs::get_my_columns()};
! 		$r->log_error($msg);
! 		return SERVER_ERROR;
! 	}
!     $opts{my_columns} = $my_columns;
  
  	# enforce some rules for tables. These are directives 
***************
*** 241,245 ****
  
  	# these are the desirable my_tables directives
! 	my @my_tables_dirs = qw(table_type label menu_order menu_tab);
  
  	# these are the desirable my_tables directives
--- 267,272 ----
  
  	# these are the desirable my_tables directives
! 	my @my_tables_dirs = qw(table_type label );
! #	my @my_tables_dirs = qw(table_type label menu_order menu_tab);
  
  	# these are the desirable my_tables directives

Index: Pager.pm
===================================================================
RCS file: /cvsroot/appwrap/AppWrap/Apache/AppWrap/Pager.pm,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -d -r1.20 -r1.21
*** Pager.pm	19 Jan 2003 23:29:24 -0000	1.20
--- Pager.pm	2 Nov 2003 07:53:58 -0000	1.21
***************
*** 302,306 ****
  
  	my $row_count = scalar(@$to_display) if $to_display;
! 	$opts->{row_count} = $row_count;
  
  	######## this is the data_header section ########
--- 302,306 ----
  
  	my $row_count = scalar(@$to_display) if $to_display;
! 	$opts->{row_count} = $row_count || 1;
  
  	######## this is the data_header section ########

Index: Subs.pm
===================================================================
RCS file: /cvsroot/appwrap/AppWrap/Apache/AppWrap/Subs.pm,v
retrieving revision 1.38
retrieving revision 1.39
diff -C2 -d -r1.38 -r1.39
*** Subs.pm	25 Aug 2003 14:00:35 -0000	1.38
--- Subs.pm	2 Nov 2003 07:53:58 -0000	1.39
***************
*** 29,32 ****
--- 29,33 ----
  use Apache::Util ();
  use Apache::File ();
+ use Apache::Request ();
  use File::Spec ();
  
***************
*** 299,307 ****
        # add the field information to the data structure
        $column_meta->{$table}{$column} = {
!         'scale'		=>$scale,
! 	'precision'	=>$prec,
! 	'type'		=>$type,
! 	'nullable'	=>$nullable
! 	};
      }
      # Explicitly de-allocate the statement resources
--- 300,308 ----
        # add the field information to the data structure
        $column_meta->{$table}{$column} = {
! 			'scale'		=> $scale,
! 			'precision'	=> $prec,
! 			'type'		=> $type,
! 			'nullable'	=> $nullable,
! 		};
      }
      # Explicitly de-allocate the statement resources
***************
*** 1560,1564 ****
  		$icon = '<link rel="shortcut icon" href="' . $img;
  		$icon .= ' type="' . $my_defaults->{favicontype};
! 		$icon = '" title="Favorite" />' . $HNL;
  	}
  	# print the opening html
--- 1561,1565 ----
  		$icon = '<link rel="shortcut icon" href="' . $img;
  		$icon .= ' type="' . $my_defaults->{favicontype};
! 		$icon .= '" title="Favorite" />' . $HNL;
  	}
  	# print the opening html
***************
*** 1568,1575 ****
  	my $header = $doc_type;
  #  my $header = '<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US">' . $HNL;
! 	$header .= '<head><title>' . $screen_title . '</title>' . $HNL;
! 	$header .= "<!-- This is AppWrap $AppWrap::VERSION -->" . $HNL;
  	$header .= $icon if $iconfile;
! 	$header .= '<link rev="made" href="' . $my_defaults->{emailaddy};
  	$header .= '" />' . $HNL;
  
--- 1569,1576 ----
  	my $header = $doc_type;
  #  my $header = '<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US">' . $HNL;
! 	$header .= qq{<head><title>$screen_title</title>$HNL};
! 	$header .= qq{<!-- This is AppWrap $AppWrap::VERSION -->$HNL};
  	$header .= $icon if $iconfile;
! 	$header .= qq{<link rev="made" href="$my_defaults->{emailaddy}};
  	$header .= '" />' . $HNL;
  
***************
*** 1597,1620 ****
  	$header .= $HNL;
    
!   # link-in the javascript library. With thanks to the phpMyAdmin team
!   $header .= '<script src="' . '/';
!   $header .= $config{includes} . '/' . $my_defaults->{javascript_lib};
!   $header .= '" type="text/javascript" language="javascript"></script>';
!   $header .= $HNL . '</head>' . $HNL . '<body>';
!   push @output, $header;
  
!   # this is the width of yer basic display device
!   my $screen_width = '960';
  
!   my $main_table_width = $opts->{main_table_width};
!   $main_table_width ||= $my_defaults->{main_table_width};
!   my $vbar_width = $opts->{vbar_width};
!   $vbar_width ||= $my_tables->{$table}{vbar_width} if $table;
!   $vbar_width ||= $my_defaults->{vbar_width};
!   my $vbar_class = $opts->{vbar_class} ||= 'vbar';
  
!   # start a div for logo and motd. Want motd to cling to right side 
!   # of table or screen. Leave 600 px for the motd
!   my @header;
  	# first float in the motd area into the upper right of the screen.
  	push @header, '<!-- default screen width is 960px -->' . $HNL;
--- 1598,1621 ----
  	$header .= $HNL;
    
! 	# link-in the javascript library. With thanks to phpMyAdmin.
! 	$header .= '<script src="/' . $config{includes};
! 	$header .= '/' . $my_defaults->{javascript_lib} . '"';
! 	$header .= qq{ type="text/javascript" language="javascript">};
! 	$header .= qq{</script>$HNL</head>$HNL<body>};
! 	push @output, $header;
  
! 	# this is the width of yer basic display device
! 	my $screen_width = '960';
  
! 	my $main_table_width = $opts->{main_table_width};
! 	$main_table_width ||= $my_defaults->{main_table_width};
! 	my $vbar_width = $opts->{vbar_width};
! 	$vbar_width ||= $my_tables->{$table}{vbar_width} if $table;
! 	$vbar_width ||= $my_defaults->{vbar_width};
! 	my $vbar_class = $opts->{vbar_class} ||= 'vbar';
  
! 	# start a div for logo and motd. Want motd to cling to right side 
! 	# of table or screen. Leave 600 px for the motd
! 	my @header;
  	# first float in the motd area into the upper right of the screen.
  	push @header, '<!-- default screen width is 960px -->' . $HNL;
***************
*** 1659,1677 ****
  	# run &tab_bar before starting the table so that we have the width 
  	# of all the tabs
! 	my $tab_bar = tab_bar($opts);
! #$log->debug("\nWebify: $tab_bar");
  
! 	# Get tabs for tabbed user interface. 
! 	if ($tab_bar && scalar(@$tab_bar)) {
! 		foreach my $tab (@$tab_bar) {
! 			push @output, $tab if $tab;
! 		}
!   	}
!   ### This is where to add new JavScript header logic or sub() call. 
!   # Long term solution should have subroutine call replace the logic 
!   # in startup.pl which populates 
!   # $config{header}. For now, do it here so 
!   # changes are reloaded without restarting the server.
!   # page titles, start with header file
  
  	# Setup the div for the vertical bar on the left side
--- 1660,1679 ----
  	# run &tab_bar before starting the table so that we have the width 
  	# of all the tabs
! 	if ($my_defaults->{tabbed_menus}) {
! 		my $tab_bar = tab_bar($opts);
  
! 		# Get tabs for tabbed user interface. 
! 		if ($tab_bar && scalar(@$tab_bar)) {
! 			foreach my $tab (@$tab_bar) {
! 				push @output, $tab if $tab;
! 			}
! 	  	}
! 	}
! 	### This is where to add new JavScript header logic or sub() call. 
! 	# Long term solution should have subroutine call replace the logic 
! 	# in startup.pl which populates 
! 	# $config{header}. For now, do it here so 
! 	# changes are reloaded without restarting the server.
! 	# page titles, start with header file
  
  	# Setup the div for the vertical bar on the left side
***************
*** 1696,1719 ****
  	my $width = $my_defaults->{vbar_table_width};
  
!   push @output, '	<!-- This is the daily stats table -->' . $HNL;
!   my $daily_stats = daily_stats( $opts );
!   if ($daily_stats && scalar(@$daily_stats)) {
! 	push @output, join("", @$daily_stats);
!   }
!   $text = '</div> <!-- This ends the leftvbar div -->';
!   push @output, $text . $HNL;
  
!   # this will print nothing if no $opts->{Title} defined
!   my $title = $opts->{Title};
!   if ($title) {
! 	  push @output, '      <p id="title">' . $title . '</p>' . $HNL;
!   }
  
!   # some pages set no subtitle, so check for it.
!   my $subtitle = $opts->{SubTitle};
!   if ($subtitle) {
! 	push @output, '      <p id="subtitle">' . $subtitle;
! 	push @output, '</p>' . $HNL;
!   }
    # start the main body area
    # Body of page
--- 1698,1721 ----
  	my $width = $my_defaults->{vbar_table_width};
  
! 	# skip if stats aren't enbled
! 	if ($my_defaults->{dailystats_enabled}) {
! 		push @output, qq{	<!-- This is the daily stats table -->$HNL};
! 		my $daily_stats = daily_stats( $opts );
! 		if ($daily_stats && scalar(@$daily_stats)) {
! 			push @output, join "", @$daily_stats;
! 		}
! 	}
! 	$text = '</div> <!-- This ends the leftvbar div -->';
! 	push @output, $text . $HNL;
  
! 	# this will print nothing if no $opts->{Title} defined
! 	my $title = $opts->{Title};
! 	push @output, qq{      <p id="title">$title</p>$HNL} if $title;
  
! 	# some pages set no subtitle, so check for it.
! 	my $subtitle = $opts->{SubTitle};
! 	if ($subtitle) {
! 		push @output, qq{      <p id="subtitle">$subtitle</p>$HNL};
! 	}
    # start the main body area
    # Body of page
***************
*** 2060,2076 ****
  ###############################
  sub get_my_tables {
!     my $opts = shift;
!     my %my_tables;
!     my $ref = sqlSelectArrayRef('*', 'my_tables');
! 	my $log = Apache->request->log;
  	my $test;
  #	my $test = join (", ", map {$_ . '=' . $args->{$_} } %$args);
  #$log->debug("\nget_my_tqbles: args=$test");
  
!   foreach my $row (@$ref) {
!     my ($idnum, $tablename, $admin_name, $admin_value) = @$row;
!     $my_tables{$tablename}{$admin_name} = $admin_value;
!   }
!   
  	##############################
  	# here we will fudge just a bit. Want to get all text labels 
--- 2062,2079 ----
  ###############################
  sub get_my_tables {
! 	my $opts = shift;
! 	my %my_tables;
! 	my $ref = sqlSelectArrayRef('*', 'my_tables');
! 	my $r = Apache->request;
! 	my $log = $r->log;
  	my $test;
  #	my $test = join (", ", map {$_ . '=' . $args->{$_} } %$args);
  #$log->debug("\nget_my_tqbles: args=$test");
  
! 	foreach my $row (@$ref) {
! 	my ($idnum, $tablename, $admin_name, $admin_value) = @$row;
! 	$my_tables{$tablename}{$admin_name} = $admin_value;
! 	}
! 	
  	##############################
  	# here we will fudge just a bit. Want to get all text labels 
***************
*** 2080,2108 ****
  	# AppWrap lot. This is good.
  	##############################
! 	my $my_text = $opts->{my_text};
! 	$my_text ||= get_my_text($opts);
! 	$opts->{my_text} = $my_text;
  #	foreach my $tablename (%$my_text) {
  #		foreach my $tablename (%$my_text) {
  #	}
  
! 
!   # while we are here, lets store a list of all valid tables
!   my @valid_tables;
!   foreach (keys %my_tables) {
!     next unless $_;
!     # some tables have no key_type, so allow this.
!     next unless $my_tables{$_}{parent};
!     next unless $my_tables{$_}{menu_order};
!     next if ($my_tables{$_}{table_type} && 
  		$my_tables{$_}{table_type} eq 'report');
! #    next if $my_tables{$_}{report};
!     next if $my_tables{$_}{beta};
!     # store a list of valid tables, which will generate no 
!     # 'uninitialized value' errors
!     push @valid_tables, $_;
!   }
!   $opts->{valid_tables} = \@valid_tables;
!   return \%my_tables;
  } # end my_tables sub
  
--- 2083,2115 ----
  	# AppWrap lot. This is good.
  	##############################
! #	my $my_text = $opts->{my_text};
! #	$my_text ||= get_my_text($opts);
! #	unless ($my_text) {
! #		my $msg = q{Subs::get_my_tables: no data from &get_my_text};
! #		$r->log_error($msg);
! #		return;
! #	}
! #	$opts->{my_text} = $my_text;
  #	foreach my $tablename (%$my_text) {
  #		foreach my $tablename (%$my_text) {
  #	}
  
! 	# while we are here, lets store a list of all valid tables
! 	my @valid_tables;
! 	foreach (keys %my_tables) {
! 		next unless $_;
! 		# some tables have no key_type, so allow this.
! 		next unless $my_tables{$_}{parent};
! 		next unless $my_tables{$_}{menu_order};
! 		next if ($my_tables{$_}{table_type} && 
  		$my_tables{$_}{table_type} eq 'report');
! #   	 next if $my_tables{$_}{report};
! 		next if $my_tables{$_}{beta};
! 		# store a list of valid tables, which will generate no 
! 		# 'uninitialized value' errors
! 		push @valid_tables, $_;
! 	}
! 	$opts->{valid_tables} = \@valid_tables;
! 	return \%my_tables;
  } # end my_tables sub
  
***************
*** 2138,2141 ****
--- 2145,2150 ----
  sub get_my_text {
  	my ($opts, $args) = @_;
+ 	my $r = Apache->request;
+ 
  	my $text;
  	my $test;
***************
*** 2148,2162 ****
  	$lang ||= get_language($opts);
  	$opts->{language} ||= $lang;
  
- 	my $r = Apache->request;
  	my $log = $r->log;
! 	$test = join (", ", map {$_ . '=' . $args->{$_} } %$args);
  #$log->debug("\nget_my_text: args=$test");
  	my $user = $r->pnotes('authed_email');
! 	unless ($lang) {
! 		$text = $r->as_string;
! #		$r->log_error("get_my_text: request: $text");
! 		return SERVER_ERROR;
  	}
  	# because language can be specified in a query string arg, 
  	# we must test for the existence of the specified language
--- 2157,2180 ----
  	$lang ||= get_language($opts);
  	$opts->{language} ||= $lang;
+ 	unless ($lang) {
+ 		my $msg = qq{Subs::get_my_text: no language found};
+ 		$r->log_error($msg);
+ 		return;
+ 	}
  
  	my $log = $r->log;
! #	$test = join (", ", map {$_ . '=' . $args->{$_} } %$args);
  #$log->debug("\nget_my_text: args=$test");
+ 	# get user from AppWrap, or see if another app stuffed 
+ 	# it into the browser
  	my $user = $r->pnotes('authed_email');
! 	$user ||= $r->connection->user;
! 
! 	unless ($user) {
! 		my $msg = q{Subs::get_my_text: no user name found};
! 		$r->log_error($msg);
! 		return;
  	}
+ 
  	# because language can be specified in a query string arg, 
  	# we must test for the existence of the specified language
***************
*** 2167,2179 ****
  		s/^lang_//
  	} keys %{ $config{column_meta}{my_text} };
  #$test = join(", ", @languages);
  #$log->debug("\nget_my_text: langs=$test");
  	unless (grep(/$lang/, @languages)) {
! 		$text = qq{get_my_text: language $text requested by};
  		$text .= qq{ $user not found: };
  		$text .= $r->as_string;
  		$r->log_error($text);
  		# set the language to the default
! 		$lang = $opts->{my_defaults}{language_default};
  	}
  
--- 2185,2205 ----
  		s/^lang_//
  	} keys %{ $config{column_meta}{my_text} };
+ 
  #$test = join(", ", @languages);
  #$log->debug("\nget_my_text: langs=$test");
+ 
+ 	unless (scalar(@languages)) {
+ 		my $msg = q{Subs::get_my_text(): no language fields};
+ 		$msg .= q{ found in table my_text.};
+ 		$r->log_error($msg);
+ 		return;
+ 	}
  	unless (grep(/$lang/, @languages)) {
! 		$text = qq{Subs::get_my_text: language "$lang" requested by};
  		$text .= qq{ $user not found: };
  		$text .= $r->as_string;
  		$r->log_error($text);
  		# set the language to the default
! 		$lang = $opts->{my_defaults}{language};
  	}
  
***************
*** 2203,2206 ****
--- 2229,2233 ----
  		$my_text{$tablename}{$caller}{$element} = $text;
  	}
+ 	$opts->{my_text} = \%my_text;
  	return \%my_text;
  } # end get_my_text sub
***************
*** 3247,3260 ****
  sub daily_stats {
    my $opts = shift;
  
    my $my_tables = $opts->{my_tables};
    my $table = $opts->{table};
-   my $my_defaults = $opts->{my_defaults};
    my $r = Apache->request;
    my $log = $r->log;
  
-   # bail out if stats aren't enbled
-   return unless $my_defaults->{dailystats_enabled};
- 
    # start is the day we began collecting stats. Should be the first 
    # entry in the 'sitestats' table
--- 3274,3285 ----
  sub daily_stats {
    my $opts = shift;
+   my $my_defaults = $opts->{my_defaults};
+ 
  
    my $my_tables = $opts->{my_tables};
    my $table = $opts->{table};
    my $r = Apache->request;
    my $log = $r->log;
  
    # start is the day we began collecting stats. Should be the first 
    # entry in the 'sitestats' table
***************
*** 4467,4471 ****
  	my $test;
  
- #$log->debug("\nget_display_text: phase=$phase");
  	# set arguments to pass to &get_my_text. First up, a language
  	# this bit probably belongs in an initialization handler
--- 4492,4495 ----
***************
*** 4476,4480 ****
  	# get text messages for this caller
      my $my_text = $opts->{my_text};
!     $my_text ||= get_my_text ($opts, \%my_text_args);
  	$opts->{my_text} ||= $my_text;
  #$log->debug("\nget_display_text: my_text=$my_text");
--- 4500,4509 ----
  	# get text messages for this caller
      my $my_text = $opts->{my_text};
!     $my_text ||= get_my_text($opts);
! 	unless ($my_text) {
! 		my $msg = q{Subs::get_txt: no data from &get_my_text};
! 		$r->log_error($msg);
! 		return;
! 	}
  	$opts->{my_text} ||= $my_text;
  #$log->debug("\nget_display_text: my_text=$my_text");
***************
*** 4584,4587 ****
--- 4613,4621 ----
  	my $my_text = $opts->{my_text};
  	$my_text ||= get_my_text($opts);
+ 	unless ($my_text) {
+ 		my $msg = q{Subs::get_txt: no data from &get_my_text};
+ 		$r->log_error($msg);
+ 		return;
+ 	}
  	$opts->{my_text} = $my_text;
  #$test = scalar(keys %$my_text);