home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / filter31.pl < prev    next >
Text File  |  2009-11-06  |  7KB  |  235 lines
  1. # FILE: filter31.pl
  2. # DESCRIPTION: Read in data from Discus 3.1X for upgrade purposes
  3. #-------------------------------------------------------------------------------
  4. # DISCUS COPYRIGHT NOTICE
  5. #
  6. # Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
  7. # The use of Discus is governed by the Discus License Agreement which is
  8. # available from the Discus WWW site at:
  9. #    http://www.discusware.com/discus/license
  10. #
  11. # Pursuant to the Discus License Agreement, this copyright notice may not be
  12. # removed or altered in any way.
  13. #-------------------------------------------------------------------------------
  14.  
  15. use strict;
  16. use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);
  17.  
  18. ###
  19. ### v31_user_line_as_hash
  20. ###
  21. ### Converts a line of raw input to a useful, easy manipulated hash
  22. ###
  23.  
  24. sub v31_user_line_as_hash {
  25.     my @r = ();
  26.     my @s = ('user', 'pass', 'email', 'fullname', 'edit', 'notify');
  27.     while (my $x = shift @_) {
  28.         my $i = {};
  29.         chomp $x;
  30.         my @x = split(/:/, $x);
  31.         foreach my $s (@s) {
  32.             $i->{$s} = shift @x;
  33.         }
  34.         ($i->{stime}, $i->{atime}) = split(/\//, shift @x);
  35.         $i->{ctime} = 0;
  36.         $i->{groups} = shift @x;
  37.         push (@r, $i);
  38.     }
  39.     return $r[0] if scalar(@r) == 1;
  40.     return \@r;
  41. }
  42.  
  43. ###
  44. ### queue_transform
  45. ###
  46. ### Messages in the queue
  47. ###
  48.  
  49. sub queue_transform {
  50.     my ($self) = @_;
  51.     my $n = {};
  52.     $self->{PAGE} =~ m|^(\d+)/(\d+)|; $n->{topic_number} = $1; $n->{me_number} = $2;
  53.     $n->{text} = $self->{TEXT};
  54.     $n->{author} = $self->{POSTBY};
  55.     $n->{real_author} = join(":", $self->{USERNAME}, $self->{GROUP});
  56.     $n->{username} = $self->{USERNAME};
  57.     $n->{author_status} = (
  58.         $self->{USERNAME} eq $DCONF->{superuser} && $self->{GROUP} eq "MODERATOR" ? 10 : (
  59.         $self->{GROUP} eq "MODERATOR" ? 9 : (
  60.         $self->{USERNAME} eq "PUBLIC" ? 2 : 3)));
  61.     $n->{'time'} = $self->{TIME};
  62.     if ($self->{PROFILE} =~ m|<A HREF="(.*?)">|) {
  63.         $n->{email} = $1;
  64.     } elsif ($self->{EMAIL}) {
  65.         $n->{email} = "mailto:$self->{EMAIL}";
  66.     }
  67.     $n->{subject} = $self->{SUBJECT} if $self->{SUBJECT} ne "";
  68.     $n->{source} = $self->{SOURCE};
  69.     $n->{remote_addr} = $self->{RA};
  70.     $n->{remote_host} = $self->{RH};
  71.     return $n;
  72. }
  73.  
  74. ###
  75. ### enhanced_user_profile_3031
  76. ###
  77. ### Reads an enhanced user profile from 3.0 or 3.1 format
  78. ###
  79.  
  80. sub enhanced_user_profile_3031 {
  81.     my ($filedata, $username, $oldconf) = @_;
  82.     dreq("webtags");
  83.     my @p = grep(/\S/, @{ $filedata }); @p = grep(!/^#/, @p);
  84.     my $flag = 0;
  85.     my $f = {};
  86.     my @in = ();
  87.     my $ctr = 0;
  88.     foreach my $line (@p) {
  89.         chomp $line;
  90.         if ($line =~ m|<INFO>|) {
  91.             $flag = 1;
  92.         } elsif ($line =~ m|</INFO>|) {
  93.             $flag = 0;
  94.         } elsif ($flag == 1 && $line =~ m|^(\w+)=(.*)|) {
  95.             my ($var, $val) = ($1, $2);
  96.             if ($var =~ m|(\w+)_hide|) {
  97.                 $f->{pershide}->{$1} = $val;
  98.             } else {
  99.                 next if $val eq "";
  100.                 my $vl = unescape($val);
  101.                 my ($lint, $message) = webtags($vl, 1, 1);
  102.                 $message = "" if $lint eq "!Error";
  103.                 if (defined $oldconf->{$var} && $oldconf->{$var} < 20) {
  104.                     $in[$oldconf->{$var}] = { var => $var, val => $message };
  105.                 } else {
  106.                     $f->{cust}->{$var}->{val} = $message;
  107.                     $ctr++;
  108.                     $f->{cust}->{$var}->{order} = $ctr;
  109.                 }
  110.             }
  111.         } elsif ($line =~ m|<PICTURE>|) {
  112.             $flag = 2;
  113.         } elsif ($line =~ m|</PICTURE>|) {
  114.             $flag = 0;
  115.         } elsif ($flag == 2 && $line =~ m|^(\w+)=(.*)|) {
  116.             $f->{pict} = unescape($2);
  117.         } elsif ($line =~ m|<CUSTOM>|) {
  118.             $flag = 3;
  119.         } elsif ($line =~ m|</CUSTOM>|) {
  120.             $flag = 0;
  121.         } elsif ($flag == 3 && $line =~ m|^(\w+)=(.*)|) {
  122.             my ($var, $val) = ($1, $2);
  123.             next if $val eq "";
  124.             my $vl = unescape($val);
  125.             my ($lint, $message) = webtags($vl, 1, 1);
  126.             $message = "" if $lint eq "!Error";
  127.             $f->{cust}->{$var}->{var} = $message;
  128.         } elsif ($line =~ m|<PREFS>|) {
  129.             $flag = 4;
  130.         } elsif ($line =~ m|</PREFS>|) {
  131.             $flag = 0;
  132.         } elsif ($flag == 4 && $line =~ m|^(\w+)=(.*)|) {
  133.             $f->{pref}->{$1} = unescape($2);
  134.         }
  135.     }
  136.     my $conv = {cookie => 'a',cookie_temp => 'b',noemail => 'c', skip_preview => 'd',show_all_nm => 'e',nm_view => 'f',nm_newwindow => 'g',last_favs => 'h',spellcheck => 'i'};
  137.     my %h = map { $conv->{$_}, 1 } grep($f->{pref}->{$_} > 0 && $_ ne "favorites", keys %{$f->{pref}});
  138.     my %fav = map { $_, 1 } split(/,/, $f->{pref}->{favorites});
  139.     my @inf = ();
  140.     my @cus = ();
  141.     foreach my $c (@in) {
  142.         if (! defined $f->{cust}->{$c->{var}}) {
  143.             push @inf, { hide => ($f->{pershide}->{$c->{var}} ? 1 : 0), val => unescape($c->{val}) };
  144.         }
  145.     }
  146.     foreach my $k (sort { $f->{cust}->{$a}->{order} <=> $f->{cust}->{$b}->{order} } keys %{ $f->{cust} }) {
  147.         push @cus, { var => $f->{cust}->{$k}->{var}, val => $f->{cust}->{$k}->{val} };        
  148.     }
  149.     my $s = {};
  150.     $s->{username} = $username;
  151.     $s->{picture} = $f->{pict} =~ m|^(\d+)\.(\w+)$| ? $f->{pict} : "";
  152.     $s->{pref} = \%h;
  153.     $s->{favorite} = \%fav;
  154.     $s->{custom} = \@cus;
  155.     $s->{personal} = \@inf;
  156.     return $s;
  157. }
  158.  
  159. ###
  160. ### import_posting_reading_privileges
  161. ###
  162. ### Posting and reading privileges (posting.txt, security.txt, postoptions.txt)
  163. ###
  164.  
  165. sub import_posting_reading_privileges {
  166.     my $p = { p => 'posting.txt', r => 'security.txt' };
  167.     my @u = ('p'); push (@u, 'r') if $DCONF->{pro};
  168.     dreq("fcn-grp");
  169.     my $G = read_group_file();
  170.     my @actions = ();
  171.     foreach my $i (@u) {
  172.         if (-e "$DCONF->{admin_dir}/$p->{$i}") {
  173.             my $file = readfile("$DCONF->{admin_dir}/$p->{$i}", "import_posting_reading_privileges(3.1)", { zero_ok => 1 });
  174.             foreach my $line (@{ $file }) {
  175.                 chomp $line;
  176.                 $line =~ s/~/\*/g;
  177.                 my ($topic, $ip_based, $user_based, $moderator_based, $special) = split(/:/, $line);
  178.                 undef my $u;
  179.                 $u->{action} = "set_equal";
  180.                 $u->{topic} = $topic;
  181.                 $u->{type} = $i;
  182.                 $u->{ip} = $ip_based;
  183.                 $u->{user} = $user_based;
  184.                 if ($moderator_based ne "" && $moderator_based ne "*") {
  185.                     my $mm = {};
  186.                     foreach my $grp (split(/,/, $moderator_based)) {
  187.                         my %h = map { $_, 1 } keys %{$G->{by_grp}->{$grp}};
  188.                         hash_merge($mm, \%h, 1);
  189.                     }
  190.                     $moderator_based = join(",", keys %{$mm});
  191.                 }
  192.                 $u->{moderator} = $moderator_based;
  193.                 $u->{special} = $special;
  194.                 push (@actions, $u);
  195.             }
  196.         }
  197.     }
  198.     if (-e "$DCONF->{admin_dir}/postoptions.txt") {
  199.         my $file = readfile("$DCONF->{admin_dir}/postoptions.txt", "import_posting_reading_privileges(3.1)", { zero_ok => 1 });
  200.         foreach my $line (@{ $file }) {
  201.             chomp $line;
  202.             my ($topic, $anon, $fullname, $email) = split(/:/, $line);
  203.             undef my $u;
  204.             $u->{topic} = $topic;
  205.             $u->{type} = "o";
  206.             $u->{anon} = 0 + $anon;
  207.             $u->{fullname} = 0 + $fullname;
  208.             $u->{email} = 0 + $email;
  209.             $u->{profile} = 0 + $email;
  210.             push (@actions, $u);
  211.         }
  212.     }
  213.     if ($DCONF->{pro}) {
  214.         if (-e "$DCONF->{admin_dir}/queue.txt") {
  215.             my $file = readfile("$DCONF->{admin_dir}/queue.txt", "import_posting_reading_privileges(3.1)", { zero_ok => 1 });
  216.             foreach my $line (@{ $file }) {
  217.                 chomp $line;
  218.                 my ($topic, $users, $moderator, $special, $public) = split(/:/, $line);
  219.                 next if $topic !~ m|\d|;
  220.                 undef my $u;
  221.                 $u->{topic} = $topic;
  222.                 $u->{type} = "q";
  223.                 $u->{users} = 0 + $users;
  224.                 $u->{moderators} = 0 + $moderator;
  225.                 $u->{special} = 0 + $special;
  226.                 $u->{public} = 0 + $public;
  227.                 push (@actions, $u);
  228.             }
  229.         }
  230.     }
  231.     return \@actions;
  232. }
  233.  
  234. 1;
  235.