src/Modules/UserInfo.pl

   1 #
   2 # UserInfo.pl: User Information Services
   3 #      Author: dms
   4 #     Version: v0.1 (20000509).
   5 #     Created: 20000509
   6 #        NOTE: Idea from Flugh. Originally written in tcl for eggdrop by
   7 #               unknown.
   8 #
   9
  10 use strict;
  11
  12 my $orderOfInfo = 'RN,J,C,W,D';
  13 my %infoDesc = (
  14         'RN'    => 'Real Name',
  15         'J'     => 'Occupation',
  16         'C'     => 'Contact',
  17         'W'     => 'URL',
  18         'D'     => 'Description',
  19 );
  20
  21 sub UserInfo2Hash {
  22     my ($text) = @_;
  23     my %hash;
  24
  25     foreach (split /\|/, $text) {
  26         if (/^\s*(\S+):\s*(.*)\s*$/) {
  27             $hash{$1} = $2;
  28         }
  29     }
  30
  31     return %hash;
  32 }
  33
  34 sub Hash2UserInfo {
  35     my (%hash) = @_;
  36     my @array;
  37
  38     foreach (sort keys %hash) {
  39         push(@array, "$_: $hash{$_}");
  40     }
  41
  42     join('|', @array);
  43 }
  44
  45 ###
  46 ###
  47 ###
  48
  49 sub UserInfoGet {
  50     my ($query) = @_;
  51     $query =~ s/^\s+|\s+$//g if (defined $query);
  52
  53     if (!defined $query or $query =~ /^$/) {
  54         &help('userinfo');
  55         return;
  56     }
  57
  58     if ($query !~ /^$mask{nick}$/) {
  59         &msg($who, "Invalid query of '$query'.");
  60         return;
  61     }
  62
  63     my $result;
  64     if ($result = &getFactoid($query.' info')) {
  65         # good.
  66     } else { # bad.
  67         &performReply("No User Information on \002$query\002");
  68         return;
  69     }
  70
  71     if ($result !~ /\|/) {
  72         &msg($who, "Invalid User Information for '$query'.");
  73         return;
  74     }
  75
  76     my %userInfo = &UserInfo2Hash($result);
  77
  78     my @reply;
  79     foreach (split ',', $orderOfInfo) {
  80         next unless (exists $userInfo{$_});
  81         push(@reply, "$infoDesc{$_}: $userInfo{$_}");
  82     }
  83
  84     &performStrictReply("User Information on $userInfo{'N'} -- ".
  85         join(', ', @reply));
  86 }
  87
  88 sub UserInfoSet {
  89     my($type, $what) = @_;
  90     my %userInfo;
  91     my $info;
  92
  93     if (&IsLocked("$who info")) {
  94         &DEBUG("UIS: IsLocked('$who info') == 1.");
  95         return;
  96     }
  97
  98     my $new = 0;
  99     if (my $result = &getFactoid("$who info")) {
 100         %userInfo = &UserInfo2Hash($result);
 101     } else {
 102         &DEBUG("UIS: new = 1!");
 103         $userInfo{'N'} = $who;
 104         $new = 1;
 105     }
 106
 107     ### TODO: hash for %infoS2L.
 108     if ($type =~ /^(RN|real\s*name)$/i) {
 109         $info = 'RN';
 110     } elsif ($type =~ /^(J|job|occupation|school|life)$/i) {
 111         $info = 'J';
 112     } elsif ($type =~ /^(C|contact|email|phone)$/i) {
 113         $info = 'C';
 114     } elsif ($type =~ /^(W|www|url|web\s*page|home\s*page)$/i) {
 115         $info = 'W';
 116     } elsif ($type =~ /^(D|desc\S+)$/i) {
 117         $info = 'D';
 118     } elsif ($type =~ /^(O|opt\S+)$/i) {
 119         $info = 'O';
 120     } else {
 121         &msg($who, "Unknown type '$type'.");
 122         return;
 123     }
 124
 125     if (!defined $what) {       # !defined.
 126         if (exists $userInfo{$info}) {
 127             &msg($who, "Current \002$infoDesc{$info}\002 is: '$userInfo{$info}'.");
 128         } else {
 129             &msg($who, "No current \002$infoDesc{$info}\002.");
 130         }
 131
 132         my @remain;
 133         foreach (split ',', $orderOfInfo) {
 134             next if (exists $userInfo{$_});
 135             push(@remain, $infoDesc{$_});
 136         }
 137         if (scalar @remain) {
 138             ### TODO: show short-cut (identifier) aswell.
 139             &msg($who, "Remaining slots to fill: ".join(' ', @remain));
 140         } else {
 141 ###         &msg($who, "Personal Information completely filled. Good.");
 142         }
 143
 144         return;
 145     } elsif ($what =~ /^$/) {   # defined but NULL. UNSET
 146         if (exists $userInfo{$info}) {
 147             &msg($who, "Unsetting \002$infoDesc{$info}\002 ($userInfo{$info}).");
 148             delete $userInfo{$info};
 149         } else {
 150             &msg($who, "\002$infoDesc{$info}\002 is already empty!");
 151             return;
 152         }
 153     } else {                    # defined.
 154         if (exists $userInfo{$info}) {
 155             &msg($who, "\002$infoDesc{$info}\002 was '$userInfo{$info}'.");
 156             &msg($who, "Now is: '$what'.");
 157         } else {
 158             &msg($who, "\002$infoDesc{$info}\002 is now '$what'.");
 159         }
 160         $userInfo{$info} = $what;
 161     }
 162
 163     &setFactInfo($who.' info', 'factoid_value', &Hash2UserInfo(%userInfo));
 164     if ($new) {
 165         &DEBUG("UIS: locking '$who info'.");
 166         &DEBUG("UIS: nuh => '$nuh'.");
 167         &setFactInfo("$who info", "locked_by", $nuh);
 168         &setFactInfo("$who info", "locked_time", time());
 169     }
 170 }
 171
 172 1;