File: Caution.pm

package info (click to toggle)
sporum 1.8b1-3.1
  • links: PTS
  • area: main
  • in suites: woody
  • size: 1,108 kB
  • ctags: 676
  • sloc: perl: 14,300; makefile: 52
file content (90 lines) | stat: -rw-r--r-- 1,978 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
package Templates::Caution;

use SmallPigVars qw($config);
use Templates::Default;

use strict;
use vars qw(@ISA $template $lang);

@ISA = qw(Templates::Default);

sub new{
  my ($class, $spcgi, $spdb, $btitle, $bmsg, $uri, $refresh) = @_;

  $template = Templates::Default->new($spcgi, $spdb, "index");

  $template->{'STATE'} = $spcgi->{'STATE'};
  $template->{'spdb'} = $spdb || SPDB->new;
  
  $template->{'pagetype'} = "caution";

  $template->{'title'} = "";

  $lang = $template->{'lang'};
  
  $template->{'btitle'}   = $btitle || $lang->{'cant_proceed'};
  $template->{'bmsg'}     = $bmsg;
  $template->{'uri'}      = $uri || $ENV{'SCRIPT_NAME'};
  $template->{'refresh'}  = $config->{'refresh'} || $refresh || 2 if $refresh != -1; 
  $template->{'cookie'};

  bless $template, $class;

  $template->initialize();
  
  return $template;
}

#########################################################################
# --- Sun Dec 19 23:06:10 PST 1999
# ---
sub initialize{
  my ($template) = @_;
  
  my $pagefiles = {};
  $pagefiles->{'caution'} = "caution.temp";
  
  $template->{'pagefiles'} = $pagefiles;

  my $pagesubs = {};
  $pagesubs->{'caution'} = \&whole;
  
  $template->{'pagesubs'} = $pagesubs;
}

#########################################################################
# --- pagesubs
# ---
sub whole{
  $template->SUPER::print_standard_index();
  print_caution_msg();
}

sub print_caution_msg{
  my ($STATE, $spdb, $btitle, $bmsg) = 
      map{ $template->{$_} } qw(STATE spdb btitle bmsg);
  my $DBH = $spdb->{'dbh'};

  my $back =  qq|<a href="$template->{'uri'}">&lt</a> <a href="$template->{'uri'}">back</a>| if !$btitle;
  
  $btitle ||= $template->{'btitle'};
  $bmsg ||= $template->{'bmsg'};
  
  $template->SUPER::print_block_start("","", $btitle);

  print qq|
      <TR><TD>
	  <TABLE border=0 cellpadding=10><TR><TD>
	      $bmsg<br>$back

		  </TD></TR></TABLE>
		      </TD></TR>|;
  
  $template->SUPER::print_block_end();
}

return 1;