2 # Captive project DriverSurvey page Perl template.
3 # Copyright (C) 2005 Jan Kratochvil <project-www.jankratochvil.net@jankratochvil.net>
5 # This program is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; exactly version 2 of June 1991 is required
9 # This program is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 # GNU General Public License for more details.
14 # You should have received a copy of the GNU General Public License
15 # along with this program; if not, write to the Free Software
16 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19 package project::captive::DriverSurvey;
20 require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway
21 our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
28 require Time::Piece::ISO;
29 use Carp qw(confess cluck);
32 our $HTML_TEST_QUERY_STRING="captive-static-1.1.6-0.i386.rpm";
35 # It will not return the new cookie if you set one!
40 my $trash; # For {"headers_in"} stability.
41 $trash=$W->{"headers_in"}{"Cookie"};
42 $trash=$W->{"headers_in"}{"Cookie2"};
43 my $jar=Apache2::Cookie::Jar->new($W->{"r"});
46 my $cookie=Apache2::Cookie->new($W->{"r"},
50 "domain" =>$W->{"web_hostname"},
51 # No __PACKAGE__ as it needs to be retrieved also from: /project/captive/Index.pm
52 "path" =>"/project/captive/",
54 # Do not: # Prevent: Can't bake2 a Netscape cookie
56 # as RFCed "Cookie2" somehow does not work and even nobody uses it.
58 # Do not: $cookie->bake2($W->{"r"});
59 # as RFCed "Cookie2" somehow does not work and even nobody uses it.
60 $cookie->bake($W->{"r"});
62 # Somehow it may croak on error parsing the cookie headers or whatever.
63 return eval { $jar->cookies($name) };
73 my $val=$W->{"args"}{$name};
74 return 'name="'.$name.'"'.(!defined $val ? "" : ' value="'.escapeHTML($val).'"');
79 my($name,$rows,$attr)=@_;
82 <textarea rows="$rows" cols="$COLS" name="$name"@{[
83 !$attr ? '' : ' '.$attr
84 ]}>@{[ escapeHTML($W->{"args"}{$name}||"") ]}</textarea>
90 my($name,$value,$attr)=@_;
93 <input type="radio" name="$name" value="$value"@{[
94 ($W->{"args"}{$name}||"") ne $value ? '' : ' checked="checked"'
96 !$attr ? '' : ' '.$attr
105 stamp: @{[ Time::Piece::ISO::gmtime()."+00:00" ]}
113 next if !defined (my $val=$W->{"headers_in"}{$key});
115 headers_in::$key=$val
119 for my $key (sort keys(%{$W->{"args"}})) {
120 next if $key eq "file";
121 next if $key eq "submit";
122 my $val=$W->{"args"}{$key};
123 next if !defined $val;
131 $data.=("-" x 78)."\n\n";
133 my $filename=">>".path_abs_disk("./DriverSurvey.out");
135 open F,$filename or confess "open \"$filename\": $!";
136 print F $data or confess "write \"$filename\": $!";
137 close F or confess "close \"$filename\": $!";
142 return "Please check the appropriate leftmost checkmark."
143 if !$W->{"args"}{"kind"};
145 # It works as &Apache2::Cookie::bake uses &err_headers_out - it is a redirect (not 200 OK).
147 My::Web->http_moved("./");
153 "title"=>'Captive NTFS - Linux Drivers Availability Survey',
154 "js_push"=>"./DriverSurvey.js",
158 "args_persistent"=>{map(($_=>1),qw(
161 "css_push"=>"./Lib.css",
168 # Workaround persistence of 'empty' argument - omit it instead.
169 do { $$_=undef() if !$$_; } for \$W->{"args"}{"file"};
171 my $error=submit() if $W->{"args"}{"submit"};
173 # At least after &submit !
182 <h1>Linux Drivers Availability</h1>
187 <p>Please take a minute before downloading Captive NTFS to fill in this survey
188 for the possibility to extend Captive for free support of other MS-Windows drivers
189 (besides the current file system drivers). The original MS-Windows installation
190 (<b>ntoskrnl.exe</b>) would not even be needed in such case.</p>
195 <p align="center" class="error" id="error">$error</p>
200 <form action="DriverSurvey.pm" @{[ form_method "post" ]} onsubmit="return DriverSurvey_validate(this);">
201 @{[ input_hidden_persistents() ]}
202 <table border="0" width="80%" class="margin-center padded">
203 <tr><td><table border="1" width="100%" class="padded">
205 <p>@{[ radio "kind","owned" ]} I would like such MS-Windows drivers interface
206 - I have a hardware device missing Linux support.</p>
207 <p>@{[ radio "kind","wannabuy" ]} I would like to buy a hardware device
208 but so far I could not as it is not Linux compatible.</p>
210 <table border="0" class="vtop">
211 <tr><td style="font-size: larger;" align="center" colspan="2">Incompatible Hardware Details</td></tr>
213 for my $producti (0..$PRODUCTS_MAX-1) {
215 <tr id="product${producti}_row0"><td align="center">Product #@{[ 1+$producti ]}</td></tr>
216 <tr id="product${producti}_row1">
217 <td>Vendor (if known) and product name</td>
218 <td><input type="text" size="$COLS" @{[ nameval "product${producti}_name" ]} /></td>
220 <tr id="product${producti}_row2">
221 <td>Product webpage URL (if known)</td>
222 <td><input type="text" size="$COLS" @{[ nameval "product${producti}_url" ]} /></td>
226 # Just a protection for non-CSS non-JS browsers to no longer display the button:
227 if (!$W->{"args"}{"productnext"}) {
229 <tr style="display: none;" id="productnext_row0"><td colspan="2"> </td></tr>
230 <tr style="display: none;" id="productnext_row1"><td colspan="2" align="center">
231 <input type="submit" name="productnext" value="More Devices >>>"
232 onclick="return Survey_productnext(this);" />
238 <tr><td colspan="2"> </td></tr>
240 <td rowspan="4">Would you like to cooperate on the driver testing?</td>
242 @{[ radio "coop","yes" ]} Yes, I want to test a snapshot of the driver right now.
246 @{[ radio "coop","buy" ]} Yes but only if the driver somehow works
247 to buy the device first.
250 @{[ radio "coop","no" ]} No, I do not own the device
251 or I do not want to test it.
254 @{[ radio "coop","other",'id="coop_other_radio"' ]} Other answer:<br />
255 @{[ textarea "coop_other_textarea",2,q{onkeypress="click_on('coop_other_radio');"} ]}
261 <tr><td>@{[ radio "kind","oss" ]} I know a specific hardware (either mine or just seen)
262 is not compatible but I do not want to use MS-Windows drivers in Linux.
264 <p>What are the more specific reasons? Are you aware the drivers in Linux are
265 in many times just reverse engineered out of their MS-Windows counterparts?</p>
267 @{[ textarea "kind_oss",3 ]}
270 <tr><td>@{[ radio "kind","working" ]} All my hardware is working perfectly in Linux.</td></tr>
272 <tr><td>@{[ radio "kind","answered" ]} I already answered this survey before.</td></tr>
275 <tr><td>Your e-mail; optional but appreciated: <input type="text" size="30" @{[ nameval "email" ]} /></td></tr>
277 <tr><td>Comments<br />
278 @{[ textarea "comment",3 ]}
283 <tr><td align="center" class="error">$error</td></tr>
287 <tr><td align="center">
288 <input type="submit" name="submit" value="@{[
290 ? "Submit and download ".escapeHTML($W->{"args"}{"file"})
291 : "Submit the survey"
297 <p>Direct e-mail address: @{[ a_href 'mailto:driversurvey@jankratochvil.net' ]}</p>