Pragma: no-cache Cache-Control: no-cache Expires: Thu, 01 Jan 2001 00:00:00 GMT url; my $me_full_url = $q->url(-path_info=>1,-query=>1); my $txt_context = $q->param('context') || ''; my $txt_command = lc($q->param('txt_command')) || ''; my $bln_runtime_invalid = 0; PAGE: { if ($txt_context) { @txt_context_args = PDK::Encrypt::simple_decipher($txt_context); ($int_tm_signin, $int_user_id) = @txt_context_args[0,1]; unless (time <= $int_tm_signin + 43200) { $txt_error = "user: old_signin"; $txt_help_params = "?error=old_signin"; last PAGE; } } unless ($txt_command) { for ($q->param) { if (/^(.*?)\.x/) { $txt_command = $1; last; } } } DATABASE: { $dbh = DBI->connect('DBI:mysql:pdk', 'pdk', 'delta^sushi', {RaiseError => 0}) or do { $txt_error = "fatal: connecting to database: $DBI::errstr"; last DATABASE }; if ($int_user_id) { $txt_sql = qq(SELECT txt_username, txt_firstname, txt_lastname, txt_privileges, int_primary_usertype FROM tbl_users WHERE ID=$int_user_id); $sth = $dbh->prepare($txt_sql); $sth->execute or do { $txt_error = "Fatal: $DBI::errstr [$txt_sql]"; last DATABASE }; ($txt_username, $txt_firstname, $txt_lastname, $txt_privileges, $int_primary_usertype) = $sth->fetchrow_array; } } # DATABASE $sth->finish if $sth; $dbh->do(q(UNLOCK TABLES)) if $dbh; $dbh->disconnect if $dbh; } # PAGE !> Professional Development Kit Home Page
Fatal error

$txt_error

); } elsif ($txt_error eq q(user: old_signin) || $txt_error eq q(user: no_signin)) { # If the page included a context string, strip it out. Yes, we # could probably hack this with regular expressions that would # work 99.99% of the time, but this is the correct way to do it # that will never break. my $uri = URI->new($me_full_url); my $query = $uri->query || ''; my $q2 = new CGI($query); # make a new query. $q2->delete('context'); # delete the context parameter. my $new_query_string = $q2->query_string; $new_query_string = '?' . $new_query_string if $new_query_string; $new_query_string .= '#' . $uri->fragment if $uri->fragment; my $context_less_uri = $uri->scheme . '://' . $uri->authority . $uri->path . $new_query_string; my $redirect_info = MIME::Base64::encode_base64(qq(Professional Development Kit Home Page|$context_less_uri), ''); $q->redirect(qq(/pdk/login.iphtml?txt_redirect_info=$redirect_info)); } elsif ($txt_error) { } else { # no error, show normal page. !> param('txt_username'), $q->param('txt_password')); # Crude browser-sniffing code. The sequence of these tests is important. # An exhuastive list of known useragents can be found at http://www.cen.uiuc.edu/bstats/latest-month.html unless ($q->param('passme') == 1) { my ($bln_browser_ok, $bln_browser_known) = (0,0); $_ = $ENV{'HTTP_USER_AGENT'}; BROWSER_CHECK: { $bln_browser_known++, last if /AOL/i; $bln_browser_known++, last if /WebTV/i; $bln_browser_known++, last if /Lynx/; if (/MSIE/i) { $bln_browser_known++; /MSIE\s*(.*?);/i; my $txt_version = $1; last unless $txt_version >= 5; } elsif (/Opera/i) { $bln_browser_known++; /Opera\/(.*?);/i; my $txt_version = $1; last unless $txt_version >= 4; } elsif (/Mozilla/i) { $bln_browser_known++; /Mozilla\/(.*?)\s+/i; my $txt_version = $1; last unless $txt_version >= 5; } $bln_browser_ok++; } unless ($bln_browser_ok) { $q->redirect('index.old.iphtml'); } } !>
PDK About PDK Tour Tour Registration Registration
Username
Password

[ About PDK | Tour | Registration ]

National Center on Adult LiteracyPDK is being developed by the National Center on Adult Literacy at the University of Pennsylvania in collaboration with SRI International, Silicon Goblin Technologies, and Jennifer Elmore Instructional Design. PDK is funded by the U.S. Department of Education, Office of Vocational and Adult Education.

PDK version 1.5.1

Copyright & Credits

Validation