#!/usr/bin/perl ############################################## ## ## ## PROFILE MANAGER PREMIUM 2.1 ## ## Build 2004-02-28 ## ## ## ## Aytekin Tank ## ## email: aytekin@interlogy.com ## ## http://www.interlogy.com/products/pmpre ## ## ## ## Copyright 1999-2004 Aytekin Tank. ## ## ## ############################################## ############################### # find the root if this is IIS: ############################### if($ENV{'SERVER_SOFTWARE'} =~ m/IIS/) { if($root eq "" && $ENV{'PATH_TRANSLATED'} ne "") { my $pt = $ENV{'PATH_TRANSLATED'}; my @pts = split(/\\/, $pt); $pts[-1] = ""; $root = join "/", @pts; $OS = "NT"; } } require "${root}lib/pm.lib"; require "${root}lib/admin.lib"; require "${root}lib/payment.lib"; require "${root}data/config/pmpre.cfg"; $strip_html = "no"; $iamadmin = 1; $no_strip_pipe = 1; &readit; if($input{'adminpass'} ne ""){ $input{'pass'} = pm_encode($input{'adminpass'}); } if($input{'pass'} eq ""){ $input{'pass'} = $req->cookie("pmadm"); } if($input{'action'} eq "admin_menu"){ my $packed_cookie = $req->cookie( -NAME => "pmadm", -VALUE => $input{'pass'}, -EXPIRES => "+7d", -PATH => "/" ); print $req->header(-COOKIE => $packed_cookie); $header_set = 1; }elsif($input{'action'} eq "logout"){ my $packed_cookie = $req->cookie( -NAME => "pmadm", -VALUE => "byebye", -EXPIRES => "-1h", -PATH => "/" ); print $req->header(-COOKIE => $packed_cookie); $header_set = 1; $input{'action'} = "admin_logout"; &tempwiz; exit; }else{ print "Content-type: text/html\n\n"; } if(&admin_pass_check ne "yes") { if($input{'pass'} ne ""){ print "
You can reset your password by deleting admin.pass file manually
"; } $input{'action'} = "admin"; &tempwiz; exit; } else { $admin_checked=1; } #tempwiz('adminheader'); if( $input{'action'} eq "users" ) { &users; } elsif( $input{'action'} eq "message" ) { $input{'from'} = $admin; &tempwiz; } elsif( $input{'action'} eq "messanger" ) { &messanger($database); } elsif( $input{'action'} eq "deleted_user" ) { &remove_row; $input{'action'}="users"; &users; } elsif( $input{'action'} eq "backup" ) { &backup_list; &tempwiz("backup"); &admin_end; } elsif( $input{'action'} eq "backedup" ) { &backup; &backup_list; $input{'action'}="backup"; &tempwiz; &admin_end; } elsif( $input{'action'} eq "retrieve" ) { &retrieve; &backup_list; $input{'action'}="backup"; &tempwiz; &admin_end; } elsif( $input{'action'} eq "export" ){ &export; &tempwiz; &admin_end; } elsif( $input{'action'} eq "exported" ){ &exported; &tempwiz; &admin_end; } elsif( $input{'action'} eq "mass_add" ){ $values{'list fields'} = join(", ", @base)."\n"; $values{'list required fields'} = join("|", @not_null); &tempwiz; &admin_end; } elsif( $input{'action'} eq "mass_added" ){ &mass_added; &tempwiz; &admin_end; } elsif( $input{'action'} eq "support" ){ &fetch_support; &tempwiz; &admin_end; } elsif( $input{'action'} eq "forum" ){ &fetch_forum; &tempwiz; &admin_end; } elsif( $input{'action'} eq "latest_versions" ){ &fetch_latest_versions; &tempwiz; &admin_end; } elsif( $input{'action'} eq "change_pass" ) { &tempwiz; &admin_end; } elsif( $input{'action'} eq "changed_pass" ) { &admin_pass_change; $input{'action'}="admin_menu"; $input{'pass'} = pm_encode($input{'pass1'}); $values{'pass'} = $input{'pass'}; &tempwiz; &admin_end; } elsif( $input{'action'} eq "approval") { &approval; &tempwiz; &admin_end; } elsif( $input{'action'} eq "massedit") { &tempwiz; &admin_end; } elsif( $input{'action'} eq "massedited") { &massedited; &tempwiz; &admin_end; } elsif( $input{'action'} eq "edittemp") { &edittemp; &tempwiz; &admin_end; } elsif( $input{'action'} eq "stats" ) { &show_stats; &tempwiz; &admin_end; } elsif( $input{'action'} eq "tracking" ) { &show_tracking; &tempwiz; &admin_end; } elsif( $input{'action'} eq "env" ) { &show_env; &tempwiz; &admin_end; } elsif( $input{'action'} eq "search_stats" ) { &show_search_stats; &tempwiz; &admin_end; } elsif( $input{'action'} eq "paymentlog" ) { &show_paymentlog; &tempwiz; &admin_end; } elsif( $input{'action'} eq "paymentexpiring" ) { &show_paymentexpiring; &tempwiz; &admin_end; } elsif( $input{'action'} eq "subscriptions" ) { &show_subscriptions; &tempwiz; &admin_end; } elsif( $input{'action'} eq "subscription_manage" ) { &subscription_manage; &tempwiz; &admin_end; } elsif( $input{'action'} eq "subscription_add" ) { &subscription_add; &tempwiz("subscription_manage"); &admin_end; } elsif( $input{'action'} eq "subscription_modify" ) { &subscription_modify; &tempwiz("subscription_manage"); &admin_end; } elsif( $input{'action'} eq "subscription_delete" ) { &subscription_delete; &tempwiz("subscription_manage"); &admin_end; } elsif( $input{'action'} eq "paymentreports" ) { &paymentreports; &tempwiz; &admin_end; } else { $input{'action'} = "admin_menu"; &tempwiz; &admin_end; } &admin_end; sub errdie{ ($em) = @_; print "Terminating Error: $em"; exit; } sub admin_end{ #tempwiz('adminfooter'); exit; } sub fetch_support { my $text = ""; my $name = ""; if($input{'text'} ne ""){ $text = "Just Reporting: Documentation+of+$input{'text'}+variable+is+not+clear."; } if($ENV{'HTTP_HOST'} ne "" && $ENV{'HTTP_HOST'} ne "localhost"){ $name = "$ENV{'HTTP_HOST'}"; } #- fetch support form from interlogy site: eval("use LWP::Simple"); eval("\$input{'out'} = get(\"http://www.interlogy.com/about/pmpre_support.html?text=$text&email=$from&name=$name\") "); } sub fetch_forum { #- fetch support forum list from interlogy site: eval("use LWP::Simple"); eval("\$input{'out'} = get(\"http://www.interlogy.com/support/pmpre/board/latest_bare.php\")"); } sub fetch_latest_versions { #- fetch support forum list from interlogy site: eval("use LWP::Simple"); eval("\$input{'out'} = get(\"http://www.interlogy.com/products/pmpre/latest_bare.html\")"); } sub exported { my $allrows = 1; my @fields = (); my @checks = (); #- find out what the form says foreach (keys %input){ my $v = $input{$_}; if(m/only(\d)_field/){ if($v ne ""){ my $t = "only$1_text"; $checks{$v} = $input{$t}; $allrows = 0; } }elsif(m/field_(.*)/){ push(@fields, $1); } } #- fix the order my @temp = (); foreach my $b( @base ){ foreach my $f( @fields ){ if($b eq $f){ push(@temp, $b); } } } @fields = @temp; #- think about the first line my $out = ""; if($input{'firstline_names'} eq "yes"){ $out .= join($input{'delimiter'}, @fields); $out .= "\n"; } #- create the export list open (DATABASE, "<${root}$database"); while(my $line = ) { my $ok = 1; my $i = 0; my @results = (); init($line); my $d = $input{'delimiter'}; foreach(keys %values){ $values{$_} =~ s/\Q$d\E/ /g; } if($allrows){ foreach(@fields){ $results[$i++] = $values{$_}; } }else{ foreach my $c(keys %checks){ if($values{$c} ne $checks{$c}){ $ok = 0; } } if($ok){ foreach(@fields){ $results[$i++] = $values{$_}; } } } if( $ok ){ my $newline = join($input{'delimiter'}, @results); if($input{'remove_duplicates'} eq "yes"){ foreach( split("\n", $out) ){ $ok = 0 if($_ eq $newline); } } if( $ok ){ $out .= "$newline\n"; } } } close DATABASE; if($out eq ""){ $input{'export_list'} = "Sorry, no results found!"; }else{ $input{'export_list'} = $out; } } sub export { my $size = int((@base)/2); my $i = 0; $input{'base_checkbox'} = "\n\n
"; $input{'base_dropdown'} = ""; foreach(@base){ $input{'base_dropdown'} .= ""; $input{'base_checkbox'} .= "\n\n" if($size == $i++); $input{'base_checkbox'} .= " $_
"; } $input{'base_checkbox'} .= "\n\n
"; } sub mass_added{ #- check for the unwanted windows character: $input{'data'} =~ s/\r/\n/g; $input{'data'} =~ s/\n\n/\n/g; my($fields, @rows) = split("\n", $input{'data'}); $input{'data'} = ""; #- free the memory $d = $input{'delimeter'}; $d = "|" if($d eq ""); $d =~ s/(\W)/\\$1/g; my(@fields) = split(/$d/, $fields); #print "$fields
"; #print "@rows"; #- check the first line #- it should include required fields my $fc = 0; foreach $f(@fields){ if($f eq "login"){ $login_field = $fc; } elsif($f eq "ID"){ $ID_field = $fc; } elsif($f eq "email"){ $email_field = $fc; } elsif($f eq "register_date"){ $register_date_field = $fc; } elsif($f eq "update_date"){ $update_date_field = $fc; } elsif($f eq "sortable_register_date"){ $sortable_register_date_field = $fc; } elsif($f eq "sortable_update_date"){ $sortable_update_date_field = $fc; } foreach $nn(@not_null){ if($nn eq $f){ $foundnn{$nn} = $fc; } } $fc++; } if($ID_field<1){ $fields[$fc] = "ID"; $ID_field = $fc++; } if($email_field<1){ $fields[$fc] = "email"; $email_field = $fc++; } if($register_date_field<1){ $fields[$fc] = "register_date"; $register_date_field = $fc++; } if($update_date_field<1){ $fields[$fc] = "update_date"; $update_date_field = $fc++; } if($sortable_register_date_field<1){ $fields[$fc] = "sortable_register_date"; $sortable_register_date_field = $fc++; } if($sortable_update_date_field<1){ $fields[$fc] = "sortable_update_date"; $sortable_update_date_field = $fc++; } foreach(@not_null){ if($foundnn{$_} eq ""){ $problem_fatal .= "
$_ is a required field and it is missing" unless($_ eq "ID" || $_ eq "password"); } } #- check the login field format &get_existing_logins; foreach(@rows){ #- todo: changed brakes back to normal #my(@ea) = split(/\|/, $_); my(@ea) = split(/$d/, $_); my $login = $ea[$login_field]; if ($login =~ /[^A-Za-z0-9]/) { $rejected{$login} = "Login field should only include alphanumeric chracters!"; next; } #- check the login if already exists if($existing_logins{$login} == 1){ $rejected{$login} = "Login already exists in the database!"; next; }elsif($existing_logins{$login} == 2){ $rejected{$login} = "Duplicate entry!"; next; }else{ $existing_logins{$login} = 2; } #- check required fields my $r = 0; foreach(keys %foundnn){ my $fc = $foundnn{$_}; if($ea[$fc] eq "" || $ea[$fc] eq " "){ $rejected{$login} .= "Required field $_ is missing! "; $r = 1; } } if($r){ next; } #- check the email field format if( $check_email eq "yes") { if($email_field ne ""){ if(!($ea[$email_field] =~ m/^([\w\-\.\!\%\+]+\@[a-zA-Z0-9\-]+(\.[a-zA-Z0-9\-]+)*\.[a-zA-Z0-9\-]+)$/)){ $rejected{$login} = "Email format is not correct! ($ea[$email_field])"; next; } } } #- create the dates and IDs &time_n_ID; if($ea[$register_date_field] eq ""){ $ea[$register_date_field] = $today; } if($ea[$update_date_field] eq ""){ $ea[$update_date_field] = $today; } if($ea[$sortable_register_date_field] eq ""){ $ea[$sortable_register_date_field] = $sortabledate; } if($ea[$sortable_update_date_field] eq ""){ $ea[$sortable_update_date_field] = $sortabledate; } if($ea[$ID_field] < 10){ $ea[$ID_field]=$ID; } #for($i=0; $i<@ea; $i++){ # print "($i=$fields[$i]=$ea[$i])"; #} my %fea; for($i=0; $i<@fields; $i++){ $fea{$fields[$i]} = $ea[$i]; } my @bfea; foreach(@base){ if($fea{$_} eq ""){ $fea{$_} = " "; } push(@bfea, $fea{$_}); } $accepted .= join("|", @bfea)."\n"; } #- put accested lines and other warnings into variables $input{'rejected'} = " "; foreach(keys %rejected){ $input{'rejected'} = "
  • Rejected $_: $rejected{$_}"; } #- if complete, give a success page if($input{'submit'} eq "Complete" && $problem_fatal eq ""){ $input{'out'} = "The new users have been successfully added to the database!"; open (DATABASE, ">>${root}$database"); print DATABASE ${accepted}; close(DATABASE); return; } #- add to accepted lines $input{'out'} = "


    "; if($problem_fatal eq ""){ $input{'out'} .= "\n "; }else{ $input{'out'} .= "\n Fatal problem!$problem_fatal"; } } sub get_existing_logins{ open (DATABASE, "<${root}$database"); while() { if (m/^(.*?)\|/){ $existing_logins{$1} = 1; } } close DATABASE; } sub show_env{ my $type = "Apache"; if($ENV{'SERVER_SOFTWARE'} =~ m/IIS/){ $type = "Windows IIS"; } $values{'env'} = "\n\n

    Server Environment Variables:

    \n"; $values{'env'} .= "\n\n\n"; $values{'env'} .= "\n\n\n"; $values{'env'} .= "\n\n"; $values{'env'} .= "\n\n"; $values{'env'} .= "\n\n"; foreach (keys %ENV){ $values{'env'} .= "\n\n"; my $envline = $ENV{$_}; $envline =~ s/\,/\, /g; $values{'env'} .= "\n"; $values{'env'} .= "\n\n"; } $values{'env'} .= "\n\n
    Server Type:$type
    Sendmail Locations:\n"; $values{'env'} .= `whereis sendmail`; $values{'env'} .= "\n\n
    Default Sendmail Location:\n"; $values{'env'} .= `which sendmail`; $values{'env'} .= "\n\n
    Image::Magick Installed?\n"; eval("use Image::Magick"); if ($@) { $values{'env'} .= "no"; } else { $values{'env'} .= "yes"; } $values{'env'} .= "\n\n

    Environment Variables:
    \n"; $values{'env'} .= "\n\n
    $_: $envline
    \n"; } sub approval{ if($input{'waiting'} ne ""){ #- open(H, "<${root}$content_pass_file") or errdie "Cannot open htpassword file: $!\n"; @lines = ; close H; my $encrypted = crypt($input{$input{'waiting'}}, $encrypt_addon); push(@lines, "$input{'waiting'}:$encrypted\n"); open(H, ">${root}$content_pass_file") or errdie "Cannot open htpassword file: : $!"; print H @lines; close H; #- approved email if($input{'send_email'} eq "yes" && $send_confirmation eq "yes"){ open (DATABASE, "<${root}$database"); while ($thisrow = ){ if ($thisrow =~ m/^$input{'waiting'}\|(.*)/){ &init($thisrow); } } close DATABASE; print "

    sending email to $values{'email'}...
    "; &confirm_approval; } elsif($input{'send_email'} eq "yes" && $send_confirmation ne "yes"){ print "not sending email, because send_confirmation is disabled in pmpre configuration"; } } if($input{'approved'} ne ""){ #- open(H, "<${root}$content_pass_file") or errdie "Cannot open htpassword file: $!\n"; @lines = ; close H; foreach(@lines){ if(!(m/^$input{'approved'}:/i)){ push(@newlines, $_); } } open(H, ">${root}$content_pass_file") or errdie "Cannot open htpassword file: $!\n"; print H @newlines; close H; } #- open .htpassword and get all logins open(H, "<${root}$content_pass_file") or errdie "Cannot open htpassword file: $!"; while(my $l = ){ my ($lo) = split(/\:/, $l); $hlogins .= "|${lo}|"; } close(H); #- open database and get all logins open(D, "<${root}$database") or errdie "Cannot open database: $!"; my @dlines = ; close(D); #- find the ones that don't exist in the htpass foreach(@dlines){ if($htaccess_use_id eq "no"){ ($lgn, $dump, $didtemp) = split(/\|/, $_); } else { ($lgn, $didtemp) = split(/\|/, $_); } #$lgn = lc($lgn); $did{$lgn} = $didtemp; if($hlogins =~ m/\|${lgn}\|/){ push(@approved, $lgn); }else{ push(@waiting, $lgn); } } #- sort them @approved = sort @approved; @waiting = sort @waiting; #- list them $values{'awaiting'} .= "\n"; $values{'awaiting'} .= "\n"; $values{'awaiting'} .= "\n"; $values{'awaiting'} .= "\n"; $values{'awaiting'} .= ""; $values{'awaiting'} .= "
    "; $values{'awaiting'} .= ""; $values{'awaiting'} .= ""; $values{'awaiting'} .= ">\">

    "; $values{'awaiting'} .= ""; $values{'awaiting'} .= "
    "; $values{'awaiting'} .= "
    "; foreach(@waiting){ $values{'awaiting'} .= "\n"; } $values{'awaiting'} .= "\n Send email to approved members
    "; $values{'awaiting'} .= "\n"; } { my $cf = $input{'changefrom'}; my $ct = $input{'changeto'}; my $no_of_tempz = keys %tempz; my $tout = "$no_of_tempz files are scanned..."; foreach my $tn(keys %tempz){ my $tf = $tempz{$tn}; if( open(TEMPR, "<${root}$tf") ) { my @arrtempfile = ; #my $tempfile = join("", @arrtempfile); close TEMPR; my @newarrtempfile = (); foreach my $line(@arrtempfile){ if($line =~ m/\Q${cf}/){ $modifiedfiles{$tn} = $tf; $line =~ s/\Q${cf}/${ct}/g; } push(@newarrtempfile, $line); } open(TEMPW, ">${root}$tf") or print "Cannot open ${root}$tf for writing: $!\n
    "; print TEMPW @newarrtempfile; close TEMPW; #open(TEMPW, ">/tmp/temp/$tn") or print $!; #print TEMPW @newarrtempfile; #close TEMPW; #print "\ndiff /tmp/temp/$tn $tf"; #print `diff /tmp/temp/$tn $tf`; #print "\n"; } else { print "Cannot open ${root}$tf for reading: $!\n
    "; } } $no_of_modifiedfiles = keys %modifiedfiles; if( $no_of_modifiedfiles < 1){ $tout .= "
    String not found on any of the files."; }else{ $tout .= "
    String has been replaced on $no_of_modifiedfiles files:
      "; foreach(keys %modifiedfiles){ $tout .= "\n
    • $_ ($modifiedfiles{$_})"; } $tout .= "
    \n\n"; } $input{'output'} = $tout; } sub edittemp { my $tout; if($input{'file'} ne ""){ $tp = $tempz{$input{'file'}}; if($tp ne "" && $input{'text'} ne "") { open(T, ">${root}$tp") or print "${root}$tp: $! (did you set the template files as writable?)

    \n"; print T $input{'text'}; close T; $tout .= "

    "; } } $tout .= "\n\n\n
    "; # create a drop down list from tempz array #- get addon folder list #- get profile folder list #- get member folder list #- get search folder list foreach(keys %tempz){ my $t = $tempz{$_}; if($t =~ m/templates\/addon/){ push(@t_addon, $_); }elsif($t =~ m/templates\/common/){ push(@t_common, $_); }elsif($t =~ m/templates\/member/){ push(@t_member, $_); }elsif($t =~ m/templates\/profile/){ push(@t_profile, $_); }elsif($t =~ m/templates\/search/){ push(@t_search, $_); }elsif($t =~ m/templates\/admin/){ push(@t_admin, $_); }elsif($t =~ m/templates\/blog/){ push(@t_blog, $_); }else{ push(@t_other, $_); } } $tout .= ""; $tout .= ""; $tout .= "\n\n"; $tout .= ""; $tout .= "
    "; # create a form for each edit=profile type if($input{'nexttemp'} ne ""){ $tp = $tempz{$input{'nexttemp'}}; if($tp ne "") { open(T, "<${root}$tp") or die "${root}$tp: $!"; @l = ; close T; $template = join("", @l); $template =~ s/\<\/textarea\>/\<\/textarea\>/ig; $template =~ s/\r\n/\n/g; $template =~ s/\ /\&\;nbsp/g; $tout .= "
    "; $tout .= ""; $tout .= ""; $tout .= ""; $tout .= ""; $tout .= ""; $tout .= "
    "; $tout .= ""; $tout .= ""; $tout .= ""; $tout .= ""; $tout .= "
    "; $tout .= ""; } } $input{'action'} = "tempedit"; $values{'output'} = $tout; } sub massedited { my $cf = $input{'changefrom'}; my $ct = $input{'changeto'}; my $no_of_tempz = keys %tempz; my $tout = "$no_of_tempz files are scanned..."; foreach my $tn(keys %tempz){ my $tf = $tempz{$tn}; if( open(TEMPR, "<${root}$tf") ) { my @arrtempfile = ; #my $tempfile = join("", @arrtempfile); close TEMPR; my @newarrtempfile = (); foreach my $line(@arrtempfile){ if($line =~ m/\Q${cf}/){ $modifiedfiles{$tn} = $tf; $line =~ s/\Q${cf}/${ct}/g; } push(@newarrtempfile, $line); } open(TEMPW, ">${root}$tf") or print "Cannot open ${root}$tf for writing: $!\n
    "; print TEMPW @newarrtempfile; close TEMPW; #open(TEMPW, ">/tmp/temp/$tn") or print $!; #print TEMPW @newarrtempfile; #close TEMPW; #print "\ndiff /tmp/temp/$tn $tf"; #print `diff /tmp/temp/$tn $tf`; #print "\n"; } else { print "Cannot open ${root}$tf for reading: $!\n
    "; } } $no_of_modifiedfiles = keys %modifiedfiles; if( $no_of_modifiedfiles < 1){ $tout .= "
    String not found on any of the files.\n"; }else{ $tout .= "
    String has been replaced on $no_of_modifiedfiles files:

      "; foreach(keys %modifiedfiles){ $tout .= "\n
    • $_ ($modifiedfiles{$_})"; } $tout .= "
    \n\n"; } $input{'output'} = $tout; } sub backup { &get_time; my @rowz; open (DATABASE, "<${root}$database"); while (($line = )) { push (@rowz, $line); } close DATABASE; open (DATABASE, ">${root}$backup_folder/$timeno.dat"); print DATABASE @rowz; close DATABASE; } sub retrieve { my @rowz; if($input{'file'} eq ""){ &err("no file is selected for backup");exit;} open (DATABASE, "<${root}$backup_folder/$input{'file'}"); while (($line = )) { push (@rowz, $line); } close DATABASE; open (DATABASE, ">${root}$database"); foreach $rowz(@rowz) {print DATABASE $rowz}; close DATABASE; } sub backup_list { opendir(FOLDER, "${root}$backup_folder"); @files = readdir(FOLDER); closedir FOLDER; $values{'backup list'} .= "\n"; } sub users { $admin_link = 1; if($input{'sortby'} eq ""){ $list_alphabetic = "no"; } $input{'sortby'} = "sortable_register_date"; $input{'reverse'} = "yes"; $tempz{'list_table'} = $tempz{'admin_list_table'}; $tempz{'list_table_next'} = $tempz{'admin_list_table'}; if($input{'catvalue'} eq ""){ $input{'catvalue'} = "all"; } &list; $values{'pass'} = $input{'pass'}; &tempwiz; } exit; sub env { print "
    "; print join("\n
    ", keys %ENV); print "
    "; print join("\n
    ", values %ENV); print "
    "; } &check_secure; if ($input{'action'} eq "menu") {&menu;} elsif ($input{'action'} eq "list") {&admin_list;} elsif ($input{'action'} eq "message_central") {&message_central;} elsif ($input{'action'} eq "statistics") {&statistics;} else {&admin_login;} sub menu { print qq~

    Membership Administration

  • List: Gives the listing of all members

  • Message Central:

  • Board Admin:

  • Statistics:

  • Archive:
    archive no: this is the text used in the archive file name. You can use it as week number. Caution: if you give a number, which is already exist, it will overwrite it!

    arhchive no:
    link text:

  • Delete: This will remove the account permanently!

  • Login Name:

  • Membership Approval: These entries are waiting for your approval.

  • $ourapprovel_html

     

    ~; } sub statistics{ print "

    STATISTICS


    "; open(STATISTICS, "<${root}$statistics_file"); while (( $stats = )) { print "$stats\n"; } close STATISTICS; exit; } sub message_central{ open (FILE, "<${root}$message_central_file") or die " can not open $approve_file!"; while (($ourfile = )) { print "$ourfile\n"; } close FILE; exit; } sub last_visitors { @statz = reverse(@statz); #last 20 $recent = $input{'number'}; $stats_html = ""; $stats_html .= "\n"; $stats_html .= "\n\t"; $stats_html .= "\n\t"; $stats_html .="\n\t"; $stats_html .= "\n\t"; $stats_html .= "\n\t"; $stats_html .= "\n"; if($input{'next'}<1){ $input{'next'} = 0; } for($i = $input{'next'}; $i<$input{'next'}+$recent && $i<$values{'total logins'}; $i++) { @fieldz = split(/\|/, $statz[$i]); $stats_html .= "\n\n"; $stats_html .= ""; #print ""; $stats_html .= "\n\t"; if($fieldz[5] eq "") { $stats_html .= "\n\t"; } else { $stats_html .= "\n\t"; } $stats_html .= "\n\t"; $stats_html .= "\n\t"; $stats_html .= "\n\n"; } $stats_html .= "
     Time   Login      IP   Browser     O/S   
     $fieldz[3] $fieldz[1] "; $stats_html .= "$fieldz[2]   $fieldz[4]  $fieldz[5]   $fieldz[6]  $fieldz[7]
    \n"; $input{'next'} += $i; if($i<$values{'total logins'}){ $stats_html .= "
    next
    "; } } sub show_search_stats { if($input{'number'}<1){ $input{'number'} = 0; } open (STAT, "<${root}$h_search"); while (($line = )) { push (@statz, $line); } close STAT; @statz = reverse(@statz); $values{'total searches'} = @statz; if($values{'total searches'} > 10000){ print "

    Warning: Delete(reset) $h_search file if this page gets very slow!

    "; } $where_next = 0; $stats_html .= ""; for($i=$input{'number'}; $i<$input{'number'}+20; $i++){ $where_next++; $fcolor = ($where_next%2)?"navy":"teal"; if($statz[$i] ne ""){ my($IP, $query) = split(/\|/, $statz[$i]); $query_readable = join("
    ", split(/\&/, $query)); $stats_html .= ""; } } $stats_html .= "
    IP Query
    $IP $query_readable

    Back "; if($input{'number'}+20<$values{'total searches'}){ $where_next = $input{'number'}+20; $stats_html .= "- Next"; } $values{'stats'} = $stats_html; } sub show_stats { if($input{'number'}<1){ $input{'number'} = 20; } open (STAT, "<${root}$stat_file"); while (($line = )) { push (@statz, $line); } close STAT; $values{'total logins'} = @statz; if($values{'total logins'} > 10000){ print "

    Warning: Delete stats.dat file if this page gets very slow!

    "; } &last_visitors; ($sec, $min, $hr, $today, $thismonth, $ye, $wd, $yd, $ds) = localtime(); my $day=$yd; my $win; my $exp; for(my $i=0; ($i<@statz)&&($yd-$day<20); $i++) { @statdetail = split(/\|/, $statz[$i]); @digits = split(//, $statdetail[0]); $day = 100*$digits[13]+10*$digits[14]+$digits[15]-100; @daycount[$day]++; if($statdetail[6] eq "Explorer") { $exp++; } if($statdetail[7] =~ m/Win/i) { $win++; } #print "$day -> $daycount[$day] -> $win -> $exp\n"; } $values{'stats'} = $stats_html; } sub show_tracking { my $perpage = 20; my $start = 0; if($input{'next'}>0){ $start = $input{'next'}; $input{'next'} += $perpage; } my $nolines = 0; my $end = $start + $perpage; #- get the number of line on the file open (TRACK, "<${root}$track_file"); $nolines++ while(); close TRACK; if($nolines > 10000){ print "

    Warning: Delete or trim track.dat file if this page gets very slow!

    "; } $reverse_start = $nolines - $start; $reverse_end = $nolines - $end; my $count = 0; open (TRACK, "<${root}$track_file"); while (($line = )) { if($count<$reverse_start && $count>=$reverse_end){ push (@trackz, $line); } $count++; } close TRACK; my $track_html = ""; if($track_user ne "yes"){ $track_html .= "

    Currently disabled. Enable this feature.

    "; } $track_html .= ""; $track_html .= "\n"; $track_html .="\n\t"; $track_html .= "\n\t"; $track_html .= "\n\t"; $track_html .= "\n"; foreach(reverse @trackz){ my($l, $a, $t) = split /\|/; $track_html .= "\n"; $track_html .="\n\t"; $track_html .= "\n\t"; $track_html .= "\n\t"; $track_html .= "\n"; } $track_html .= ""; $track_html .= "
    Time Login Action
    $t $l $a
    back "; $track_html .= "next" if($reverse_end > 0); $track_html .= "
    \n"; $values{'tracking'} = $track_html; }