source: gsdl/trunk/cgi-bin/usabcgi.pm@ 18061

Last change on this file since 18061 was 11656, checked in by kjdon, 18 years ago

changed email address to greenstone instead of dmn, moved the html files into greenstone/usability, using httpimg to work out the address

  • Property svn:keywords set to Author Date Id Revision
File size: 3.9 KB
Line 
1package usabcgi;
2
3
4sub get_config_info {
5 open FILEIN, ("gsdlsite.cfg") || die "ERROR: Could not open site configuration file\n";
6
7 my $configfile;
8 while(<FILEIN>) {
9 $configfile .= $_;
10 }
11 close(FILEIN);
12
13
14 ($infotype) = @_;
15
16 $configfile =~ /^$infotype\s+(\S+)\s*\n/m;
17 $loc=$1;
18 $loc =~ s/\"//g;
19
20 return ($loc);
21}
22
23sub get_httpimg {
24 my ($imageloc) = usabcgi::get_config_info("httpimg");
25 if(!($imageloc =~ "http")) {$imageloc="http://".$ENV{HTTP_HOST}.$imageloc;}
26 return $imageloc;
27}
28
29sub get_httpusab {
30 my ($htmlloc) = usabcgi::get_config_info("httpimg");
31 if(!($htmlloc =~ "http")) {$htmlloc="http://".$ENV{HTTP_HOST}.$htmlloc;}
32 $htmlloc =~ s/images/usability/;
33 return $htmlloc;
34
35}
36
37sub printscript {
38
39 print "<script type=\"text/javascript\">\n";
40 print "\tfunction showaboutprivacy(url){\n";
41 print "\t\tinfowin=window.open(url,'infowin','toolbars=0, height=600, width=600')\n";
42 print "\t}\n";
43 print "</script>\n";
44}
45
46sub printbanner {
47 ($title)=@_;
48 ($imageloc) = usabcgi::get_httpimg();
49 print "<table width=\"100%\"><tr>\n<td><h1>Greenstone Usability - $title</h1></td>\n";
50 print "<td align=\"right\">";
51 if ($imageloc) { print "<img src=\"$imageloc\/usabbnr.gif\" alt=\"Greenstone koru design\" title=\"Greenstone koru design\">"; }
52 print "</td>\n</tr></table>";
53}
54
55sub printaplinks {
56 # this is a hack
57 ($htmlloc) = usabcgi::get_httpusab();
58 print "<p class=\"sans\">\n";
59 print "<a href=\"javascript:showaboutprivacy('$htmlloc/about.html')\">About</a>\n &#8226; <a href=\"javascript:showaboutprivacy('$htmlloc/privacy.html')\">Privacy</a>\n";
60
61}
62
63sub printstyle {
64 ($browser) = @_;
65 $browser=~/([^\/]*)\/([0-9]+\.[0-9]+)/;
66 if(($1 ne "Netscape")||($2 > 4.77)){
67 print "<style type=\"text/css\">\n";
68 print "\th1 {font-family: sans-serif; font-size: 20px}\n";
69 print "\th2 {font-family: sans-serif; font-size: 14px; font-weight: bold; color: #009966}\n";
70 print "\tp.sans {font-family: sans-serif}\n";
71 print "\ttd {vertical-align: top}\n";
72 print "\ttd.sans {font-family: sans-serif; width: 50%}\n";
73 print "</style>\n";
74 }
75
76}
77
78sub checkidno {
79 if((!($ENV{QUERY_STRING}=~/\d/)) || ($ENV{QUERY_STRING}=~/\D/) ) {
80 print "<h2>Each report sent has an ID number. This page needs one of those numbers to work.</h2>\n";
81 print "<br><br><p class=\"sans\"><a href=\"mailto:greenstone&#064;cs.waikato.ac.nz\">Contact us</a> with any queries about this.\n";
82 print "</body></html>\n";
83 die;
84 }
85}
86
87sub getusabreportdetails {
88 ($etcfileloc) = usabcgi::get_config_info("gsdlhome");
89 if(!($etcfileloc =~/\/$/)) {$etcfileloc.="/";}
90 $etcfileloc .= "etc/usability.txt";
91 open (FILEIN, $etcfileloc) or die "could not open usability.txt\n";
92 while(<FILEIN>){
93 $etcfile.=$_;
94 }
95 close(FILEIN);
96
97 if(!($etcfile=~ / $ENV{QUERY_STRING}\&usabend;/)) {
98 print "<h2>Each report has an ID number. This program needs one of those ID numbers to work, and the ID number provided wasn't found.</h2>\n";
99 print "<br><br><p class=\"sans\"><a href=\"mailto:greenstone&#064;cs.waikato.ac.nz\">Contact us</a> with any queries about this.\n";
100 print "</body></html>";
101 die;
102 }
103
104#get the report for whjich details are to be viewed.
105 $etcfile=~/report-id := $ENV{QUERY_STRING}\&usabend\;\n/;
106 $report = $&;
107 $tmp=$';
108 $tmp=~/----------------------?/;
109 $report.=$`;
110 @pairs=split(/\&usabend\;\n/,$report);
111 foreach $pair (@pairs) {
112 ($name, $value)= split(/ := /,$pair);
113
114 #this splits long values up for display purposes
115 @tmplist = split(/ /,$value);
116 foreach $item (@tmplist){
117 if(length $item > 60){
118 $tmp="";
119 while(length $item > 60){
120 $tmp.= substr $item, 0, 60;
121 $tmp.=" ";
122 $item = substr $item, 60;
123 }
124 $tmp.=$item;
125 $item=$tmp;
126 }
127 }
128 $value = join(' ',@tmplist);
129
130 #this adds html tags for breaks
131 $value =~ s/\n/\<br\>\n/g;
132 $reportvals{$name}=$value;
133 }
134 return %reportvals;
135
136}
137
1381;
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
Note: See TracBrowser for help on using the repository browser.