# ---------------------------------------------------------------------------
# AUTHLIB.PL
#
# Ver: 8_4_8
# ---------------------------------------------------------------------------
# SSI Web - Web Surveying System
# Copyright Sawtooth Software, Inc. 1998-2015. All rights reserved.
# Orem, UT USA (801) 477-4700
#
# Any modification of this script will be considered violation of
# copyright (with the exception of the first line which can be
# modified to reflect the correct path to the Perl interpreter)
#
# Any use of this script or its code for purposes outside of
# the systems created by Sawtooth Software is prohibited.
# ---------------------------------------------------------------------------
use strict; use Symbol qw(gensym); package authlib8_4_8; eval { require 5.007003; }; if ($@) { authlib8_4_8::_bqa(0, "The version of Perl installed on this computer is not compatible with SSI Web.
" . $@, "", $@); } use constant _CBQ => -4; use constant _CBR => -3; use constant _CBS => -2; use constant _CBT => -1; use constant _CBU => 1; use constant _CBV => 2; use constant _CBW => 3; use constant _CBX => 4; use constant _CBY => 5; use constant _CBZ => 6; use constant _CCA => 7; use constant _CCB => 8; use constant _CCC => 9; use constant _CCD => 10; use constant _CCE => 13; use constant _CCF => 14; use constant _CCG => 15; use constant _CCH => 16; use constant _CCI => 17; use constant _CCJ => 18; use constant _CCK => 19; use constant _CCL => 20; use constant _CCM => 21; use constant _CCN => 22; use constant _CCO => 23; use constant _CCP => 24; use constant _CCQ => 25; use constant _CCR => 26; use constant _CCS => 27; use constant _CCT => 28; use constant _CCU => 29; use constant _CCV => 2; use constant _CCW => 4; use constant _CCX => 5; use constant _CCY => 1; use constant _CCZ => 2; use constant _CDA => 3; use constant _CDB => 4; use constant _CDC => 5; use constant _CDD => 6; use constant _CDE => 0; use constant _CDF => 1; use constant _CDG => 2; use constant _CDH => 3; $authlib8_4_8::_byz = ""; $authlib8_4_8::_bzb = ""; $authlib8_4_8::_bwn = {}; $authlib8_4_8::_bwo = ""; $authlib8_4_8::_bzj = 0; %authlib8_4_8::_bwq = (); %authlib8_4_8::_bzi = (); %authlib8_4_8::_bws = (); $authlib8_4_8::_byy = {}; $authlib8_4_8::_bwu = {}; %authlib8_4_8::_bwv = (); $authlib8_4_8::_bzu = 0; $authlib8_4_8::_bwx = ""; $authlib8_4_8::_bwy = ""; $authlib8_4_8::_bwz = "1444230147"; $authlib8_4_8::_bzk = 0; $authlib8_4_8::_bzl = 0; %authlib8_4_8::_bxc = (); %authlib8_4_8::_bxd = (); $authlib8_4_8::_bxe = 0; $authlib8_4_8::_bxf = 0; $authlib8_4_8::_bxh = 0; $authlib8_4_8::_bxi = 0; $authlib8_4_8::_cab = 0; $authlib8_4_8::_cau = 0; $authlib8_4_8::_cai = 0; $authlib8_4_8::_caj = ""; $authlib8_4_8::_cak = ""; %authlib8_4_8::_bxo = (); %authlib8_4_8::_bxp = (); $authlib8_4_8::_bzy = 0; $authlib8_4_8::_bzh = 0; $authlib8_4_8::_bzs = 0; $authlib8_4_8::_bxt = 0; %authlib8_4_8::_bxu = (); $authlib8_4_8::_bxv = ""; $authlib8_4_8::_bxw = 0; $authlib8_4_8::_bzq = 0; $authlib8_4_8::_bzr = 0; $authlib8_4_8::_bxz = 0; $authlib8_4_8::_bzo = 0; $authlib8_4_8::_byb = 0; $authlib8_4_8::_byd = ""; $authlib8_4_8::_bye = 1; $authlib8_4_8::_byf = ""; $authlib8_4_8::_bzt = 1; $authlib8_4_8::_byh = 0; %authlib8_4_8::_byi = (); $authlib8_4_8::_bzw = 0; $authlib8_4_8::_bzx = 0; $authlib8_4_8::_byl = 0; $authlib8_4_8::_bym = 0; $authlib8_4_8::_bxg = 0; $authlib8_4_8::_byn = 0; $authlib8_4_8::_cav = 0; $authlib8_4_8::_byw = 0; $authlib8_4_8::_bze = 0; $authlib8_4_8::_byr = {}; $authlib8_4_8::_bys = 0; sub _bmp { my($__ayu) = @_; $authlib8_4_8::_byz = ""; $authlib8_4_8::_bzb = ""; $authlib8_4_8::_bwn = {}; $authlib8_4_8::_bwo = ""; $authlib8_4_8::_bzj = 0; %authlib8_4_8::_bwq = (); %authlib8_4_8::_bzi = (); %authlib8_4_8::_bws = (); $authlib8_4_8::_byy = {}; $authlib8_4_8::_bwu = {}; %authlib8_4_8::_bwv = (); $authlib8_4_8::_bzu = 0; $authlib8_4_8::_bwx = "8_4_8"; $authlib8_4_8::_bwy = ".pl"; $authlib8_4_8::_bwz = "1444230147"; $authlib8_4_8::_bzk = 0; $authlib8_4_8::_bzl = 0; %authlib8_4_8::_bxc = (); %authlib8_4_8::_bxd = (); $authlib8_4_8::_bxe = 0; $authlib8_4_8::_bxf = 0; $authlib8_4_8::_bxg = 0; $authlib8_4_8::_bxh = 0; $authlib8_4_8::_bxi = 0; $authlib8_4_8::_cab = 0; $authlib8_4_8::_cau = 0; $authlib8_4_8::_cai = 0; $authlib8_4_8::_caj = ""; $authlib8_4_8::_cak = ""; %authlib8_4_8::_bxo = (); %authlib8_4_8::_bxp = (); $authlib8_4_8::_bzy = 0; $authlib8_4_8::_bzh = $__ayu; $authlib8_4_8::_bzs = 0; $authlib8_4_8::_bxt = 0; %authlib8_4_8::_bxu = (); $authlib8_4_8::_bxv = ""; $authlib8_4_8::_bxw = 0; $authlib8_4_8::_bzq = 0; $authlib8_4_8::_bzr = 0; $authlib8_4_8::_bxz = 0; $authlib8_4_8::_bzo = 0; $authlib8_4_8::_byb = 0; $authlib8_4_8::_byc = 0; $authlib8_4_8::_byd = ""; $authlib8_4_8::_bye = 1; $authlib8_4_8::_byf = ""; $authlib8_4_8::_bzt = 1; $authlib8_4_8::_byh = 0; %authlib8_4_8::_byi = (); $authlib8_4_8::_bzw = 0; $authlib8_4_8::_bzx = 0; $authlib8_4_8::_byl = 0; $authlib8_4_8::_bym = 0; $authlib8_4_8::_byn = 0; $authlib8_4_8::_cav = 0; $authlib8_4_8::_byw = 0; $authlib8_4_8::_bze = 0; $authlib8_4_8::_byr = {}; $authlib8_4_8::_bys = 0; } sub _bmq { my ($__azd) = @_; my $__ayv = 0; my $__ayw = 0; my $__ayx = ""; my $__ayy = ""; my $__ayz = ""; eval { require DBI; $authlib8_4_8::_bwn->{'_caw'} = 1400; if (uc($__azd->{"database_type"}) eq uc("mysql")) { $__ayz = "dbi:" . $__azd->{"database_type"} . ":" . $__azd->{"database_name"} . ":" . $__azd->{"database_address"}; if ($__azd->{"database_port"}) { $__ayz .= ":" . $__azd->{"database_port"}; } $authlib8_4_8::_byw = DBI->connect($__ayz, $__azd->{"database_username"}, $__azd->{"database_password"},{RaiseError => 1, AutoCommit => 0, PrintError => 0}); $authlib8_4_8::_bwn->{'_cax'} = "ENGINE = MYISAM"; $authlib8_4_8::_bwn->{'_cay'} = "AUTO_INCREMENT"; $authlib8_4_8::_bwn->{'_caz'} = 50; } elsif(uc($__azd->{"database_type"}) eq uc("SQLite")) { $authlib8_4_8::_byw = DBI->connect("dbi:" . $__azd->{"database_type"} . ":dbname=" . $authlib8_4_8::_bwv{'_cba'} . $authlib8_4_8::_bzb . ".sqlite", undef, undef, {RaiseError => 1, PrintError => 0, AutoCommit => 0, "sqlite_use_immediate_transaction" => 1}); $authlib8_4_8::_bwn->{'_cay'} = "AUTOINCREMENT"; $authlib8_4_8::_bwn->{'_caz'} = 1; } elsif(uc($__azd->{"database_type"}) eq uc("ODBC")) { my $__aza = $__azd->{"database_address"}; my $__azb = "{SQL Server}"; if (exists $__azd->{"database_driver"} && $__azd->{"database_driver"} ne "") { $__azb = $__azd->{"database_driver"}; } $__ayz = "DBI:" . $__azd->{"database_type"} . ":" . "Driver=" . $__azb . ";Server=" . $__aza . ";" . "Database=" . $__azd->{"database_name"} . ";" . "uid=" . $__azd->{"database_username"} . ";" . "pwd=" . $__azd->{"database_password"} . ";" . "port=" . $__azd->{"database_port"}; $authlib8_4_8::_byw = DBI->connect($__ayz, undef, undef, {RaiseError => 1, AutoCommit => 0}); my $__azc = 1; if(exists $authlib8_4_8::_byr->{"respnum_start"}) { $__azc = $authlib8_4_8::_byr->{"respnum_start"}; } $authlib8_4_8::_bwn->{'_cay'} = "IDENTITY(" . $__azc . ", 1)"; $authlib8_4_8::_byw->{"LongReadLen"} = 131070; $authlib8_4_8::_bwn->{'_caz'} = 4; $authlib8_4_8::_bwn->{'_caw'} = 1000; } else { $__ayw = 1; $__ayy = "Failed to connect to the database."; $__ayx = "Cannot find database for " . $__azd->{"database_type"} . "."; } if(uc($__azd->{"database_type"}) ne uc("SQLite")) { if (exists $__azd->{"database_max_fields_table"}) { $authlib8_4_8::_bwn->{'_caw'} = $__azd->{"database_max_fields_table"}; } if (exists $__azd->{"database_max_tables_join"}) { $authlib8_4_8::_bwn->{'_caz'} = $__azd->{"database_max_tables_join"}; } } }; if ($@) { $__ayy = "Failed to connect to the database."; $__ayx = $@; if ($__ayx =~ m/Unknown database/i || $__ayx =~ m/Cannot open database/i) { $__ayy .= " Cannot find the \"" . $__azd->{"database_name"} . "\" database. Make sure that this database has been created and that you have access to it."; } elsif($__ayx =~ m/Access denied for user/i || $__ayx =~ m/Login failed for user/i) { $__ayy .= " Access denied for database user \"" . $__azd->{"database_username"} . "\". Check the database user name and password. Also verify that you have the database name (" . $__azd->{"database_name"} . ") correct."; } elsif($__ayx =~ m/install_driver(.*?)failed/i) { $__ayy .= " Cannot find database driver " . $__azd->{"database_type"} . "."; } } elsif(!$authlib8_4_8::_byw) { ($__ayv, $__ayy, $__ayx) = _bmv($__azd->{"database_type"}); $__ayw = 1; $__ayy = "Failed to connect to the database."; } elsif(!$__ayw) { ($__ayv, $__ayy, $__ayx) = _bmv($__azd->{"database_type"}); $authlib8_4_8::_bwn->{'_bgu'} = lc($__azd->{"database_type"}); } else { $__ayv = 1; } return ($__ayv, $__ayy, $__ayx); } sub _bmr { if ($authlib8_4_8::_byw) { $authlib8_4_8::_byw->commit(); $authlib8_4_8::_byw->disconnect; $authlib8_4_8::_byw = 0; } } sub _bms { my ($__aze) = @_; if ($authlib8_4_8::_bwn->{'_bgu'} eq "odbc" && defined($__aze)) { $__aze = pack("U0C*", unpack("C*", $__aze)); } return $__aze; } sub _bmt { my ($__azf) = @_; if($authlib8_4_8::_bwn->{'_bgu'} eq "odbc" && defined($__azf)) { $__azf = pack("C*", unpack("U0C*", $__azf)); } return $__azf; } sub _bmu { my ($__azg) = @_; $__azg =~ s{([\x00-\x29\x2C\x3A-\x40\x5B-\x5E\x60\x7B-\x7F])} {'%' . uc(unpack('H2', $1))}eg; return $__azg; } sub _bmv { my ($__azi) = @_; if ($authlib8_4_8::_bwy eq ".pl") { my @__azh = DBI->available_drivers(); unless (grep(/$__azi/i, @__azh)) { return (0, "", "A " . $__azi . " driver is not installed for Perl. Please make sure that the CPAN module DBD::" . $__azi . " is installed and reachable from Perl."); } } return (1, "", ""); } sub _bmw { my($__azk) = @_; my $__azj = ""; if($authlib8_4_8::_bwn->{'_bgu'} eq "odbc") { $__azj .= "IF OBJECT_ID('" . $__azk . "') IS NOT NULL DROP TABLE \"" . $__azk . "\""; } else { $__azj .= "DROP TABLE IF EXISTS `" . $__azk . "`"; } return $__azj; } sub _bmx { my($__azq) = @_; my $__azl = ""; my $__azm = 0; my $__azn = 0; my $__azo = ""; my $__azp = ""; if ($authlib8_4_8::_bwn->{'_bgu'} eq "sqlite") { $__azl = "PRAGMA table_info(`" . $__azq . "`)"; $__azm = 1; $__azn = 2; $__azo = "name"; $__azp = "type"; } elsif ($authlib8_4_8::_bwn->{'_bgu'} eq "odbc") { $__azl = "SELECT COLUMN_NAME 'Field', DATA_TYPE 'Type' FROM INFORMATION_SCHEMA.COLUMNS WHERE TABLE_NAME = '" . $__azq . "'"; $__azm = 0; $__azn = 1; $__azo = "Field"; $__azp = "Type"; } else { $__azl = "DESCRIBE `" . $__azq . "`"; $__azm = 0; $__azn = 1; $__azo = "Field"; $__azp = "Type"; } return ($__azl, $__azm, $__azn, $__azo, $__azp); } sub _bmy { my($__azr, $__azs) = @_; if($authlib8_4_8::_bwn->{'_bgu'} eq "odbc") { $__azr =~ s/`/\"/g; if ($__azs) { $__azr =~ s/\s+TINYINT\(\d+\)([,\s\)])/ TINYINT$1/ig; $__azr =~ s/\s+INTEGER([,\s\)])/ INT$1/ig; $__azr =~ s/\s+LONGTEXT([,\s\)])/ nvarchar\(max\)$1/ig; $__azr =~ s/\s+TEXT([,\s\)])/ nvarchar\(max\)$1/ig; $__azr =~ s/\s+VARCHAR\s*\((\d+)\)([,\s\)])/ nvarchar\($1\)$2/ig; $__azr =~ s/\s+DOUBLE([,\s\)])/ decimal\(38, 16\)$1/ig; $__azr =~ s/CREATE\s+INDEX/CREATE CLUSTERED INDEX/ig; } } elsif ($authlib8_4_8::_bwn->{'_bgu'} eq "sqlite") { if ($__azs) { $__azr =~ s/\s+INT([,\s\)])/ INTEGER$1/ig; $__azr =~ s/\s+TEXT/ TEXT COLLATE NOCASE/ig; $__azr =~ s/^double$/text/ig; } } return $__azr; } sub _bmz { my($__azt) = @_; if($authlib8_4_8::_bwn->{'_bgu'} eq "odbc") { $__azt =~ s/^bool$/tinyint/ig; $__azt =~ s/^INTEGER$/int/ig; $__azt =~ s/^LONGTEXT$/nvarchar\(max\)/ig; $__azt =~ s/^TEXT$/nvarchar\(max\)/ig; $__azt =~ s/^VARCHAR$/nvarchar\(max\)/ig; $__azt =~ s/^DOUBLE$/decimal\(38, 16\)/ig; } elsif ($authlib8_4_8::_bwn->{'_bgu'} eq "sqlite") { $__azt =~ s/^bool$/tinyint\(1\)/ig; $__azt =~ s/^int$/INTEGER/ig; $__azt =~ s/^double$/text/ig; } else { $__azt =~ s/^bool$/tinyint\(1\)/ig; } return $__azt; } sub _bna { my($__azv) = @_; my $__azu = 0; if($__azv =~ m/text/i || $__azv =~ m/varchar/i) { $__azu = 1; } return $__azu; } sub _bnb { my($__azz, $__baa) = @_; my $__azw = $authlib8_4_8::_byw->last_insert_id(undef, undef, "`" . $__azz . "`", $__baa); if (!$__azw) { my $__azx = ""; if($authlib8_4_8::_bwn->{'_bgu'} eq "odbc") { $__azx = "SELECT \@\@IDENTITY FROM `" . $__azz . "`"; } else { $__azx = "SELECT LAST_INSERT_ID() FROM `" . $__azz . "`"; } my $__azy = $authlib8_4_8::_byw->selectrow_arrayref(authlib8_4_8::_bmy($__azx, 0)); $__azw = $__azy->[0]; if (!$__azw) { authlib8_4_8::_bqa(267, "Database error.", "Database error. Cannot get last_insert_id for " . $__azz, $@); } } return $__azw; } sub _bnc { my($__baq, $__bar, $__bas) = @_; my $__bab = ""; my $__bac = ciwlib8_4_8::_bia(); if ($__bac > 0) { my $__bad = 0; my $__bae = ""; my $__baf = ""; my $__bag = 0; if (keys %{$authlib8_4_8::_byy} == 0 && !$authlib8_4_8::_bzy) { _bne($__bac); } if (exists $authlib8_4_8::_bwu->{$__baq}) { $__bab = ""; $__bad = 1; } elsif (exists $authlib8_4_8::_byy->{$__baq}) { $__bab = $authlib8_4_8::_byy->{$__baq}; $__bad = 1; } elsif(!$authlib8_4_8::_bzy) { my ($__bat, $__bau) = _bnv($__baq, 0, 1); if ($__bat) { $__bad = 1; my $__bah = "SELECT " . $__bau . " FROM `" . $authlib8_4_8::_bzb . "_data" . $__bat . "` WHERE `sys_RespNum` = " . $__bac; my $__bai = 0; my $__baj = ""; eval { $__bai = $authlib8_4_8::_byw->selectrow_hashref(authlib8_4_8::_bmy($__bah, 0)); }; if ($@ || $__bai == 0) { } else { foreach $__baj (keys %{$__bai}) { $authlib8_4_8::_byy->{$__baj} = _bmt($__bai->{$__baj}); } if (exists $authlib8_4_8::_byy->{$__baq}) { $__bab = $authlib8_4_8::_byy->{$__baq}; $__bad = 1; } } } } if (!$__bad && !$authlib8_4_8::_bzy) { $__bag = _btj($__bac); if (exists $authlib8_4_8::_byy->{$__baq}) { $__bab = $authlib8_4_8::_byy->{$__baq}; $__bad = 1; } } if (!$__bad && !$authlib8_4_8::_bzy) { if (exists $authlib8_4_8::_bzi{"hid_loops"}) { if ($__bar) { if ($__baq =~ m/(.*?)\.\d+$/o) { $__bab = _bnc($1, 1); } } else { my $__bak = 0; my ($__bat, $__bau) = _bnv($__baq, 1); if ($__bat) { $__bak = 1; } elsif($__bag) { foreach my $__bal (keys %{$__bag}) { if ($__bal =~ m/(.*?)\./o) { if($__baq eq $1) { $__bak = 1; } } } } if($__bak) { my $__bam = 0; my($__bae, $__baf, $__bav) = authlib8_4_8::_brx($__baq); if (exists $authlib8_4_8::_bwq{$__bae}) { my $__ban = $authlib8_4_8::_bwq{$__bae}; $__bam = $__ban->{'_v'}; } else { $__bam = _bqm(); } my $__bao = $authlib8_4_8::_bzj->[$__bam - 1]; my $__bap = ciwlib8_4_8::_bhq($authlib8_4_8::_bzi{"hid_loops"}); my ($__baw, $__bax) = ciwlib8_4_8::_bhs($__bao, $__bap, $__bas); $__bab = _bnc($__baq . $__baw, 1); } } if ($__bab) { $authlib8_4_8::_byy->{$__baq} = $__bab; $__bad = 1; } } } } return $__bab; } sub _bnd { my($__bay, $__baz) = @_; delete $authlib8_4_8::_bwu->{$__bay}; $authlib8_4_8::_byy->{$__bay} = $__baz; } sub _bne { my ($__bbd) = @_; my @__bba = ("`sys_RespNum`", "`sys_CheckSum`", "`sys_StartTime`", "`sys_EndTime`", "`sys_RespStatus`", "`sys_DispositionCode`", "`sys_LastQuestion`", "`sys_UserJavaScript`"); my $__bbb = "SELECT " . join(",", @__bba) . " FROM `" . $authlib8_4_8::_bzb . "_data1` WHERE `sys_RespNum` = " . $__bbd; eval { $authlib8_4_8::_byy = $authlib8_4_8::_byw->selectrow_hashref(authlib8_4_8::_bmy($__bbb, 0)); }; if ($@ || $authlib8_4_8::_byy == 0) { authlib8_4_8::_bqa(207, "Database error.", "Database error. Initial data read failed.", $@); } my $__bbc = authlib8_4_8::_bqm(); if ($__bbc > 1) { _btl(); } } sub _bnf { my $__bbe = _bqk(); if($__bbe =~ m/Googlebot|Baiduspider|msnbot|bingbot|spider|robot|crawler|crawling/i) { authlib8_4_8::_bso(); } } sub _bng { my ($__bbi) = @_; my $__bbf = 0; my $__bbg = "SELECT `sys_RespNum` FROM `" . $authlib8_4_8::_bzb . "_data1` WHERE `sys_RespNum` = " . $__bbi; my $__bbh = 0; eval { $__bbh = $authlib8_4_8::_byw->selectrow_hashref(authlib8_4_8::_bmy($__bbg, 0)); }; if ($@) { authlib8_4_8::_bqa(277, "Database error.", "Database error. Error checking if record exists.", $@); } if ($__bbh) { if (exists $__bbh->{"sys_RespNum"}) { if ($__bbh->{"sys_RespNum"} == $__bbi) { $__bbf = 1; } } } return $__bbf; } sub _bnh { my($__bbj) = @_; $authlib8_4_8::_byz = $__bbj; $authlib8_4_8::_bzb = $authlib8_4_8::_byz; if (exists $authlib8_4_8::_bzi{"hid_test_mode"}) { $authlib8_4_8::_bzb = authlib8_4_8::_buc(); } } sub _bni { my($__bbn) = @_; my $__bbk = ""; my $__bbl = ref $__bbn; if ($__bbl eq "ARRAY") { $__bbk .= "["; my $__bbm = 0; foreach $__bbm (@{$__bbn}) { $__bbl = ref $__bbm; if ($__bbl eq "ARRAY") { $__bbk .= "["; $__bbk .= join(",", @{$__bbm}); $__bbk .= "],"; } else { $__bbk .= $__bbm . ","; } } $__bbk =~ s/,$//; $__bbk .= "]"; } return $__bbk; } sub _bnj { my ($__bbs, $__bbt, $__bbu, $__bbv) = @_; my $__bbo = 0; eval { require "Digest.pm"; $__bbo = Digest->new("MD5"); }; if ($@) { authlib8_4_8::_bqa(0, "Unable to load Digest.pm
", $@, ""); } $__bbo->add(0xFF01); $__bbo->add($__bbu); $__bbo->add($__bbt); $__bbo->add($__bbs); $__bbo->add($__bbv); $__bbo->add($authlib8_4_8::_bzi{"hid_respnum"}); $__bbo->add($authlib8_4_8::_byl); $__bbo->add($authlib8_4_8::_byz); my $__bbp = $__bbo->digest(); my $__bbq = join(",", ($__bbu, $__bbt, $__bbs, $__bbv, $authlib8_4_8::_bzi{"hid_respnum"}, $authlib8_4_8::_byl, $authlib8_4_8::_byz)); my $__bbr = pack("V", 0xFF01) . $__bbp; $__bbr .= pack("V", length($__bbq)) . _bnk($__bbq, $__bbp); return _bnn($__bbr); } sub _bnk { my ($__bce, $__bcf) = @_; my $__bbw = length($__bce); my $__bbx = ""; my $__bby = 0; my $__bbz = length($__bcf); for (; $__bby < $__bbw - $__bbz; $__bby += $__bbz) { $__bbx .= $__bcf ^ substr($__bce, $__bby, $__bbz); } my %__bca = (0 => 0, 1 => 1, 2 => 2, 3 => 3, 4 => 4, 5 => 5, 6 => 6, 7 => 7, 8 => 8, 9 => 9, 10 => 'A', 11 => 'B', 12 => 'C', 13 => 'D', 14 => 'E', 15 => 'F'); my $__bcb = ""; my $__bcc = 0; my @__bcd = (); if ($__bbw % $__bbz) { $__bcc = $__bbz - ($__bbw % $__bbz); @__bcd = ($__bca{$__bcc}) x ($__bcc * 2); $__bcb = pack("H*", join("", @__bcd)); } $__bbx .= $__bcf ^ ($__bcb . substr($__bce, $__bby)); return $__bbx; } sub _bnl { my ($__bdc) = @_; if ($__bdc !~ m/^(?:(?:[A-Z0-9_-]{4})*(?:[A-Z0-9_-]{2,3})?){1}$/io) { authlib8_4_8::_bqa(304, "Page link is invalid.", "Page link is invalid: " . $__bdc, ""); } my $__bcg = _bno($__bdc); my $__bch = unpack("V", $__bcg); my $__bci = 0; my $__bcj = 0; my $__bck = 0; my $__bcl = 0; my $__bcm = 0; my $__bcn = ""; my $__bco = 0; if ($__bch == 0xFF01) { my $__bcp = substr($__bcg, 4, 16); my $__bcq = unpack("V", substr($__bcg, 20, 4)); my $__bcr = substr($__bcg, 24); my $__bcs = _bnm($__bcr, $__bcq, $__bcp); ($__bck, $__bcj, $__bci, $__bcl, $__bcm, $__bco, $__bcn) = split(',', $__bcs); my $__bct = 0; eval { require "Digest.pm"; $__bct = Digest->new("MD5"); }; if ($@) { authlib8_4_8::_bqa(0, "Unable to load Digest.pm
", $@, ""); } $__bct->add(0xFF01); $__bct->add($__bck); $__bct->add($__bcj); $__bct->add($__bci); $__bct->add($__bcl); $__bct->add($__bcm); $__bct->add($__bco); $__bct->add($__bcn); my $__bcu = $__bct->digest; if ($__bcp != $__bcu) { my $__bcv = "Expected_digest=" . unpack('H*', $__bcp) . ", actual_digest=" . unpack("H*", $__bcu); $__bcv .= ", version=$__bch, id=$__bci, checksum=$__bcj, timestamp=$__bcl, respnum=$__bcm, studyname=$__bcn, istestmode=$__bck, previous=$__bco"; authlib8_4_8::_bqa(309, "URL values do not match expected values.", $__bcv, ""); } } else { $__bch = ""; my ($__bdd, $__bde, $__bdf) = unpack("VVV", $__bcg); my $__bcp = substr($__bcg, 12, 16); my $__bcw = substr($__bcg, 28, 16); my $__bcx = (int($__bdf / 16) + 1) * 16; my $__bcy = 44; my $__bcz = substr($__bcg, $__bcy, $__bcx); $__bcy += $__bcx; $__bcx = (int($__bde / 16) + 1) * 16; my $__bda = substr($__bcg, $__bcy, $__bcx); $__bcy += $__bcx; my $__bdb = substr($__bcg, $__bcy); $__bci = _bnm($__bda, $__bde, $__bcp); $__bcn = _bnm($__bdb, $__bdd, $__bcp); $__bcj = _bnm($__bcz, $__bdf, $__bcp); $__bck = _bnm($__bcw, 1, $__bcp); } return ($__bch, $__bci, $__bcn, $__bcj, $__bck, $__bcl, $__bcm, $__bco); } sub _bnm { my ($__bdm, $__bdn, $__bdo) = @_; my $__bdg = length($__bdo); my $__bdh = 0; my $__bdi = ""; for (; $__bdh < $__bdn - $__bdg; $__bdh += $__bdg) { $__bdi .= $__bdo ^ substr($__bdm, $__bdh, $__bdg); } my %__bdj = (0 => 0, 1 => 1, 2 => 2, 3 => 3, 4 => 4, 5 => 5, 6 => 6, 7 => 7, 8 => 8, 9 => 9, 'a' => 10, 'b' => 11, 'c' => 12, 'd' => 13, 'e' => 14, 'f' => 15, 'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14, 'F' => 15); my $__bdk = $__bdo ^ substr($__bdm, $__bdh); if ($__bdn % $__bdg) { my $__bdl = unpack("H", substr($__bdk, 0, 1)); $__bdi .= substr($__bdk, $__bdj{$__bdl}); } else { $__bdi .= $__bdk; } return $__bdi; } sub _bnn { my $__bdp = _bnp(shift, ""); $__bdp =~ s/=+\z//; $__bdp =~ tr[+/][-_]; return $__bdp; } sub _bno { my $__bdq = shift; $__bdq =~ tr[-_][+/]; $__bdq .= '=' while length($__bdq) % 4; return _bnq($__bdq); } sub _bnp { require bytes; require integer; my $__bdr = "\n" unless defined $_[1]; my $__bds = pack("u", $_[0]); $__bds =~ s/^.//mg; $__bds =~ s/\n//g; $__bds =~ tr|` -_|AA-Za-z0-9+/|; my $__bdt = (3 - length($_[0]) % 3) % 3; $__bds =~ s/.{$__bdt}$/'=' x $__bdt/e if $__bdt; if (length($__bdr)) { $__bds =~ s/(.{1,76})/$1$__bdr/g; } return $__bds; } sub _bnq { local($^W) = 0; require integer; my $__bdu = $_[0]; $__bdu =~ tr|A-Za-z0-9+=/||cd; if (length($__bdu) % 4) { authlib8_4_8::_bqa(0, "Invalid link.", "Length of base64 data not a multiple of 4: " . $__bdu, ""); } $__bdu =~ s/=+$//; $__bdu =~ tr|A-Za-z0-9+/| -_|; return "" unless length($__bdu); my $__bdv = ""; my $__bdw; my $__bdx; $__bdx = length($__bdu) - 60; for ($__bdw = 0; $__bdw <= $__bdx; $__bdw+= 60) { $__bdv .= "M" . substr($__bdu, $__bdw, 60); } $__bdu = substr($__bdu, $__bdw); if ($__bdu ne "") { $__bdv .= chr(32 + length($__bdu)*3/4) . $__bdu; } return unpack("u", $__bdv); } sub _bnr { my $__bdy = @{$_[0]} - 1; my $__bdz = 0; if ($__bdy == 1) { if (rand() > 0.5) { ($_[0]->[0], $_[0]->[1]) = ($_[0]->[1], $_[0]->[0]); } } else { for (; $__bdy > 0; $__bdy--) { $__bdz = int(rand($__bdy + 1)); ($_[0]->[$__bdy], $_[0]->[$__bdz]) = ($_[0]->[$__bdz], $_[0]->[$__bdy]); } } } sub _bns { my($__beb) = @_; my $__bea = ""; $__bea .= "\n"; return $__bea; } sub _bnt { my($__ber) = @_; my $__bec = ""; my $__bed = ""; my $__bee = 0; my $__bef = ""; my $__beg = 10000; foreach $__bec (sort keys(%authlib8_4_8::_bzi)) { $__bed = $authlib8_4_8::_bzi{$__bec}; if(!$__ber) { $__bed =~ s// > /g; } $__bed =~ s/onbegin/on begin/ig; $__bed =~ s/<(\s*)script/<$1 s c r i p t/ig; $__bed =~ s/javascript/j a v a _ s c r i p t/ig; $__bed =~ s/\[%/\[ %/ig; if (length($__bed) > $__beg) { my $__beh = 1; if (exists $authlib8_4_8::_bzi{"hid_SavedListNames"}) { my @__bei = split(",", $authlib8_4_8::_bzi{"hid_SavedListNames"}); my $__bej = @__bei; my $__bek = ""; my $__bel = 0; for ($__bel = 0; $__bel < $__bej; $__bel++) { if ($__bec eq $__bei[$__bel]) { $__beh = 0; last; } } } if ($__beh) { if ($__bec eq "result_list") { $__beh = 0; } } if ($__beh) { $__bed = substr($__bed,0,$__beg); $__bef .= "Input greater than " . $__beg . " characters removed."; } } $authlib8_4_8::_bzi{$__bec} = $__bed; if (!$__ber && ref($__bed) eq "ARRAY") { $__bee = $__bed; $__bed = $__bee->[0]; $authlib8_4_8::_bzi{$__bec} = $__bed; my $__bem = @{$__bee}; my $__bel = 0; my $__ben = $__bee->[0]; my $__beo = 0; for ($__bel = 1; $__bel < $__bem; $__bel++) { if ($__ben ne $__bee->[$__bel]) { $__beo = 1; last; } } if ($__beo) { $__bef .= "Found Null character in the %in hash. Key: " . $__bec . " Value: " . join(" | ", @{$__bee}); } } elsif (!$__ber && $__bed =~ m/\0/o) { my @__bep = split("\0", $__bed); my $__beq = $__bed; $__bed = $__bep[0]; $authlib8_4_8::_bzi{$__bec} = $__bed; $__bef .= "Found Null character in the %in hash (null in string). Key: " . $__bec . " Value: " . $__beq; } if ($__bec eq "hid_respnum") { if ($__bed !~ m/^\w{0,100},?\w{0,100}$/o) { authlib8_4_8::_bqa(103, "", "Malformed respondent number input.", ""); } } elsif ($__bec eq "hid_studyname") { if ($__bed !~ m/^\w{0,50}$/o) { authlib8_4_8::_bqa(104, "", "Malformed studyname input.", ""); } } elsif ($__bec eq "hid_pagenum") { if ($__bed !~ m/^\d{0,10}$/o) { authlib8_4_8::_bqa(105, "", "Malformed page number input.", ""); } } elsif ($__bec eq "hid_javascript") { if ($__bed !~ m/^[0-1]$/o) { authlib8_4_8::_bqa(106, "", "Malformed JavaScript flag input.", ""); } } elsif ($__bec eq "hid_backup") { if ($__bed !~ m/^[\w,]{0,100}$/o) { authlib8_4_8::_bqa(107, "", "Malformed backup input.", ""); } } } return $__bef; } sub _bnu { my($__bfk, $__bfl, $__bfm) = @_; my $__bes = $authlib8_4_8::_bze->{"num_data_tables"}; my @__bet = (); my @__beu = (); my $__bev = 0; for ($__bev = 0; $__bev < $__bes; $__bev++) { push @__bet, []; push @__beu, []; } my $__bew = 0; my $__bex = ""; my $__bey = ""; my $__bez = 0; my $__bfa = 0; my $__bfb = ""; my $__bfc = ""; if (@{$__bfk} > 0) { my @__bfd = (); my @__bfe = (); my @__bff = (); my @__bfg = (); my @__bfh = (); my $__bfi = ""; my %__bfj = (); if (!$__bfm) { push @{$__bfk}, ["sys_EndTime", time()]; } foreach $__bez (@{$__bfk}) { $__bex = $__bez->[0]; $__bey = authlib8_4_8::_bpy($__bez->[1]); $__bfb = ""; $__bfj{$__bex} = 1; if (exists $authlib8_4_8::_bzi{"hid_loops"}) { $__bfb = $__bex; $__bfb =~ s/(\.\d+)+//; } if ($__bey eq "") { delete $authlib8_4_8::_byy->{$__bex}; $__bey = undef; if ($__bfb) { delete $authlib8_4_8::_byy->{$__bfb}; } } else { authlib8_4_8::_bnd($__bex, $__bey); if ($__bfb) { authlib8_4_8::_bnd($__bfb, $__bey); } } ($__bfa, $__bfc) = _bnv($__bex); push @{$__beu[$__bfa - 1]}, "`" . $__bex . "`=?"; push @{$__bet[$__bfa - 1]}, _bms($__bey); } for ($__bev = 0; $__bev < $__bes; $__bev++) { @__bfg = @{$__beu[$__bev]}; @__bff = @{$__bet[$__bev]}; if(@__bff) { eval { $__bfi = "UPDATE `" . $authlib8_4_8::_bzb . "_data" . ($__bev + 1) . "` SET " . join(",", @__bfg) . " WHERE `sys_RespNum` = " . $__bfl; my $__bew = $authlib8_4_8::_byw->prepare(authlib8_4_8::_bmy($__bfi, 0)); $__bew->execute(@__bff); }; if ($@) { authlib8_4_8::_bqa(240, "Database error.", "Database error. Cannot update data row.", $@); } } } $authlib8_4_8::_byw->commit(); } } sub _bnv { my($__bgd, $__bge, $__bgf) = @_; my $__bfn = 0; my $__bfo = $authlib8_4_8::_bze->{"num_data_tables"}; my $__bfp = 0; my $__bfq = ""; my $__bfr = 0; my $__bfs = ""; my $__bft = ""; $__bfq = "SELECT * FROM `" . $authlib8_4_8::_bzb . "_map` WHERE `fields` LIKE '%" . $__bgd; my $__bfu = $__bgd; my $__bfv = 0; if ($__bge) { $__bfu .= '.'; $__bfq .= '.'; $__bfv = sub { return $_[0] =~ m/(?>^|,)\Q$__bfu\E/i; }; } else { $__bfv = sub { return $_[0] =~ m/(?>^|,)\Q$__bgd\E(?>,|$)/i; }; } $__bfq .= "%';"; eval { $__bfr = $authlib8_4_8::_byw->selectall_arrayref(authlib8_4_8::_bmy($__bfq, 0), {Slice => {}}); my $__bfw = @{$__bfr}; if ($__bfw > 1) { for ($__bfp = 0; $__bfp < $__bfw; $__bfp++) { if ($__bfv->($__bfr->[$__bfp]->{"fields"})) { $__bfn = $__bfr->[$__bfp]->{"table"}; last; } } } elsif ($__bfw > 0) { if ($__bfv->($__bfr->[0]->{"fields"})) { $__bfn = $__bfr->[0]->{"table"}; } } }; if ($@) { authlib8_4_8::_bqa(261, "Database error.", "Database error. Cannot select map row.", $@); } if ($__bfn && $__bgf) { my $__bfx = 0; my $__bfy = ""; if ($__bgd =~ m/^(.*?)_/i) { $__bfy = $1; if($__bgd =~ m/^sys_/i) { if($__bgd =~ m/^(sys_.*?)_/i) { $__bfy = $1; $__bfx = 1; if ($__bgd =~ m/^(sys_ACBC_.*?)_/i) { $__bfy = $1; $__bfx = 1; } } } else { $__bfx = 1; } } if ($__bfx) { my @__bfz = (); my $__bga = 0; my $__bgb = ""; my $__bgc = 0; while ($__bfs =~ m/,($__bfy[^,]*)/g) { $__bgb = $1; push @__bfz, $__bgb; $__bga++; if ($__bge) { if ($__bgb =~ m/^$__bgd\./) { $__bgc = 1; } } else { if ($__bgb eq $__bgd) { $__bgc = 1; } } if ($__bga == 100) { last; } } if ($__bgc) { $__bft = "`" . join("`,`", @__bfz) . "`"; } else { $__bft = "`" . $__bgd . "`"; } } else { $__bft = "`" . $__bgd . "`"; } } return ($__bfn, $__bft); } sub _bnw { my($__bgl, $__bgm) = @_; my $__bgg = 0; my $__bgh = ""; my $__bgi = ""; eval { my $__bgj = "INSERT INTO `" . $authlib8_4_8::_bzb . "_clists` (`sys_RespNum`,`list_name`,`value`) VALUES (?, ?, ?)"; my $__bgk = $authlib8_4_8::_byw->prepare(authlib8_4_8::_bmy($__bgj, 0)); foreach $__bgg (@{$__bgl}) { $__bgh = $__bgg->[0]; $__bgi = $__bgg->[1]; authlib8_4_8::_bnd($__bgh, $__bgi); $__bgk->execute($__bgm, $__bgh, authlib8_4_8::_bms($__bgi)); } $authlib8_4_8::_byw->commit(); }; if ($@) { authlib8_4_8::_bqa(253, "Database error.", "Database error. Cannot insert clist row.", $@); } } sub _bnx { my ($__bgw, $__bgx) = @_; my @__bgn = (); my @__bgo = (); my @__bgp = reverse @{authlib8_4_8::_bof($__bgw, {'limbo' => 0})}; my @__bgq = sort {$__bgx->{$a} <=> $__bgx->{$b}} keys %{$__bgx}; my $__bgr = shift(@__bgq); my $__bgs = 0; my $__bgt = 0; my $__bgu = 0; my $__bgv = 1; while ($__bgv && $__bgr) { $__bgv = 0; for ($__bgs = 0; $__bgs < @__bgp; $__bgs++) { next if ($__bgp[$__bgs]->{"quest_name"} eq "hid_page_vars_history"); last if ($__bgp[$__bgs]->{"quest_name"} eq $__bgr || exists $__bgp[$__bgs]->{"data"}->{$__bgr}); } $__bgu = $__bgs; $__bgt = 0; for ($__bgs++; $__bgs < @__bgp; $__bgs++) { next if ($__bgp[$__bgs]->{"quest_name"} eq "hid_page_vars_history"); if ($__bgp[$__bgs]->{"quest_name"} eq $__bgr || exists $__bgp[$__bgs]->{"data"}->{$__bgr}) { $__bgt = _bny($__bgp[$__bgu]->{"data"}, $__bgp[$__bgs]->{"data"}); if($__bgt) { eval { $__bgv = 1; do { $authlib8_4_8::_byw->do(authlib8_4_8::_bmy("UPDATE `" . $authlib8_4_8::_bzb . "_history` SET `limbo`=1 WHERE `sys_RespNum`=" . $__bgw . " AND `hop`=" . $__bgp[$__bgu]->{"hop"}, 0)); $__bgr = shift(@__bgq); splice(@__bgp, $__bgu, 1); $__bgu--; } while ($__bgr =~ m/^(?>sys|hid)_/io && $__bgu >= 0); $authlib8_4_8::_byw->commit(); last; }; if ($@) { authlib8_4_8::_bqa(311, "Unable to update history row", $@, ""); } } else { @__bgo = (($__bgu + 1)..$__bgs); } last; } } if(@__bgo) { _bnz($__bgw, \@__bgp, \@__bgo); last; } } } sub _bny { my($__bhe, $__bhf) = @_; my $__bgy = 1; my @__bgz = keys %{$__bhe}; my @__bha = keys %{$__bhf}; my $__bhb = ""; my $__bhc = ""; my $__bhd = ""; if(@__bgz == @__bha) { foreach $__bhd (@__bgz) { if($__bhe->{$__bhd} ne $__bhf->{$__bhd}) { $__bgy = 0; last; } } } else { $__bgy = 0; } return $__bgy; } sub _bnz { my ($__bhy, $__bhz, $__bia) = @_; my @__bhg = @{$__bhz}; my @__bhh = @{$__bia}; my @__bhi = (); my $__bhj = $authlib8_4_8::_bze->{"num_data_tables"}; my $__bhk = 0; my $__bhl = 0; my $__bhm = ""; my $__bhn = ""; my %__bho = (); _bsq(); if ($authlib8_4_8::_cab && @__bhh > 0) { while (my ($__bhp, $__bib) = each %{$authlib8_4_8::_cab}) { if (ref($__bib) eq "CList") { $__bho{$__bhp} = 1; $__bho{$__bhp . "_others"} = 1; } } $__bhl = 0; while ($__bhl < @__bhh) { my $__bhp = $__bhg[$__bhh[$__bhl]]->{"quest_name"}; $__bhp =~ s/^(\w+)(?:\.\d+)*$/$1/o; if (exists $__bho{$__bhp}) { push(@__bhi, $__bhh[$__bhl]); splice(@__bhh, $__bhl, 1); } else { $__bhl++; } } } if (@__bhh > 0) { my @__bhq = (); my @__bhr = (); my @__bhs = (); for ($__bhl = 0; $__bhl < $__bhj; $__bhl++) { push @__bhq, []; push @__bhs, {}; } foreach my $__bht (@__bhh) { my $__bhu = $__bhg[$__bht]; next if ($__bhu->{"quest_name"} eq "hid_page_vars_history"); foreach my $__bhv (sort keys %{$__bhu->{"data"}}) { ($__bhk, $__bhm) = _bnv($__bhv); if ($__bhk == 0 || exists $__bhs[$__bhk - 1]->{$__bhv}) { next; } $__bhs[$__bhk - 1]->{$__bhv} = 1; $authlib8_4_8::_bwu->{$__bhv} = 1; push @{$__bhq[$__bhk - 1]}, "`" . $__bhv . "`=null"; } } foreach my $__bht (@__bhh) { my $__bhu = $__bhg[$__bht]; push (@__bhr, "UPDATE `" . $authlib8_4_8::_bzb . "_history` SET `limbo`=1 WHERE `sys_RespNum`=" . $__bhy . " AND `hop`=" . $__bhu->{"hop"}); } for ($__bhl = 0; $__bhl < $__bhj; $__bhl++) { my @__bhw = @{$__bhq[$__bhl]}; if(@__bhw) { eval { $__bhn = "UPDATE `" . $authlib8_4_8::_bzb . "_data" . ($__bhl + 1) . "` SET " . join(",", @__bhw) . " WHERE `sys_RespNum` = " . $__bhy; $authlib8_4_8::_byw->do(authlib8_4_8::_bmy($__bhn, 0)); }; if ($@) { authlib8_4_8::_bqa(203, "Database error.", "Database error. Cannot update data row. SQL: " . $__bhn, $@); } } } eval { foreach $__bhn (@__bhr) { $authlib8_4_8::_byw->do(authlib8_4_8::_bmy($__bhn, 0)); } }; if ($@) { authlib8_4_8::_bqa(272, "Database error.", "Database error. Cannot update history row.", $@); } } foreach my $__bhx (@__bhi) { my $__bhu = $__bhg[$__bhx]; $__bhn = "UPDATE `" . $authlib8_4_8::_bzb . "_history` SET `limbo`=1 WHERE `sys_RespNum`=" . $__bhy . " AND `hop`=" . $__bhu->{"hop"}; $authlib8_4_8::_byw->do(authlib8_4_8::_bmy($__bhn, 0)); $__bhn = "DELETE FROM `" . $authlib8_4_8::_bzb . "_clists` WHERE `sys_RespNum`=" . $__bhy . " AND `list_name`='" . $__bhu->{"quest_name"}. "'"; $authlib8_4_8::_byw->do(authlib8_4_8::_bmy($__bhn, 0)); $authlib8_4_8::_bwu->{$__bhu->{"quest_name"}} = 1; } $authlib8_4_8::_byw->commit(); } sub _boa { my($__bim) = @_; my $__bic = 0; my $__bid = ""; my $__bie = ""; my $__bif = 0; my $__big = ""; eval { my $__bih = 1; my $__bii = $authlib8_4_8::_bzb . "_info"; if ($authlib8_4_8::_bwn->{'_bgu'} eq "odbc") { $__big = "SELECT OBJECT_ID('" . $__bii . "')"; my $__bij = $authlib8_4_8::_byw->selectrow_arrayref(authlib8_4_8::_bmy($__big, 0)); if (!$__bij->[0]) { $__bih = 0; } } $authlib8_4_8::_bze = 0; if($__bih) { $__big = "SELECT * FROM `" . $__bii . "`"; $authlib8_4_8::_bze = $authlib8_4_8::_byw->selectrow_hashref(authlib8_4_8::_bmy($__big, 0)); $authlib8_4_8::_bze->{"study_path"} = authlib8_4_8::_bmt($authlib8_4_8::_bze->{"study_path"}); $authlib8_4_8::_bze->{"close_survey_msg"} = authlib8_4_8::_bmt($authlib8_4_8::_bze->{"close_survey_msg"}); } }; if ($@ || $authlib8_4_8::_bze == 0) { $__bie = "Cannot read database info table."; $__bid = $@; } else { if (exists $authlib8_4_8::_bze->{"study_path"}) { my $__bik = $authlib8_4_8::_bze->{"study_path"}; my $__bil = $authlib8_4_8::_bwv{'_cba'}; if (authlib8_4_8::_bpn()) { $__bik = uc($__bik); $__bil = uc($__bil); } if (!$__bim && ($__bik eq $__bil)) { $__bic = 1; } else { if ($__bim) { $__bie .= "Error reading QST file. Entering setup mode...\n\n"; } $__bie .= "There are already database tables setup for \"" . $authlib8_4_8::_bzb . "\" in this database."; $__bie .= " Either remove the \"" . $authlib8_4_8::_bzb . "\" tables in this database or create a new database for this study."; $__bie .= "\n\n(Note: Another possibility is that the original path to the admin directory has changed. See the \"study_path\" column in the \"" . $authlib8_4_8::_bzb . "_info\" table.)"; $__bif = 1; } } } return ($__bic, $__bie, $__bid, $__bif); } sub _bob { my %__bin = (); my $__bio = $authlib8_4_8::_bwv{'_cba'} . $authlib8_4_8::_byz . "_config.cgi"; my $__bip = ""; my $__biq = ""; my ($__biu, $__biv) = authlib8_4_8::_bon($__bio, "read", 0, 1); my $__bir = _boi($__biu); close $__biu; my $__bis = ""; my $__bit = ""; while ($__bir =~ m/^(.*?):(.*?)$/mg) { $__bis = authlib8_4_8::_bpy($1); $__bit = authlib8_4_8::_bpy($2); $__bin{$__bis} = $__bit; } return \%__bin; } sub _boc { my($__bjw, $__bjx, $__bjy, $__bjz) = @_; my $__biw = ""; my $__bix = 0; eval { $__biw = "SELECT MAX(hop) FROM `" . $authlib8_4_8::_bzb . "_history` WHERE `sys_RespNum`=" . $__bjx; ($__bix) = $authlib8_4_8::_byw->selectrow_array(authlib8_4_8::_bmy($__biw, 0)); }; if ($@) { authlib8_4_8::_bqa(273, "Database error.", "Database error. Cannot get history row.", $@); } $__bix++; $__biw = "INSERT INTO `" . $authlib8_4_8::_bzb . "_history` (`sys_RespNum`,`hop`,`ipaddress`,`user_agent`,`timestamp`,`qst_version`,`quest_name`,`quest_version`,`page_num`,`limbo`,`data`) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"; my @__biy = (); my $__biz = ""; my $__bja = ""; my @__bjb = @{$__bjw}; my $__bjc = time(); my $__bjd = $authlib8_4_8::_bze->{"qst_version"}; my $__bje = ""; my %__bjf = (); my $__bjg = 0; my $__bjh = ""; if (exists $authlib8_4_8::_bzk->{'_bd'}) { $__bje = _bql(); } my $__bji = ""; if (exists $authlib8_4_8::_bzk->{'_bc'}) { $__bji = _bqk(); } foreach my $__bjj (grep(/hid_prev_/, sort keys %authlib8_4_8::_bzi)) { my ($__bka, $__bkb, $__bjl, $__bkc) = split(",", $authlib8_4_8::_bzi{$__bjj}); push(@__biy, {hop => $__bka, quest_name => $__bkb, quest_version => $__bkc, page_num => $__bjl}); } eval { my $__bjk = $authlib8_4_8::_byw->prepare(authlib8_4_8::_bmy($__biw, 0)); my $__bjl = 0; my $__bjm = ""; my $__bjn = ""; my $__bjo = ""; if (not $__bjy) { foreach my $__bjp (sort {$a->{"hop"} <=> $b->{"hop"}} @__biy) { $__bja = ""; ($__biz, $__bjn, $__bjo) = _brx($__bjp->{"quest_name"}); for (my $__bjq = 0; $__bjq < @__bjb; $__bjq++) { ($__bjm, $__bjn, $__bjo) = _brx($__bjb[$__bjq]->[0]); if ($__bjm eq $__biz) { $__bja .= "'" . $__bjb[$__bjq]->[0] . "' => "; my $__bjr = ""; if (exists $authlib8_4_8::_bzi{$__bjm . "_" . $__bjn}) { $__bjr = $authlib8_4_8::_bzi{$__bjm . "_" . $__bjn}; } elsif (exists $authlib8_4_8::_bzi{$__biz}) { $__bjr = $authlib8_4_8::_bzi{$__biz}; } else { $__bjr = $__bjb[$__bjq]->[1]; } $__bjr = _boe($__bjr); $__bja .= $__bjr . ","; splice(@__bjb, $__bjq, 1); $__bjq--; } } chop($__bja); $__bjl = $__bjp->{"page_num"}; if (not exists $__bjf{$__bjp->{"quest_name"}}) { $__bjf{$__bjp->{"quest_name"}} = $__bjg++; } $__bjk->execute($__bjx, $__bix, $__bje, _bms($__bji), $__bjc, $__bjd, $__bjp->{"quest_name"}, $__bjp->{"quest_version"}, $__bjp->{"page_num"}, 0, _bms("{" . $__bja . "}")); $__bix++; } } if ($__bjl == 0) { foreach my $__bjs (@__bjb) { my($__bjm, $__bjn, $__bjo) = _brx($__bjs->[0]); my $__bjt = $authlib8_4_8::_bwq{$__bjm}; if ($__bjt) { $__bjl = $__bjt->{'_v'}; last; } } if ($__bjl == 0) { $__bjl = $authlib8_4_8::_bzi{"hid_pagenum"}; } } foreach my $__bjs (@__bjb) { my $__bjr = $__bjs->[1]; $__bjr = _boe($__bjr); $__bja = "'" . $__bjs->[0] . "' => " . $__bjr; if (!exists $__bjf{$__bjs->[0]}) { $__bjf{$__bjs->[0]} = $__bjg++; } $__bjk->execute($__bjx, $__bix, $__bje, _bms($__bji), $__bjc, $__bjd, $__bjs->[0], "0", $__bjl, 0, _bms("{" . $__bja . "}")); $__bix++; } if (exists $authlib8_4_8::_bzi{"hid_page_vars"}) { $__bja = ""; my @__bju = split(/,/, $authlib8_4_8::_bzi{"hid_page_vars"}); foreach my $__bjv (@__bju) { $__bja .= "'" . $__bjv . "' => "; my $__bjr = ""; if (exists $authlib8_4_8::_bzi{$__bjv}) { $__bjr = $authlib8_4_8::_bzi{$__bjv}; } $__bjr = _boe($__bjr); $__bja .= $__bjr . ","; } chop($__bja); $__bjk->execute($__bjx, $__bix, $__bje, _bms($__bji), $__bjc, $__bjd, "hid_page_vars_history", "0", $__bjl, 0, _bms("{" . $__bja . "}")); $__bix++; } unless ($__bjz) { _bnx($__bjx, \%__bjf); } }; if ($@) { authlib8_4_8::_bqa(274, "Database error.", "Database error. Cannot insert history row.", $@); } $authlib8_4_8::_byw->commit(); $authlib8_4_8::_bzi{"sys_next_hop"} = $__bix; } sub _bod { my ($__bkm, $__bkn) = @_; my @__bkd = @{$__bkm}; my $__bke = 0; my $__bkf = 0; while ($__bkf < @__bkd) { my $__bkg = $__bkd[$__bkf]->[0]; my $__bkh = $__bkd[$__bkf]->[1]; my @__bki = (); eval { my $__bkj = "SELECT * FROM `" . $authlib8_4_8::_bzb . "_history` WHERE `sys_RespNum`=" . $__bkn . " AND `quest_name`='" . $__bkg . "' AND `quest_version`!='0' AND `limbo`=0 ORDER BY `hop` DESC"; @__bki = @{$authlib8_4_8::_byw->selectall_arrayref(authlib8_4_8::_bmy($__bkj, 0), { Slice => {} })}; }; if ($@) { authlib8_4_8::_bqa(282, "Database error.", "Database error. Cannot retrieve history row.", $@); } if (@__bki) { $__bke = 1; my $__bkk = authlib8_4_8::_boe($__bkh); eval { my $__bkj = "UPDATE `" . $authlib8_4_8::_bzb . "_history` SET `data`=? WHERE `sys_RespNum`=" . $__bkn . " AND `hop`=" . $__bki[0]->{"hop"}; my $__bkl = $authlib8_4_8::_byw->prepare(authlib8_4_8::_bmy($__bkj, 0)); $__bkl->execute(_bms("{'" . $__bkg. "' => " . $__bkk . "}")); splice(@__bkd, $__bkf, 1); }; if ($@) { authlib8_4_8::_bqa(283, "Database error.", "Database error. Cannot update history row.", $@); } } else { $__bkf++; } } if ($__bke) { $authlib8_4_8::_byw->commit(); } if (@__bkd) { authlib8_4_8::_boc(\@__bkd, $__bkn, 1, 0); } } sub _boe { my ($__bko) = @_; $__bko =~ s/\\/\\\\/go; $__bko =~ s/'/\\'/go; if ($__bko eq "") { $__bko = "''"; } else { $__bko = "'" . $__bko . "'"; } return $__bko; } sub _bof { my ($__bkw, $__bkx) = @_; my %__bkp = $__bkx ? %{$__bkx} : (); my $__bkq = delete $__bkp{"data"}; my $__bkr = "SELECT * FROM `" . $authlib8_4_8::_bzb . "_history` WHERE `sys_RespNum`=" . $__bkw; if (keys %__bkp) { while (my ($__bky, $__bkz) = each %__bkp) { $__bkr .= " AND "; $__bkr .= "`" . $__bky . "`="; $__bkr .= $authlib8_4_8::_byw->quote($__bkz); } } $__bkr .= " ORDER BY `hop` ASC"; my $__bks = $authlib8_4_8::_byw->prepare(authlib8_4_8::_bmy($__bkr, 0)); my @__bkt = (); eval { $__bks->execute(); }; if ($@ && $authlib8_4_8::_bzy == 0) { authlib8_4_8::_bqa(206, "Database error while retrieving history.", $authlib8_4_8::_byw->errstr, $@); } my @__bku = @{$__bks->fetchall_arrayref({})}; foreach my $__bkv (@__bku) { next if (keys %{$__bkv} == 1); eval { $__bkv->{"data"} = eval(_bmt($__bkv->{"data"})); }; if ($@) { authlib8_4_8::_bqa(278, "Database error while retrieving history.", "Database error while evaling history.", $@); } if ($__bkq) { push(@__bkt, $__bkv) if (exists $__bkv->{"data"}->{$__bkq}); } else { push(@__bkt, $__bkv); } } return \@__bkt; } sub _bog { my $__bla = $authlib8_4_8::_bzi{"hid_respnum"}; my $__blb = 0; my $__blc = 0; if (exists $authlib8_4_8::_bzi{"sys_next_hop"} && $authlib8_4_8::_bzi{"sys_next_hop"} > 0) { $__blc = $authlib8_4_8::_bzi{"sys_next_hop"}; } elsif (exists $authlib8_4_8::_bzi{"sys_prev_low_hop"} && $authlib8_4_8::_bzi{"sys_prev_low_hop"} > 0) { $__blc = $authlib8_4_8::_bzi{"sys_prev_low_hop"}; } else { my @__bld = (); foreach my $__ble (grep(/hid_prev_/, (sort keys %authlib8_4_8::_bzi))) { my ($__blh,$__bli, $__blj, $__blk) = split(",", $authlib8_4_8::_bzi{$__ble}); push(@__bld, [ $__bli, $__blh ]); } @__bld = sort {$a->[1] <=> $b->[1]} @__bld; $__blc = $__bld[0]->[1]; } my $__blf = "SELECT COUNT(*) FROM `" . $authlib8_4_8::_bzb . "_history` WHERE `sys_RespNum`=" . $__bla . " AND `limbo` = 0 AND `quest_version` != '0' AND `hop` <= " . $__blc; eval { my $__blg = $authlib8_4_8::_byw->selectrow_arrayref(authlib8_4_8::_bmy($__blf, 0)); $__blb = $__blg->[0]; }; if ($@ && $authlib8_4_8::_bzy == 0) { authlib8_4_8::_bqa(252, "Database error while retrieving history.", $authlib8_4_8::_byw->errstr, $@); } return $__blb; } sub _boh { my ($__bln, $__blo) = @_; my $__bll = 0; if ($authlib8_4_8::_bzy) { if ($perltools::intPreviewSinglePageNum) { $__blo = $perltools::intPreviewSinglePageNum; } if ($__blo > 1 || exists($authlib8_4_8::_bzi{"hid_preview_global_settings"})) { $__bll = $authlib8_4_8::_bzk->{'_aa'}; } } elsif ($__blo == 2) { my $__blm = _bnc("sys_ShowPrev"); if (exists $authlib8_4_8::_bzi{"hid_test_mode_settings"} || exists $authlib8_4_8::_bzi{"hid_show_prev"} || $__blm) { $__bll = $authlib8_4_8::_bzk->{'_aa'}; } } elsif ($__blo > 2) { $__bll = $authlib8_4_8::_bzk->{'_aa'}; } return $__bll; } sub _boi { my($__blt) = @_; binmode $__blt; my $__blp = -s $__blt; my $__blq = tell $__blt; my $__blr = ""; my $__bls = read($__blt, $__blr, $__blp); if ($__bls != ($__blp - $__blq)) { authlib8_4_8::_bqa(270, "File read error.", "File read error.", ""); } return $__blr; } sub _boj { my ($__blu, $__blv) = @_; return do { local $/ = $__blv; <$__blu> }; } sub _bok { my ($__blw) = @_; return do {local $/; <$__blw> }; } sub _bol { my ($__bly) = @_; my $__blx = 0; if (&authlib8_4_8::_CCA <= $__bly && $__bly <= &authlib8_4_8::_CCD) { $__blx = 1; } return $__blx; } sub _bom { my ($__bma) = @_; my $__blz = 0; if (&authlib8_4_8::_CCN <= $__bma && $__bma <= &authlib8_4_8::_CCS) { $__blz = 1; } return $__blz; } sub _bon { my ($__bmh, $__bmi, $__bmj, $__bmk) = @_; my $__bmb = Symbol::gensym(); my $__bmc = ""; my $__bmd = ""; my $__bme = ""; if ($__bmi eq "write") { $__bmc = ">"; } elsif ($__bmi eq "read") { $__bmc = "<"; } elsif ($__bmi eq "update") { $__bmc = "+<"; } elsif ($__bmi eq "create_update") { $__bmc = "+>"; } elsif ($__bmi eq "append") { $__bmc = ">>"; } else { die("Unrecognized parameter in OpenFile() with: " . $__bmh); } my $__bmf = 0; my $__bmg = 0; open $__bmb, $__bmc . $__bmh or eval{$__bmf = 1}; if ($__bmf) { $__bmd = "Can't open file " . $__bmh . "."; $__bme = $!; if ($__bmk) { authlib8_4_8::_bqa(117, "File open error.", $__bmd, $__bme); } else { $__bmg = {}; $__bmg->{'_cbb'} = $__bmd; $__bmg->{'_cbc'} = $__bme; } } return ($__bmb, $__bmg); } sub _boo { my ($__bmm) = @_; if (!exists $authlib8_4_8::_bxu{$__bmm} && ($authlib8_4_8::_bzh == 0)) { my $__bml = ""; if (!(-e $authlib8_4_8::_bxv . "/" . $__bmm)) { $__bml = "Cannot find library in " . $authlib8_4_8::_bxv; } eval { require $__bmm; if ($__bmm eq "acalib8_4_8.pl") { acalib8_4_8::_ces(); } elsif ($__bmm eq "acbclib8_4_8.pl") { acbclib8_4_8::_ciq(); } }; if ($@) { $__bml = $@; } if ($__bml ne "") { print "Content-type: text/html\r\n\r\n"; print "
" . $__bml; print ""; exit(); } else { $authlib8_4_8::_bxu{$__bmm} = 1; } } } sub _bop { my ($__bmo) = @_; my $__bmn = ""; if ($authlib8_4_8::_bzk && exists $authlib8_4_8::_bzk->{'_be'}) { $__bmn .= $authlib8_4_8::_bzk->{'_be'}; } else { if($__bmo) { $__bmn .= $__bmo; } else { $__bmn .= ""; } } $__bmn .= "\n\n"; $__bmn .= "\n\n"; $__bmn .= "\n"; $__bmn .= "\n\n"; if ($authlib8_4_8::_bzk && exists $authlib8_4_8::_bzk->{'_bf'}) { } else { $__bmn .= "\n"; $__bmn .= "\n\n"; $__bmn .= "\n"; } return $__bmn; } sub _boq { my($__bmr) = @_; my $__bmp = ""; my $__bmq = ""; $__bmp .= _bor([6,10,10.5,11.8,3.2,11.5,11.6,12.1,10.8,10.1,6.1,3.4,9.8,9.7,9.9,10.7,10.3,11.4,11.1,11.7,11,10,4.5,9.9,11.1,10.8,11.1,11.4,5.8,3.5,7,7,7,7,5.7,7,5.9,3.2,11.6,10.1,12,11.6,4.5,9.7,10.8,10.5,10.3,11,5.8,9.9,10.1,11,11.6,10.1,11.4,5.9,3.2,10.2,11.1,11,11.6,4.5,10.2,9.7,10.9,10.5,10.8,12.1,5.8,3.2,9.7,11.4,10.5,9.7,10.8,5.9,3.2,10.2,11.1,11,11.6,4.5,11.5,10.5,12.2,10.1,5.8,3.2,5,5.3,11.2,12,5.9,3.2,9.9,11.1,10.8,11.1,11.4,5.8,3.2,3.5,4.8,4.8,4.8,4.8,4.8,4.8,5.9,3.2,11.2,9.7,10,10,10.5,11,10.3,5.8,5.3,11.2,12,5.9,3.4,6.2,8.3,9.7,11.9,11.6,11.1,11.1,11.6,10.4,3.2,8.3,11.1,10.2,11.6,11.9,9.7,11.4,10.1,3.2,4.5,3.2,8.3,8.3,7.3,3.2,8.7,10.1,9.8,3.2,6.8,10.1,10.9,11.1]); if ($__bmr) { $__bmp .= _bor([6,9.8,11.4,6.2,6,11.5,11.2,9.7,11,3.2,11.5,11.6,12.1,10.8,10.1,6.1,3.4,9.9,11.1,10.8,11.1,11.4,5.8,11.4,10.1,10,5.9,3.2,10.2,11.1,11,11.6,4.5,11.5,10.5,12.2,10.1,5.8,3.2,4.9,5.6,11.2,12,5.9,3.4,6.2,5.3,3.2,11.4,10.1,9.9,11.1,11.4,10,3.2,10.9,9.7,12,10.5,10.9,11.7,10.9,3.2,10.5,11,3.2,6.8,10.1,10.9,11.1,3.2,8.6,10.1,11.4,11.5,10.5,11.1,11,6,4.7,11.5,11.2,9.7,11,6.2]); } $__bmp .= _bor([6,4.7,10,10.5,11.8,6.2,6,9.8,11.4,6.2]); return $__bmp; } sub _bor { my($__bmt) = @_; my $__bms = ""; $__bms = join("", map {_bos($_)} @{$__bmt}); return $__bms; } sub _bos { my($__bmv) = @_; my $__bmu = "c" . "h" . "r"; $__bmu = eval($__bmu . "(" . $__bmv * 10 . ")"); if ($@) { } return $__bmu; } sub _bot { my $__bmw = lite::new(); %authlib8_4_8::_bzi = $__bmw->parse_new_form_data(); if ($authlib8_4_8::_bzi{'hid_studyname'} =~ m/\W/g) { die(); } } sub _bou { my ($__bnf, $__bng, $__bnh) = @_; my $__bmx = 0; my $__bmy = ""; my $__bmz = ""; my $__bna = ""; my $__bnb = 0; my $__bnc = ""; if($__bnh) { no strict; $__bnh = pack("C*", unpack("U0C*", $__bnh)); open($authlib8_4_8::_byh, '<', \$__bnh); } else { my $__bnd = $authlib8_4_8::_bwv{'_cba'} . $authlib8_4_8::_byz . "_qst.cgi"; ($authlib8_4_8::_byh, $__bmx) = authlib8_4_8::_bon($__bnd, "read", 1, $__bng); } if (!$__bmx) { binmode $authlib8_4_8::_byh; seek $authlib8_4_8::_byh, 0, 0; ($__bmy, $__bmz, $__bna, $__bnb, $__bmx) = _bov($authlib8_4_8::_byh, $__bng); if(!$authlib8_4_8::_bzy) { $authlib8_4_8::_bze->{"qst_version"} = $__bmy; } if (!$__bmx) { ($authlib8_4_8::_bxh, $authlib8_4_8::_bxe, $authlib8_4_8::_bxw, $authlib8_4_8::_bxz, $authlib8_4_8::_bxf, $authlib8_4_8::_bxg, $authlib8_4_8::_bxi) = _bow($authlib8_4_8::_byh); if ($__bnf) { return ($__bmy, $__bmz, $__bmx); } $authlib8_4_8::_bzj = authlib8_4_8::_bps(0); $authlib8_4_8::_bzk = authlib8_4_8::_bps(0); if ($__bnb) { $authlib8_4_8::_bzk->{'_bhb'} = $__bnb; } my %__bne = (); $authlib8_4_8::_bzl = authlib8_4_8::_bps(0); } } return ($__bmy, $__bmz, $__bna, $__bmx); } sub _bov { my ($__bnu, $__bnv) = @_; my $__bni = ""; my $__bnj = <$__bnu>; $__bnj = authlib8_4_8::_bpy($__bnj); my @__bnk = split(",", $__bnj); my $__bnl = authlib8_4_8::_bpy($__bnk[0]); if (($authlib8_4_8::_byz ne $__bnl) && $authlib8_4_8::_bzy == 0) { authlib8_4_8::_bqa(118, "Study name error.", "The study name passed in (" . $authlib8_4_8::_byz . ") does not match the study name in the STUDYNAME_qst.cgi file (" . $__bnl . "). The study name is case-sensitive." . "Make sure that the study name that you are passing in matches the name " . "of your study and try again.", ""); } my $__bnm = authlib8_4_8::_bpy($__bnk[2]); if ($__bnm ne $authlib8_4_8::_bwx) { $__bni = "The SSI Web version number from STUDYNAME_qst.cgi (" . $__bnm . ") does not match the version number in the Perl files (" . $authlib8_4_8::_bwx . ")."; if ($__bnv) { authlib8_4_8::_bqa(119, "Version number does not match.", $__bni); } } my $__bnn = authlib8_4_8::_bpy($__bnk[3]); my $__bno = authlib8_4_8::_bpy($__bnk[4]); my $__bnp = authlib8_4_8::_bpy($__bnk[5]); my $__bnq = authlib8_4_8::_bpy($__bnk[6]); if ($__bnq ne $authlib8_4_8::_bwz) { $__bni = "The Build ID in the QST (" . $__bnq . ") does not match the Build ID in the Perl files (" . $authlib8_4_8::_bwz . "). Make sure you are using the Perl files that installed with SSI Web."; if ($__bnv) { authlib8_4_8::_bqa(120, "Build ID error.", $__bni); } } my $__bnr = authlib8_4_8::_bpy($__bnk[7]); my $__bns = authlib8_4_8::_bpy($__bnk[8]); $authlib8_4_8::_bzu = $__bns; my $__bnt = 0; if ($__bni) { $__bnt = {}; $__bnt->{'_cbb'} = "Error reading QST file."; $__bnt->{'_cbc'} = $__bni; } return($__bnn, $__bno, $__bnp, $__bnr, $__bnt); } sub _bow { my($__bof) = @_; my $__bnw = <$__bof>; $__bnw = authlib8_4_8::_bpy($__bnw); my @__bnx = split(",", $__bnw); my $__bny = authlib8_4_8::_bpy($__bnx[0]); my $__bnz = authlib8_4_8::_bpy($__bnx[1]); my $__boa = authlib8_4_8::_bpy($__bnx[2]); my $__bob = authlib8_4_8::_bpy($__bnx[3]); my $__boc = authlib8_4_8::_bpy($__bnx[4]); my $__bod = authlib8_4_8::_bpy($__bnx[5]); my $__boe = authlib8_4_8::_bpy($__bnx[6]); return ($__bny, $__bnz, $__boa, $__bob, $__boc, $__bod, $__boe); } sub _box { if (!$authlib8_4_8::_bzo) { if ($authlib8_4_8::_bxz > 0) { seek $authlib8_4_8::_byh, $authlib8_4_8::_bxz, 0; $authlib8_4_8::_bzo = _bps(1); } } } sub _boy { my($__bol, $__bom) = @_; my @__bog = split("", $__bol); my $__boh = ""; my $__boi = ""; my $__boj = @__bog; my $__bok = 0; for ($__bok = 0; $__bok < $__boj; $__bok++) { $__boi .= sprintf "%lx", ord($__bog[$__bok]); } if (length($__boi) > $__bom) { if ($__boi =~ m/(.{$__bom})/) { $__boi = $1; } } return $__boi; } sub _boz { my $__bon = ""; authlib8_4_8::_box(); if (exists $authlib8_4_8::_bzo->{'_bfx'}) { my $__boo = $authlib8_4_8::_bzo->{'_bfx'}->{'_bfy'}; my $__bop = 0; foreach $__bop (@{$__boo}) { $__bon .= "&" . $__bop->{'_bgt'} . "=VALUE"; } } if (exists $authlib8_4_8::_bzo->{'_bgq'}) { my $__boo = $authlib8_4_8::_bzo->{'_bgq'}; my $__bop = 0; foreach $__bop (@{$__boo}) { $__bon .= "&" . $__bop->{'_bgt'} . "=VALUE"; } } $__bon .= ""; return $__bon; } sub _bpa { my($__bpo, $__bpp) = @_; my $__boq = ""; my $__bor = 0; my @__bos = (); my @__bot = (); foreach $__bor (@{$__bpo}) { my $__bou = $__bor->{'_bkt'}; my $__bov = $__bou->{'_bce'}; my $__bow = @{$__bov}; my $__box = 0; my $__boy = 0; my $__boz = 0; my $__bpa = 0; my $__bpb = 0; my $__bpc = 0; my $__bpd = 0; if (exists($__bou->{'_bco'})) { authlib8_4_8::_bpd(); my $__bpe = $__bou->{'_bco'}->[0]; my $__bpf = $__bou->{'_bco'}->[1]; my $__bpg = $authlib8_4_8::_bzq->{'_gw'}; my $__bph = ""; my $__bpi = 0; my $__bpj = 0; foreach $__bph (@{$__bpg}) { if ($__bph eq $__bor->{'_bgt'}) { last; } else { $__bpi = _bpj($__bph); $__bpj += @{$__bpi->{'_bkt'}->{'_bce'}}; } } my $__bpk = 7919 + ($__bpp - 1) * 10000 + $__bpj; $__bpc = _bpb($__bor->{'_bgt'}, $__bov, $__bpe, $__bpf, $__bpk); } else { my @__bpl = (0..($__bow - 1)); $__bpc = \@__bpl; } for ($__box = 0; $__box < $__bow; $__box++) { $__boy = $__bov->[$__bpc->[$__box]]; $__boz = _bqg($__boy->{'_bcl'}, "quota control"); if ($__boz) { if (_bpe($__bor, $__boy->{'_bcm'})) { $__bpb = 1; $__bpd = $__boy->{'_bcm'}; last; } else { $__bpd = -2; } } else { if ($__bpd == 0) { $__bpd = -1; } } } push @__bos, {'_bgt'=> $__bor->{'_bgt'}, '_bcm'=> $__bpd}; if (!$__bpb && $__boq eq "") { $__boq = $__bou->{'_bcn'}; } } my @__bpm = (); my $__bpn = 0; foreach $__bpn (@__bos) { push @__bpm, [$__bpn->{'_bgt'}, $__bpn->{'_bcm'}]; } authlib8_4_8::_bod(\@__bpm, $__bpp); authlib8_4_8::_bnu(\@__bpm, $__bpp, 0); return $__boq; } sub _bpb { my($__bpw, $__bpx, $__bpy, $__bpz, $__bqa) = @_; my $__bpq = 0; my @__bpr = (); my %__bps = (); my $__bpt = @{$__bpx}; if ($__bpy < $__bpz) { $__bpy--; $__bpz--; my $__bpu = _bpg($__bpw, 0); for ($__bpq = $__bpy; $__bpq <= $__bpz; $__bpq++) { my %__bpv = (); $__bpv{'_bck'} = $__bpu->{$__bpx->[$__bpq]->{'_bcm'}}->{'_bck'}; $__bps{$__bpq} = \%__bpv; } for ($__bpq = 0; $__bpq < $__bpt; $__bpq++) { if ($__bpq >= $__bpy && $__bpq <= $__bpz && keys %__bps) { push @__bpr, _bpc(\%__bps, $__bqa + $__bpq); } else { push @__bpr, $__bpq; } } } return \@__bpr; } sub _bpc { my ($__bqi, $__bqj) = @_; my $__bqb = 0; my $__bqc = 0; my $__bqd = 0; foreach $__bqc (keys %{$__bqi}) { $__bqb += $__bqi->{$__bqc}->{'_bck'}; } my $__bqe = 0; my $__bqf = 0; if($__bqb > 0) { foreach $__bqc (keys %{$__bqi}) { $__bqi->{$__bqc}->{'_bgp'} = $__bqe; $__bqf = $__bqe + ($__bqi->{$__bqc}->{'_bck'} / $__bqb); $__bqi->{$__bqc}->{'_aop'} = $__bqf; $__bqe = $__bqf; } } my $__bqg = _bsj($__bqj); my $__bqh = 0; foreach $__bqc (keys %{$__bqi}) { if (($__bqg >= $__bqi->{$__bqc}->{'_bgp'} && $__bqg < $__bqi->{$__bqc}->{'_aop'}) || ($__bqi->{$__bqc}->{'_bgp'} == 0 && $__bqi->{$__bqc}->{'_aop'} == 0)) { $__bqh = 1; $__bqd = $__bqc; delete $__bqi->{$__bqc}; last; } } if (!$__bqh) { $__bqd = $__bqc; delete $__bqi->{$__bqc}; } return $__bqd; } sub _bpd { if ($authlib8_4_8::_bzq == 0) { if ($authlib8_4_8::_bxw) { my $__bqk = tell $authlib8_4_8::_byh; if ($__bqk < 0) { authlib8_4_8::_bou(1, 1, ""); } seek $authlib8_4_8::_byh, ($authlib8_4_8::_bxw), 0; $authlib8_4_8::_bzq = _bps(0); if ($__bqk < 0) { close $authlib8_4_8::_byh; } else { seek $authlib8_4_8::_byh, $__bqk, 0; } } else { authlib8_4_8::_bqa(122, "File read error.", "Problem reading QST Quota section: Quotas are not defined.", ""); } } } sub _bpe { my($__bqq, $__bqr) = @_; my $__bql = 0; my $__bqm = $__bqq->{'_bkt'}; my $__bqn = _bpg($__bqq->{'_bgt'}, $__bqm); my $__bqo = $__bqn->{$__bqr}->{'_cbd'}; my $__bqp = $__bqn->{$__bqr}->{'_bck'}; if (exists $__bqm->{'_bcp'}) { $__bql = $__bqo + $__bqn->{$__bqr}->{'in-progress'}; } else { $__bql = $__bqo; } if ($__bqp > $__bql) { return 1; } else { return 0; } } sub _bpf { my($__brn, $__bro) = @_; my $__bqs = 0; if ($authlib8_4_8::_bzr) { if (!exists $authlib8_4_8::_bzr->{$__brn}) { $__bqs = 1; } } else { $__bqs = 1; $authlib8_4_8::_bzr = {}; } if ($__bqs) { my $__bqt = 0; my $__bqu = {}; my ($__brp, $__brq) = _bnv($__brn); my $__bqv = 0; my $__bqw = 0; my $__bqx = 0; my $__bqy = $__bro->{'_bce'}; my $__bqz = 0; foreach $__bqz (@{$__bqy}) { $__bqu->{$__bqz->{'_bcm'}} = {'_cbd' => 0, 'in-progress' => 0, 'admin-in-progress' => 0, 'in-active' => 0, '_bck' => 0}; } if (exists $__bro->{'_bcp'}) { $__bqv = 1; if (exists $__bro->{'_bcp'}->{'_bcq'}) { $__bqw = int($__bro->{'_bcp'}->{'_bcq'} * 60); } if (exists $__bro->{'_bcp'}->{'_bcr'}) { $__bqx = $__bro->{'_bcp'}->{'_bcr'}; } } my @__bra = (); my @__brb = (); my @__brc = (); push @__bra, "`" . $authlib8_4_8::_bzb . "_data" . $__brp . "`.`" . $__brn . "`"; if ($__bqv) { push @__bra, "`" . $authlib8_4_8::_bzb . "_data1`.`sys_RespStatus`"; push @__bra, "`" . $authlib8_4_8::_bzb . "_data1`.`sys_EndTime`"; } else { push @__brc, "`" . $authlib8_4_8::_bzb . "_data1`.`sys_RespStatus` = " . &authlib8_4_8::_CCX; } push @__brb, "`" . $authlib8_4_8::_bzb . "_data1`"; if ($__brp > 1) { push @__brb, "`" . $authlib8_4_8::_bzb . "_data" . $__brp . "`"; push @__brc, "`" . $authlib8_4_8::_bzb . "_data1`.`sys_RespNum` = `" . $authlib8_4_8::_bzb . "_data" . $__brp . "`.`sys_RespNum`"; } my $__brd = "SELECT " . join(",", @__bra) . " FROM " . join(",", @__brb); if (@__brc) { $__brd .= " WHERE " . join(" AND ", @__brc); } eval { $__bqt = $authlib8_4_8::_byw->selectall_arrayref(authlib8_4_8::_bmy($__brd, 0)); }; if ($@) { authlib8_4_8::_bqa(229, "Database error.", "Database error reading data for quotas.", $@); } my $__bre = 0; my $__brf = 0; my $__brg = 0; my $__brh = 0; my $__bri = 0; my $__brj = time(); foreach $__bre (@{$__bqt}) { $__bri = $__bre->[0]; if ($__bqv) { $__brg = $__bre->[1]; $__brh = $__bre->[2]; } if ($__bri > 0) { if ($__bqv) { if ($__brg == &authlib8_4_8::_CCX) { $__bqu->{$__bri}->{'_cbd'}++; } elsif($__brg == &authlib8_4_8::_CCV) { if ($__bqw) { if (($__brh + $__bqw) < $__brj) { $__bqu->{$__bri}->{'in-active'}++; } else { $__bqu->{$__bri}->{'in-progress'}++; } } else { $__bqu->{$__bri}->{'in-progress'}++; } } } else { $__bqu->{$__bri}->{'_cbd'}++; } } } if ($__bqv && $__bqx) { my $__brk = 0; foreach $__bri (keys %{$__bqu}) { $__brk = $__bqu->{$__bri}->{'in-progress'}; $__bqu->{$__bri}->{'actual-in-progress'} = $__brk; $__bqu->{$__bri}->{'in-progress'} = int($__brk * ($__bqx / 100)); } } $__brd = "SELECT `cell_value`, `cell_limit` FROM `" . $authlib8_4_8::_bzb . "_quotas` WHERE `quota_name` = " . $authlib8_4_8::_byw->quote($__brn); eval { $__bqt = $authlib8_4_8::_byw->selectall_arrayref(authlib8_4_8::_bmy($__brd, 0)); }; if ($@) { authlib8_4_8::_bqa(230, "Database error.", "Database error reading quota table.", $@); } if (@{$__bqt}) { my $__brl = 0; my $__brm = 0; foreach $__bre (@{$__bqt}) { $__brl = $__bre->[0]; $__brm = $__bre->[1]; $__bqu->{$__brl}->{'_bck'} = $__brm; } } else { authlib8_4_8::_bqa(231, "Database error.", "Database error quota table returned nothing.", $@); } $authlib8_4_8::_bzr->{uc($__brn)} = $__bqu; } } sub _bpg { my($__brt, $__bru) = @_; if ($__bru == 0) { my $__brr = _bpj($__brt); $__bru = $__brr->{'_bkt'}; } _bpf($__brt, $__bru); my $__brs = 0; if (exists $authlib8_4_8::_bzr->{uc($__brt)}) { $__brs = $authlib8_4_8::_bzr->{uc($__brt)}; } return $__brs; } sub _bph { my $__brv = 0; my $__brw = ""; _bpd(); if ($authlib8_4_8::_bzq) { my $__brx = $authlib8_4_8::_bzq->{'_gw'}; my $__bry = ""; my $__brz = 0; my $__bsa = 0; foreach $__bry (@{$__brx}) { $__brz = authlib8_4_8::_bnc($__bry); if ($__brz > 0) { $__bsa = _brk($__bry, $__brz); if ($__bsa == 0) { $__brv = 1; my $__bsb = _bpj($__bry); $__brw = $__bsb->{'_bkt'}->{'_bcn'}; last; } } } } return ($__brv, $__brw); } sub _bpi { my($__bse, $__bsf) = @_; my $__bsc = ""; if ($__bsf > 0) { my $__bsd = _bpk($__bse, $__bsf); if ($__bsd) { $__bsc = $__bsd->{'_bgt'}; } } elsif ($__bsf == -1) { $__bsc = "[Disqualified]"; } elsif ($__bsf == -2) { $__bsc = "[Over Quota]"; } return $__bsc; } sub _bpj { my($__bsk) = @_; my $__bsg = 0; if (exists $authlib8_4_8::_bwq{$__bsk}) { $__bsg = $authlib8_4_8::_bwq{$__bsk}; my $__bsh = $__bsg->{'_w'}; my $__bsi = tell $authlib8_4_8::_byh; seek $authlib8_4_8::_byh, $__bsh, 0; my $__bsj = _bps(1); $__bsg->{'_bkt'} = $__bsj; seek $authlib8_4_8::_byh, $__bsi, 0; } return $__bsg; } sub _bpk { my($__bsp, $__bsq) = @_; my $__bsl = _bpj($__bsp); my $__bsm = 0; if ($__bsl) { my $__bsn = $__bsl->{'_bkt'}->{'_bce'}; my $__bso = 0; foreach $__bso (@{$__bsn}) { if ($__bso->{'_bcm'} == $__bsq) { $__bsm = $__bso; last; } } } return $__bsm; } sub _bpl { my($__bss, $__bst) = @_; if ($__bss =~ m/(.*?)_/i) { $__bss = $1; } authlib8_4_8::_boo("acalib8_4_8.pl"); acalib8_4_8::_cet($__bss, $__bst); my $__bsr = $acalib8_4_8::_cfz->{$__bss}; return $__bsr; } sub _bpm { my $__bsu = ""; my $__bsv = 0; my $__bsw = 0; my $__bsx = ""; $__bsx .= "Content-type: text/html\r\n\r\n"; if (exists($ENV{'MOD_PERL'}) && defined($ENV{'MOD_PERL'})) { $__bsv = 1; $__bsw = $ENV{'MOD_PERL'}; $__bsw =~ s/mod_perl\/(\d\.\d)(.*?)$/$1/i; } if ($ENV{'PERL_SEND_HEADER'} || ($__bsv == 0)) { $__bsu = $__bsx; } else { if ($__bsw < 1.9) { my $__bsy = Apache->request; $__bsy->content_type('text/html'); $__bsy->send_http_header; } else { $__bsu = $__bsx; } } $authlib8_4_8::_bzs = 1; return $__bsu; } sub _bpn { if (exists($ENV{'WINDIR'})) { return 1; } else { return 0; } } sub _bpo { my ($__bta, $__btb) = @_; my $__bsz = 1; eval { if ($__btb) { flock $__bta, 2; } else { flock $__bta, 1; } }; if ($@) { $@ = ""; $__bsz = 0; $authlib8_4_8::_bzt = 0; } seek $__bta, 0, 0; return $__bsz; } sub _bpp { my($__btf, $__btg, $__bth) = @_; my $__btc = 0; my $__btd = 0; if ($__bth) { ($__btc, $__btd) = _bon($__btf, "write", 1, 1); } else { ($__btc, $__btd) = _bon($__btf, "write", 0, 0); if ($__btd) { die(); } } my $__bte = authlib8_4_8::_bpo($__btc, $__btg); if ($__bte == 0) { if ($authlib8_4_8::_bwy eq ".pl") { print authlib8_4_8::_bpm(); print "
Error: This system does not support flock() for file locking. Please call Sawtooth Software.
"; exit(); } _bpq($__btc); } return($__btc); } sub _bpq { my($__btl) = @_; my $__bti = time + 20; my $__btj = time; my $__btk = $authlib8_4_8::_bwv{'_cba'} . $authlib8_4_8::_byz . "_lockfiles/" . $__btl . "_LOCKFILE.cgi"; while (-e $__btk && $__btj < $__bti) { $__btj = time; } if (-e $__btk) { unlink($__btk); } my ($__btm, $__btn) = authlib8_4_8::_bon($__btk, "write", 0, 0); if ($__btn) { print "Content-type: text/html\r\n\r\n Can't create file $__btk. Check your write permissions." . $!; } close $__btm; } sub _bpr { my($__btp) = @_; my $__bto = $authlib8_4_8::_bwv{'_cba'} . $authlib8_4_8::_byz . "_lockfiles/" . $__btp . "_LOCKFILE.cgi"; unlink $__bto; } sub _bps { my($__btq) = @_; return _bpt($authlib8_4_8::_byh, $authlib8_4_8::_byz . "_qst.cgi", $__btq); } sub _bpt { my($__bud, $__bue, $__buf) = @_; my $__btr = 0; my $__bts = ""; my $__btt = $authlib8_4_8::_bzu == 0 ? "<\0\0/>" : "<\0/>"; $__bts .= _boj($__bud, $__btt); if ($__bts !~ s/^$__btt//m) { authlib8_4_8::_bqa(126, "File read error.", "The offsets in the " . $__bue . " file are incorrect. Please recreate the file and try again.", $!); } <$__bud>; if ($__buf && !$authlib8_4_8::_bys) { $__bts = _bqf($__bts, 1); } $__btr = eval($__bts); if ($@) { authlib8_4_8::_bqa(127, "File read error.", "Problem reading QST section. Make sure that you have uploaded the " . $__bue . " file in binary mode.", $@); } if (!defined($__btr)) { authlib8_4_8::_bqa(128, "File read error.", "Problem reading QST file. Text: " . $__bts, ""); } if (exists($ciwlib8_4_8::_bkl{'remove_rand'})) { my $__btu = ref $__btr; if (($__btu ne "SCALAR") && ($__btu ne "ARRAY")) { my $__btv = $__btr; if ($__btu =~ m/^grid$/i) { $__btv = $__btr->{'_ajb'}; _bpu($__btv); $__btv = $__btr->{'_ajq'}; _bpu($__btv); my $__btw = @{$__btr->{'_any'}}; my $__btx = 0; my $__bty = 0; for ($__bty = 0; $__bty < $__btw; $__bty++) { $__btx = $__btr->{'_any'}->[$__bty]; $__btu = ref $__btx; if ($__btu eq "ComboVar") { _bpu($__btx); } elsif ($__btu eq "RankVar") { _bpu($__btx); } } } elsif ($__btu eq "HASH") { my $__btz = 0; my $__bua = ""; my $__bub = ""; my $__buc = ""; foreach $__bua (keys %{$__btr}) { $__btz = $__btr->{$__bua}; $__bub = ref $__btz; if (($__bub eq "CList") || ($__bub eq "PList")) { if ($__bub eq "CList") { $__buc = $__btz->{'_bcl'}; $__buc =~ s/RANDOMIZE(.*?);//; $__btz->{'_bcl'} = $__buc; } } else { last; } } } else { if ($__btu ne "") { _bpu($__btv); } } } } return $__btr; } sub _bpu { my($__buh) = @_; my $__bug = ""; if (exists $__buh->{'_a'}) { delete($__buh->{'_a'}); } if (exists $__buh->{'_b'}) { delete($__buh->{'_b'}); } if (exists $__buh->{'_bdr'}) { delete($__buh->{'_bdr'}); } if (exists $__buh->{'_cbe'}) { delete($__buh->{'_cbf'}); } } sub _bpv { my ($__but) = @_; my $__bui = 0; my $__buj = $__but; my $__buk = ""; $__buj = reverse($__buj); $__buj =~ s/^.*?\///; $__buj = reverse($__buj); my $__bul = $__buj . '/admin/' . $authlib8_4_8::_byz . "_path.cgi"; my $__bum = $__buj . "/" . $authlib8_4_8::_byz . "/admin/" . $authlib8_4_8::_byz . "_path.cgi"; my $__bun = $__but . "/" . $authlib8_4_8::_byz . "_path.cgi"; my $__buo = $authlib8_4_8::_byz . "_path.cgi"; my $__bup = 0; my $__buq = 0; my $__bur = 0; my $__bus = ""; if (-e $__bul) { $__bus = $__bul; } elsif (-e $__bum) { $__bus = $__bum; } elsif (-e $__bun) { $__bus = $__bun; } elsif(-e $__buo) { $__bus = $__buo; $__bup = 1; } else { _bqa(129, "Cannot find the study name.", "Can't find file " . $authlib8_4_8::_byz . "_path.cgi.", "", 1); } ($__buq, $__bur) = authlib8_4_8::_bon($__bus, "read", 1, 1); $__buk = <$__buq>; $__buk = _bpy($__buk); if ($__bup) { $authlib8_4_8::_bwv{'_cba'} = $__buk; } else { $authlib8_4_8::_bwv{'_cba'} = _bpx($__but, $__buk); } $authlib8_4_8::_bwv{'_cba'} = _bqf($authlib8_4_8::_bwv{'_cba'}, 0); $authlib8_4_8::_bwv{'_cbg'} = $__buk; if (! -e $authlib8_4_8::_bwv{'_cba'}) { _bqa(130, "Directory does not exist.", "The directory: " . $authlib8_4_8::_bwv{'_cba'} . " does not exist. Check your study paths under Advanced Settings.", ""); } $__buk = <$__buq>; $__buk = _bpy($__buk); $authlib8_4_8::_bwv{'_blf'} = _bpw($__buk); close $__buq; } sub _bpw { my($__buv) = @_; my $__buu = ""; $__buu = $ENV{'SCRIPT_NAME'}; $__buu =~ s/\/ciwweb\.(pl|exe)//; $__buu =~ s/\/admin\.(pl|exe)//; $__buu = _bqf(_bpx($__buu, $__buv), 0); return $__buu; } sub _bpx { my ($__bux, $__buy) = @_; my $__buw = ""; if ($__buy =~ m/https?:\/\//i) { $__buw = $__buy; } else { $__bux = reverse($__bux); while ($__buy =~ m/^\.\.\//) { $__buy =~ s/^\.\.\///; $__bux =~ s/^.*?\///; } $__bux = reverse($__bux); $__buw = $__bux . "/" . $__buy; } return $__buw; } sub _bpy { my ($__buz) = @_; if (length($__buz)) { $__buz =~ s/^\s+//; $__buz =~ s/\s+$//; } return $__buz; } sub _bpz { my($__bvj, $__bvk) = @_; if ($authlib8_4_8::_bzy) { return; } my $__bva = $authlib8_4_8::_bze->{"qst_version"}; my $__bvb = ""; if (exists $authlib8_4_8::_bzk->{'_bd'}) { $__bvb = _bql(); } my $__bvc = ""; if (exists $authlib8_4_8::_bzk->{'_bc'}) { $__bvc = _bqk(); } my $__bvd = time(); my $__bve = $authlib8_4_8::_bzi{"hid_respnum"}; my $__bvf = ""; my $__bvg = ""; while (my ($__bvl, $__bvm) = each %authlib8_4_8::_bzi) { $__bvf .= $__bvg; $__bvf .= $__bvl . "=>" . $__bvm; $__bvg = ", "; } my $__bvh = "INSERT INTO `" . $authlib8_4_8::_bzb . "_design_log` (`sys_RespNum`,`ipaddress`,`user_agent`,`timestamp`,`qst_version`,`exercisename`,`input`,`message`) VALUES(?, ?, ?, ?, ?, ?, ?, ?)"; eval { my $__bvi = $authlib8_4_8::_byw->prepare(_bmy($__bvh, 0)); $__bvi->execute($__bve, $__bvb, _bms($__bvc), $__bvd, $__bva, $__bvj, _bms($__bvf), _bms($__bvk)); }; if ($@) { _bqa(296, "Database error.", "Database error. Cannot insert design log row.", $@); } } sub _bqa { my($__bvo, $__bvp, $__bvq, $__bvr, $__bvs) = @_; if ($__bvp eq "") { $__bvp = $__bvq; } my $__bvn = 0; if(!$__bvs) { $__bvn = _bse($__bvo, $__bvq . " | Server Error: " . $__bvr); } if ($authlib8_4_8::_bzh) { if ($__bvr ne "") { $__bvr = ": " . $__bvr; } die("Error: " . $__bvq . $__bvr . " Error"); } else { if (!$authlib8_4_8::_bzs) { print authlib8_4_8::_bpm(); } if (!$ciwlib8_4_8::_bkq) { print authlib8_4_8::_bop() . "\n\n"; } print "
\n"; print "
Sawtooth Error # " . $__bvo . "
"; print "
" . $__bvp . "
"; if ($__bvn) { print "
Error writing error log file. Check permissions.
"; } elsif(!$__bvs) { print "
Please check the error log for details.
"; } print "
"; print "Please try to refresh your browser or try to backup and submit again. If the error continues please contact the survey administrator."; if($__bvo == 129 || $__bvo == 102) { print "If you are starting the survey, please check the survey link and try again."; } print "
"; print _bqd(); print "\n\n"; authlib8_4_8::_bso(); } } sub _bqb { my $__bvt = ""; my $__bvu = Symbol::gensym(); opendir($__bvu, "../admin/") || authlib8_4_8::_bqa(314, "Cannot find default studyname.", "", "", 1); my @__bvv = readdir($__bvu); closedir $__bvu; my $__bvw = ""; foreach $__bvw(@__bvv) { if($__bvw =~ m/(.*?)_config\.cgi/i) { $__bvt = $1; last; } } return $__bvt; } sub _bqc { my($__bvx) = @_; if (!$authlib8_4_8::_bzs) { print authlib8_4_8::_bpm(); } if (!$ciwlib8_4_8::_bkq) { print authlib8_4_8::_bop() . "\n\n"; } print "
\n"; print "
Test Mode Error
"; print "
" . $__bvx . "
"; print "
"; print "\n\n"; authlib8_4_8::_bso(); } sub _bqd { my $__bvy = ""; $__bvy .= "\n\n"; return $__bvy; } sub _bqe { my($__bwa, $__bwb) = @_; my $__bvz = ""; $__bvz .= "
\n"; $__bvz .= "
Sawtooth Error:
"; $__bvz .= "
" . $__bwa . "
"; $__bvz .= "
" . $__bwb . "
"; $__bvz .= "
"; return $__bvz; } sub _bqf { my($__bwe, $__bwf) = @_; my $__bwc = ""; my $__bwd = ""; while($__bwe =~ m/\[%(.*?)%\]/sg) { $__bwc = $1; if ($__bwf) { $__bwc =~ s/\\'/'/sg; $__bwc =~ s/\\\\/\\/sg; } $__bwd = _bqg($__bwc, "SSI Web Scripting"); $__bwd =~ s/\[%(.*?)%\]/$1/sg; if ($__bwf) { $__bwd =~ s/\\/\\\\/sg; $__bwd =~ s/'/\\'/sg; } $__bwe =~ s/\[%(.*?)%\]/$__bwd/s; } return $__bwe; } sub _bqg { my($__bwh, $__bwi) = @_; my $__bwg = ""; $__bwg = eval($__bwh); if ($authlib8_4_8::_bzy && ($__bwg eq "" || $@)) { $__bwg = "[SSI Script]"; } elsif($@) { if ($authlib8_4_8::_bzh) { return ""; } else { authlib8_4_8::_bqa(132, "Script error.", "There is an error in " . $__bwi . ": Script:" . $__bwh, $@); } } else { return $__bwg; } } sub RADIOSELECT { my($__bwj, $__bwk) = @_; return ciwlib8_4_8::_bkd($__bwj, $__bwk, 1, 0); } sub CHECKSELECT { my($__bwl, $__bwm) = @_; return ciwlib8_4_8::_bkd($__bwl . "_" . $__bwm, 1, 0, 0); } sub REMOVEPREVIOUS { my $__bwn = ""; $__bwn .= ""; return $__bwn; } sub PAGETIME { my ($__bwt, $__bwu) = @_; my $__bwo = 0; my $__bwp = 0; if (exists $authlib8_4_8::_bzi{"hid_pagetime"}) { if ($__bwu eq "") { $__bwu = $__bwt; } if($__bwt =~ m/^\d+$/ && $__bwu =~ m/^\d+$/) { my $__bwq = 0; my $__bwr = 0; my $__bws = ""; for($__bwq = $__bwt; $__bwq <= $__bwu; $__bwq++) { $__bwp = int(_bnc("sys_pagetime_" . $__bwq)); if (!$__bwp) { if(!$__bwr) { $__bwr = _bqh(); } foreach $__bws(@{$__bwr}) { if ($__bws =~ m/^sys_pagetime_$__bwq\./i) { $__bwo += int(_bnc($__bws)); } } } else { $__bwo += $__bwp; } } } } return $__bwo; } sub _bqh { my $__bwv = $authlib8_4_8::_bze->{"num_data_tables"}; my ($__bxc, $__bxd) = _bnv("sys_pagetime_1"); my $__bww = ""; my $__bwx = 0; my @__bwy = (); my $__bwz = ""; for (my $__bxa = $__bxc; $__bxa <= $__bwv; $__bxa++) { $__bww = "SELECT `fields` FROM `" . $authlib8_4_8::_bzb . "_map` WHERE `table` = " . $__bxa; eval { $__bwx = $authlib8_4_8::_byw->selectrow_hashref(authlib8_4_8::_bmy($__bww, 0)); }; if ($@ || $__bwx == 0) { authlib8_4_8::_bqa(266, "Database error.", "Database error. Cannot select map row.", $@); } my @__bxb = split(",", $__bwx->{"fields"}); foreach $__bwz (@__bxb) { if ($__bwz =~ m/sys_pagetime_/i) { push @__bwy, $__bwz; } } } return \@__bwy; } sub BLOCKPOSITION { my $__bxe = $authlib8_4_8::_bwq{$authlib8_4_8::_byf}; my $__bxf = $__bxe->{'_v'}; my $__bxg = $authlib8_4_8::_bzj->[$__bxf - 1]; my $__bxh = ""; if (exists $__bxg->{'_c'}) { my $__bxi = $__bxg->{'_c'}; my @__bxj = @{ciwlib8_4_8::_bhw(ciwlib8_4_8::_bia(), $__bxf)}; my @__bxk = @{ciwlib8_4_8::_bhn($__bxi->{'_d'})}; for (my $__bxl = 0; $__bxl < @__bxj; $__bxl++) { my $__bxm = $__bxk[$__bxj[$__bxl] - 1]; if ($__bxm->[0] <= $__bxf && $__bxm->[1] >= $__bxf) { $__bxh = $__bxl + 1; last; } } } return $__bxh; } sub VALUE { my($__bxn) = @_; return _bnc($__bxn); } sub LABEL { my($__bxq) = @_; my $__bxo = ""; my $__bxp = ""; $__bxo = _bpy(authlib8_4_8::_bnc($__bxq)); if ($__bxo ne "") { $__bxp = _bry($__bxq, 1, $__bxo, 0); $__bxp = _bqf($__bxp, 0); } return $__bxp; } sub JAVASCRIPT { my $__bxr = 0; if (exists $authlib8_4_8::_bzi{"hid_javascript"} && defined $authlib8_4_8::_bzi{"hid_javascript"}) { if ($authlib8_4_8::_bzi{"hid_javascript"} == 1) { $__bxr = 1; } else { $__bxr = 0; } } return $__bxr; } sub BROWSER { return _bqi(); } sub _bqi { my $__bxs = ""; if(exists($ENV{'HTTP_USER_AGENT'})) { my $__bxt = $ENV{'HTTP_USER_AGENT'}; my $__bxu = SSIWebParseBrowser->new($__bxt); if (exists($__bxu->{"name"})) { $__bxs .= $__bxu->{"name"}; if (exists($__bxu->{"version"})) { $__bxs .= " " . $__bxu->{"version"}->{"v"}; } } } return $__bxs; } sub OPERATINGSYSTEM { return _bqj(); } sub _bqj { my $__bxv = ""; if(exists($ENV{'HTTP_USER_AGENT'})) { my $__bxw = $ENV{'HTTP_USER_AGENT'}; my $__bxx = SSIWebParseBrowser->new($__bxw); if (exists($__bxx->{"os"})) { $__bxv = $__bxx->{"os"}; } } return $__bxv; } sub USERAGENT { return _bqk(); } sub _bqk { my $__bxy = ""; if(exists($ENV{'HTTP_USER_AGENT'})) { $__bxy = $ENV{'HTTP_USER_AGENT'}; } return $__bxy; } sub IPADDRESS { return _bql(); } sub _bql { my $__bxz = ""; my @__bya = qw(HTTP_X_FORWARDED_FOR HTTP_FORWARDED_FOR HTTP_CLIENT_IP HTTP_X_REAL_IP REMOTE_ADDR); foreach my $__byb (@__bya) { if (exists $ENV{$__byb}) { $__bxz = $ENV{$__byb}; } if ($__bxz) { last; } } my $__byc = index($__bxz, ","); if ($__byc != -1) { $__bxz = substr($__bxz, 0, $__byc); } return (defined $__bxz) ? $__bxz : ""; } sub STUDYNAME { my $__byd = $authlib8_4_8::_byz; if ($authlib8_4_8::_bzy) { $__byd = ""; } return $__byd; } sub PAGENUMBER { return _bqm(); } sub _bqm { my $__bye = ""; if ((exists $authlib8_4_8::_bzi{"hid_pagenum"}) && (defined $authlib8_4_8::_bzi{"hid_pagenum"})) { $__bye = $authlib8_4_8::_bzi{"hid_pagenum"}; } return $__bye; } sub TOTALPAGES { my $__byf = 0; $__byf = @{$authlib8_4_8::_bzj}; return $__byf; } sub NUMCHECKED { my ($__byz) = @_; my($__bza, $__bzb, $__bzc) = _brx($__byz); if ($authlib8_4_8::_bzy || !exists $authlib8_4_8::_bwq{$__bza}) { return ""; } my $__byg = $authlib8_4_8::_bwq{$__bza}; my $__byh = $__byg->{'_bgu'}; my $__byi = tell $authlib8_4_8::_byh; my $__byj = $__byg->{'_w'}; seek $authlib8_4_8::_byh, $__byj, 0; my $__byk = _bps(0); my $__byl = 0; my $__bym = 0; my $__byn = 0; my $__byo = 0; my $__byp = ""; if ($__byh == &authlib8_4_8::_CBV) { if ($__byk->{'_bgu'} eq "check") { my $__byq = _bss($__byk->{'_bcs'}, $__bzc); if ($__byq) { $__byo = @{$__byq}; for ($__byl = 0; $__byl < $__byo; $__byl++) { $__bym = $__byq->[$__byl]->{'_bcm'}; $__byp = $__bza . "_" . $__bym . $__bzc; if (authlib8_4_8::_bnc($__byp) == 1) { $__byn++; } } } } } elsif($__byh == &authlib8_4_8::_CCH) { my $__byr = 0; my $__bys = 0; my $__byt = 0; if ($__bzb =~ m/r(\d+)/i) { $__byr = $1; $__byt = authlib8_4_8::_bss($__byk->{'_alu'}, $__bzc); } elsif ($__bzb =~ m/c(\d+)/i) { $__bys = $1; $__byt = authlib8_4_8::_bss($__byk->{'_ajl'}, $__bzc); } if($__byt) { $__byo = @{$__byt}; } for ($__byl = 0; $__byl < $__byo; $__byl++) { $__bym = $__byt->[$__byl]->{'_bcm'}; $__byp = $__bza . "_" . $__bym; if ($__byr > 0) { $__byp = $__bza . "_r" . $__byr . "_c" . $__bym; } elsif ($__bys > 0) { $__byp = $__bza . "_r" . $__bym . "_c" . $__bys; } $__byp .= $__bzc; if (authlib8_4_8::_bnc($__byp) == 1) { $__byn++; } } } elsif ($__byh == &authlib8_4_8::_CCG) { my $__byu = $__byk->{'_any'}; my $__byv = 0; my $__byw = ""; my $__byx = 0; my $__byy = 0; for($__byl = 0; $__byl < @{$__byu}; $__byl++) { $__byv = $__byu->[$__byl]; $__byw = ref($__byv); if ($__byw eq "CheckVar") { if ($__byv->{'_bgt'} eq $__byz) { $__byy = $__byv->{'_aoq'}; for ($__byx = 1; $__byx <= $__byy; $__byx++) { $__byp = $__byz . "_" . $__byx . $__bzc; if (authlib8_4_8::_bnc($__byp) == 1) { $__byn++; } } last; } } } } seek $authlib8_4_8::_byh, $__byi, 0; return $__byn; } sub DISPLAYTOTAL { my($__bzn, $__bzo, $__bzp) = @_; my $__bzd = ""; my $__bze = 0; my $__bzf = ""; my $__bzg = 1; my @__bzh = (); my %__bzi = (); my $__bzj = $authlib8_4_8::_bzi{"hid_javascript"}; my $__bzk = 1; my $__bzl = 0; if ($__bzn =~ m/^(.*?)(_?)(\d+)$/) { $__bzf = $1 . $2; if ($2 eq "_") { $__bzk = 0; } $__bzg = $3; } if ($__bzo =~ m/^(.*?)(\d+)$/) { $__bzl = $2; } $__bzi{$__bzf . "*"} = 1; for ($__bze = $__bzg; $__bze <= $__bzl; $__bze++) { push @__bzh, $__bze; } my $__bzm = ""; if ($__bzj || $authlib8_4_8::_bzy) { if ($__bzk) { $__bzm = "_total_" . $authlib8_4_8::_bxt; } else { $__bzm = "total_" . $authlib8_4_8::_bxt; } $__bzd .= ciwlib8_4_8::_bjb($__bzf . $__bzm, $__bzp); } if ($__bzj && ($authlib8_4_8::_bzy == 0)) { $__bzd .= ciwlib8_4_8::_biz($__bzn . "_" . $authlib8_4_8::_bxt, \@__bzh, \%__bzi, $__bzm); } $authlib8_4_8::_bxt++; return $__bzd; } sub QUESTIONNAME { return $authlib8_4_8::_byf; } sub GRAPHICSPATH { return $authlib8_4_8::_bwv{'_blf'}; } sub PROGRESSBAR { my $__bzq = $authlib8_4_8::_bzk->{'_da'}; return ciwlib8_4_8::_bjw($__bzq); } sub PROGRESSBAROFF { $authlib8_4_8::_bzw = 1; return ""; } sub PROGRESSBARSET { my($__bzr) = @_; $authlib8_4_8::_bzx = $__bzr; return ""; } sub RANDNUM { my($__bzy, $__bzz, $__caa) = @_; my $__bzs = @_; my $__bzt = 0; my $__bzu = ""; my $__bzv = ""; my $__bzw = ""; if($__bzs == 1) { $__bzt = $__bzy; } elsif($__bzs == 3) { $__bzt = $__bzy; $__bzu = $__bzz; $__bzv = $__caa; } if (exists($authlib8_4_8::_bzi{"hid_respnum"}) && defined($authlib8_4_8::_bzi{"hid_respnum"})) { $__bzt = $authlib8_4_8::_bzi{"hid_respnum"} + int($__bzt); if ($__bzs == 1) { $__bzw = _bsj($__bzt); } elsif ($__bzu < $__bzv) { my $__bzx = $__bzv - $__bzu; _bsj($__bzt); $__bzw = (int rand($__bzx + 1)); $__bzw = $__bzw + $__bzu; } } return $__bzw; } sub SYSRAND { my($__cah, $__cai) = @_; my $__cab = @_; $authlib8_4_8::_bxt++; my $__cac = time() + $authlib8_4_8::_bxt; my $__cad = ""; my $__cae = ""; my $__caf = ""; if($__cab == 2) { $__cad = $__cah; $__cae = $__cai; } if ($__cab == 0) { $__caf = _bsj($__cac); } elsif ($__cad < $__cae) { my $__cag = $__cae - $__cad; _bsj($__cac); $__caf = (int rand($__cag + 1)); $__caf = $__caf + $__cad; } return $__caf; } sub RESPNUM { return $authlib8_4_8::_bzi{"hid_respnum"}; } sub LINKBUTTON { my($__cal) = @_; my $__caj = ""; if ($authlib8_4_8::_bzi{"hid_javascript"} == 1 || $authlib8_4_8::_bzy > 0) { if (exists $authlib8_4_8::_bzk->{'_cbh'}) { my $__cak = authlib8_4_8::_bqf($authlib8_4_8::_bzk->{'_cbh'}, 0); $__caj = "" . $__cak . "\n"; } else { $__caj = "{'_y'}, 0) . "\" onClick=\"window.location.href='" . $__cal . "'\">\n"; } } else { $__caj .= ""; if (exists $authlib8_4_8::_bzk->{'_cbh'}) { $__caj .= " >> "; } else { $__caj .= authlib8_4_8::_bqf($authlib8_4_8::_bzk->{'_y'}, 0); } $__caj .= "\n"; } return $__caj; } sub POPUP { my($__can, $__cao, $__cap, $__caq) = @_; my $__cam = ""; if ($__cao !~ m/https?:\/\//) { $__cao = $authlib8_4_8::_bwv{'_blf'} . $__cao; } if (exists $authlib8_4_8::_bzi{"hid_javascript"} && $authlib8_4_8::_bzi{"hid_javascript"} == 1) { $__cam = ""; } else { $__cam = ""; } $__cam .= $__can . ""; return $__cam; } sub TOOLTIP { my($__cas, $__cat, $__cau, $__cav) = @_; my $__car = ""; $__car .= "" . $__cas . ""; $__car .= "{"num_data_tables"}; my $__cbb = 0; my $__cbc = ""; my $__cbd = 0; my $__cbe = 0; my $__cbf = ""; my $__cbg = ""; my $__cbh = 0; my $__cbi = ""; my %__cbj = (); my @__cbk = (); my $__cbl = 0; for ($__cbb = 1; $__cbb <= $__cba; $__cbb++) { ($__cbc, $__cbd, $__cbe, $__cbf, $__cbg) = authlib8_4_8::_bmx($authlib8_4_8::_bzb . "_data" . $__cbb); eval { $__cbl = $authlib8_4_8::_byw->selectall_arrayref(authlib8_4_8::_bmy($__cbc, 0)); }; if ($@) { authlib8_4_8::_bqa(212, "Database error.", "Database error. Cannot get table description.", $@); } $__cbc = "SELECT * FROM `" . $authlib8_4_8::_bzb . "_data" . $__cbb . "` WHERE `sys_RespNum` = " . $__cax; $__cbh = 0; $__cbi = ""; eval { $__cbh = $authlib8_4_8::_byw->selectrow_arrayref(authlib8_4_8::_bmy($__cbc, 0)); }; if ($@ || $__cbh == 0) { authlib8_4_8::_bqa(268, "Database error.", "Database error. Cannot get data for DEBUG.", $@); } else { my $__cbm = 0; foreach my $__cbn (@{$__cbl}) { $__cbi = $__cbn->[$__cbd]; if ($__cbh->[$__cbm]) { $__cbj{$__cbi} = $__cbh->[$__cbm]; push @__cbk, $__cbi; } $__cbm++; } } } $__caw .= "