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

Last change on this file since 7768 was 7765, checked in by davidb, 20 years ago

generalisation of RE expression used to match config lines.

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