perl function that closes a dcc tab?

Discussion about Perl, TCL or Python scripts and C/C++ plugins (using and writing them).

perl function that c

Postby brokndodge » 25 Jun 2006 02:52

now that i have fixed the worst bugs in File-Butler for xchat 2.x.x i've decided to extend the script to look a lil more polished. one of the things the script should do is close each dcc chat tab as the connection is closed. When i leave the fserve unattended for a time, there are dozens of tabs open and it takes me some time to figure out which ones are still active.

I would have thought this wouldn't be difficult but after several hours of searching on this forum, i've yet to find the solution.

The script is writtin in perl. If you could just point me in the right direction I can probably figure out the rest.
brokndodge
 
Posts: 15
Joined: 24 Jun 2006 09:06

Postby Khisanth » 25 Jun 2006 03:51

The answer is the same regardless of the language you are using. Just use Xchat::command( "close" ); while in the context of the dcc tab.
Khisanth
 
Posts: 1724
Joined: 10 Jun 2004 05:23

Postby brokndodge » 25 Jun 2006 08:59

could you point me to some documentation on Xchat::command("close");

i tried it as you wrote in, and a few variations from examples of other commands and none of it had the desired effect.

here's the code i'm using:
Code: Select all
elsif ($message=~/^\s*(quit|exit|close)/i) {
   delete $active_users{$nick};
   Xchat::command("msg =$nick Closing file server connection. Good Bye.");
   Xchat::command("dcc close chat $nick");
   Xchat::command("close");
    }


the result is that the tab clears but does not close
brokndodge
 
Posts: 15
Joined: 24 Jun 2006 09:06

Postby Khisanth » 25 Jun 2006 16:06

Code: Select all
use strict;
use warnings;
use Xchat qw(:all);
register( "Auto Close DCC", "1.0" );
hook_print( "DCC Chat Text", \&dcc_chat_text );

sub dcc_chat_text {
   my ($nick, $message) = @{$_[0]}[2,3];
   
   if( $message =~ /^\s*close/i  ) {
      command( "msg =$nick Closing file server connection. Good Bye." );
      command( "dcc close chat $nick" );
      command( "close" );
      return EAT_ALL;
   }
   
}


The return EAT_ALL; is required.
Khisanth
 
Posts: 1724
Joined: 10 Jun 2004 05:23

Postby brokndodge » 25 Jun 2006 19:18

Code: Select all
command("close");
return EAT_ALL;


didn't quite work... it closed the active window.

i tried:
Code: Select all
command("close $nick");
return EAT_ALL;


that did the trick! thx

but i am still looking for a complete reference for Xchat::commands
brokndodge
 
Posts: 15
Joined: 24 Jun 2006 09:06

Postby brokndodge » 25 Jun 2006 20:17

well that worked for a minute... now it's back to closing the focused window.
brokndodge
 
Posts: 15
Joined: 24 Jun 2006 09:06

Postby Khisanth » 25 Jun 2006 20:40

not much to do with Xchat::command, the example is written so it will excute in the context of the dcc tab. If your code doesn't assume the same then it will not work. Not possible to say what your problem is with only incomplete code snippets...
Khisanth
 
Posts: 1724
Joined: 10 Jun 2004 05:23

Postby brokndodge » 25 Jun 2006 21:58

there are four functions that need to close a dcc chat.

dcc_chat() #seems to work correctly
dcc_chat_failed() #not sure if this works right
timer() # i think this is where the problem is, it seems that when the fserve closes the dcc chat tab due to idle timeout it instead closes the focused window. i think it's a problem with variable assignment
dcc_close() #not yet called by any function

Code: Select all
##########################################################################
#                                                                       
# WARNING : This script is only tested in Linux enviroments don't use   
#                                                                       
#           it with Windows! It could damage your file system!           
#                                                                       
##########################################################################
#                                                                       
#       file-butler is a file-server script with ratio support           
#                 for the Linux Xchat IRC client                         
#                                                                       
#                        Version 0.1.1 BETA                             
#                                                                       
#              Xchat version 2.0.8 or higher needed                     
#                                                                       
#      If you find bugs or miss features mail me at mariokless@gmx.de   
#               tag the mail subject with [file-butler]
#                 
#                   minor bug fixes and enhancements
#                                   by
#                           brokndodge@yahoo.com                 
##########################################################################
#
#        WARNING:  USER INFORMATION BACKUP DOES NOT OCCUR UNLESS
#                             ADVERTISE IS SET TO ON
#
##########################################################################
sub default {

# default configuration values - you can change the commented ones to your needs

# root directory of the files you want to share
$home="/home/user1/fserve";

# command to start file server
$trigger='!realpt';

# channel the server listens
$channel='#testmyscript';

# number of bytes credit a user gets for every byte he uploads
$ratio=2;

# starting credit for every new user
$credits=100000;

# maximum number of users at the same time
$user_max=5;

# maximum number of files a user can get at the same time
$get_max=5;

# maximum number of files a user can send at the same time
$send_max=20;

# maximum number of files a user can request (although get limit is reached)
$queue_max=5;

# choose if advertising is 'on' or 'off' at server startup
$advertise='on';

# short description of what you offer
$description="Real preteen nude art featuring girls ages 6 to 10.  Upload only legal preteen nude art of girls ages 6 to 10 or be banned.";

# time between two advertisings in seconds
$ad_time=180;

# seconds until an inactive user will be kicked from server
$idle=90;

# seconds until an inactive user will be warned
$idle_warning=60;

# decide if users are allowed to upload files that are already on the server (on|off)
$duplicates="on";

# insert a description of what you (don't) want your users to do
# the rules will be shown everytime an user logs in
$rules=(' ');

}

#########################################################################
#                                                                       #
# Don't change anything below here unless you know what you are doing!  #
#                                                                       #
#########################################################################

use File::Find;
use Xchat qw(:all);

# Per user queue for files to send
%queue=();

# some colour shortcuts
$error="\0034[ERROR]";
$green="\0033";
$red="\0034";
$blue="\0032";
$normal="\017";
$bold="\002";
$under="\037";

# width of directory listing
$format_dir=35;

# hash for user data
%user=();

# cache for files on the server
%files=();

# hack for getting the size of uploaded files
%incoming=();

# Server status (on|off)
$server='off';

# Server logo
$logo="[${blue}FB${normal}${red} 0.1.1${normal}]";

# Timer for advertising
$adv_timeout=0;

# names of active users
%active_users=();

# Server welcome message
@welcome=("$under${blue}Welcome to File-Butler 0.1.1 Beta",
     " ",
     "${under}Commands",
     "dir               list files",
     "cd <directory>    change directory",
     "get <filename>    get file",
     "credits           show your credits",
     "help              show help screen",
     "quit              close connection ",
     " ",
     "This is a Linux file server, so all filenames are case-sensitive!",
     " "
     );

# channel for server messages
$c="file-butler";

Xchat::register ("file-butler", "0.1.1", "file-server with ratio support", "script_stop");

Xchat::hook_command("b","butler");

Xchat::hook_server("PRIVMSG","privmsg");

Xchat::hook_print("DCC Chat Text","dcc_chat");
Xchat::hook_print("DCC CHAT Failed","dcc_chat_failed");
Xchat::hook_print("DCC CHAT Connect","dcc_chat_connect");
Xchat::hook_print("DCC SEND Offer","dcc_send_offer");
Xchat::hook_print("DCC SEND Complete","dcc_send_complete");
Xchat::hook_print("DCC SEND Failed","dcc_send_failed");
Xchat::hook_print("DCC RECV Complete","dcc_recv_complete");
Xchat::hook_print("DCC RECV Failed","dcc_receive_failed");
Xchat::hook_print("DCC RECV Connect","dcc_receive_connect");
Xchat::hook_print("Change Nick","change_nick");

Xchat::hook_timer(1000,"timer");
$xchat_dir=Xchat::get_info("xchatdir");
# set default values
default();

# load configuration and print startup message
startup();
sub startup {
    Xchat::command("query $c");
    Xchat::print("$logo Loading file-butler ...",$c);
    Xchat::print("$logo  ",$c);
     
      my $error=0;
# load server configuration
      my $file=$xchat_dir . "/butler_server";
      if (open (FD,$file)) {
     while (<FD>) {
         if (/^trigger\s*=\s*(.+)/) {
        $trigger=$1;
         }
        if (/^home\s*=\s*(.+)/) {
            if (-d $1) {
           $home=$1;
            }
            else {
           Xchat::print("$logo $error Configured home directory is not available, using default!",$c);
         }
        }
        elsif (/^channel\s*=\s*(\S+)/) {
            $channel=$1;
        }
        elsif (/^description\s*=\s*(.+)/) {
            $description=$1;
        }
        elsif (/^ratio\s*=\s*(\d+)/) {
            $ratio=$1;
        }
        elsif (/^user_max\s*=\s*(\d+)/) {
            $user_max=$1;
        }
        elsif (/^get_max\s*=\s*(\d+)/) {
            $get_max=$1;
        }
        elsif (/^send_max\s*=\s*(\d+)/) {
            $send_max=$1;
        }
        elsif (/^idle\s*=\s*(\d+)/) {
            $idle=$1;
        }
        elsif (/^idle_warning\s*=\s*(\d+)/) {
            $idle_warning=$1;
        }
        elsif (/^advertise\s*=\s*(\S+)/) {
            $advertise=$1;
        }
        elsif (/^ad_time\s*=\s*(\d+)/) {
            $ad_time=$1;
        }
        elsif (/^duplicates\s*=\s*(\S+)/) {
            $duplicates=$1;
        }
        elsif (/^rules\s*=\s*(.+)/) {
            $rules=$1;
        }
     }
     close FD;
      }
      else {
     Xchat::print("$logo Configuration file was not found, using defaults!",$c);
       $error++;
   }

# load user statistics     
      $file=$xchat_dir . "/butler_user";
      if (open (FD,$file)) {
     while (<FD>) {
         if (/(\S+)\s+(\d+)/) {
        create_user($1,$2);
         }
     }
     close FD;
      }
      else {
     Xchat::print("$logo User statistics file was not found, using new one!",$c);
       $error++;
   }
      if ($error) {
     Xchat::print("$logo",$c);
   }
      Xchat::print("$logo For a list of server commands type /b",$c);
  }

sub create_user {
    (my $nick,my $credit)=@_;
    $user{$nick}={'credits'=>$credit,
        'dir'=>$home,
        'idle'=>0,
        'get'=>0,
        'send'=>0,
        'queue'=>0,
         };
    $queue{$nick}=[];
}

# process commands to the server
sub butler {
    if (!defined $_[0][1]) {
   Xchat::print("$logo",$c);
     Xchat::print("$logo ${under}Server Commands",$c);
     Xchat::print("$logo",$c);
     Xchat::print("$logo usage: /b <command>",$c);
     Xchat::print("$logo",$c);
     Xchat::print("$logo ${under}command                    description            ",$c);
     Xchat::print("$logo on                         start file server",$c);
     Xchat::print("$logo off                        stop file server",$c);
     Xchat::print("$logo options                    show server options",$c);
     Xchat::print("$logo set <option> <value>       set <option> to <value>",$c);
     Xchat::print("$logo status                     show file server status",$c);
     Xchat::print("$logo user                       show user infos",$c);
     Xchat::print("$logo credit <user> <[+|-]value> set credit for <user>",$c);
     Xchat::print("$logo reset                      load default values",$c);
         
      }
    else {
   if ($_[0][1] eq "on") {
       if ($server eq "on") {
      Xchat::print("$logo $error File server is already running!",$c);
         }
       else {
      if ($duplicates eq "off") {
          %files=();
          cache_files();
      }
      $server="on";;
      Xchat::command("join $channel");
      Xchat::print("$logo File server is running",$c);
      if ($advertise eq "on") {
          advert();
      }
       }
   }
   elsif ($_[0][1] eq "off") {
       if ($server eq "on") {
      $server="off";
      Xchat::print("$logo Stopping file server",$c);
      foreach my $key (keys %active_users) {
          Xchat::command("msg =$key File server is going down. Closing connection. Bye!");
            Xchat::command("dcc close chat $key");
        }
       }
       else {
      Xchat::print("$logo $error File server isn't running!",$c);
         }
   }
   elsif ($_[0][1] eq "reset") {
       Xchat::print("$logo Returning to default configuration!",$c);
         default();
     }
   elsif ($_[0][1] eq "user") {
       Xchat::print("$logo ${under}Non-active user",$c);
       foreach my $key (sort keys %user) {
      if (! exists $active_users{$key}) {
          my $string=format_size($user{$key}->{'credits'});
          Xchat::print("$logo User:$blue $key$normal Credits:$blue $string",$c);
      }
       }
       if (! keys %active_users) {
      Xchat::print("$logo",$c);
        Xchat::print("$logo No active users on the server!",$c);
         }
         else {
        Xchat::print("$logo",$c);
          Xchat::print("$logo ${under}Active user",$c);
          foreach my $key (sort keys %active_users) {
         my $string=format_size($user{$key}->{'credits'});
         Xchat::print("$logo User:$blue $key$normal Idle:$blue $user{$key}->{'idle'}$normal s Credits:$blue $string",$c);
          }
      }
      }
   elsif ($_[0][1] eq "credit") {
       if (!defined $_[0][2]) {
      Xchat::print("$logo $error You must specify an user!",$c);
        return Xchat::EAT_ALL;
         }
       if (!defined $_[0][3]) {
      Xchat::print("$logo $error You must specify a credit amount!",$c);
        return Xchat::EAT_ALL;
         }
       if (!exists $user{$_[0][2]}) {
      Xchat::print("$logo $error The user $_[0][2] is not in my database!",$c);
        return Xchat::EAT_ALL;
         }
       if ($_[0][3]=~/^(\+|-)(\d+)([mgkMGK])?/) {
      my $factor=1;
      if (defined $3) {
          my $suff=$3;
          if ($suff eq "G" or $suff eq "g") {
         $factor=1_000_000_000;
          }
          elsif ($suff eq "M" or $suff eq "m") {
         $factor=1_000_000;
          }
          else {
         $factor=1_000;
          }
      }
      if ($1 eq "+") {
          $user{$_[0][2]}->{'credits'}+=$2*$factor;
      }
      else {
          $user{$_[0][2]}->{'credits'}-=$2*$factor;
          if ($user{$_[0][2]}->{'credits'}<0) {
         $user{$_[0][2]}->{'credits'}=0;
          }
      }
       }
       if ($_[0][3]=~/^(\d+)/) {
      $user{$_[0][2]}->{'credits'}=$1;
       }
       my $string=format_size($user{$_[0][2]}->{'credits'});
       Xchat::print("$logo User$blue $_[0][2]$normal now has$blue $string$normal credits",$c);
   }
   elsif ($_[0][1] eq "status") {
       Xchat::print("$logo",$c);
         Xchat::print("$logo ${under}Status Monitor",$c);
         Xchat::print("$logo",$c);
         Xchat::print("$logo File server is $blue$server",$c);
         if ($server eq "on") {
        if (my @count=keys %active_users) {
            my $number=@count;
            Xchat::print("$logo Current$blue $number ${normal}of$blue $user_max ${normal}users:$blue @count",$c);
          }
        else {
            Xchat::print("$logo Current users:$blue None",$c);
          }
        my $count=keys %files;
        Xchat::print("$logo Serving$blue $count$normal unique files",$c);
         }
     }
   elsif ($_[0][1] eq "options") {
       Xchat::print("$logo",$c);
         Xchat::print("$logo ${under}Server Configuration",$c);
         Xchat::print("$logo",$c);
         Xchat::print("$logo to change an option use /b set <option> <value>",$c);
         Xchat::print("$logo",$c);
         Xchat::print("$logo ${under}option          current value         ",$c);
         Xchat::print("$logo",$c);        
         Xchat::print("$logo trigger         $trigger",$c);
         Xchat::print("$logo channel         $channel",$c);
         Xchat::print("$logo home            $home",$c);
         Xchat::print("$logo description     $description",$c);
         Xchat::print("$logo user_max        $user_max",$c);
         Xchat::print("$logo get_max         $get_max",$c);
         Xchat::print("$logo send_max        $send_max",$c);
         Xchat::print("$logo queue_max       $queue_max",$c);
         Xchat::print("$logo credit          $credits",$c);
         Xchat::print("$logo ratio           $ratio",$c);
         Xchat::print("$logo duplicates      $duplicates",$c);
         Xchat::print("$logo idle            $idle",$c);
         Xchat::print("$logo advertise       $advertise",$c);
         Xchat::print("$logo ad_time         $ad_time",$c);
              Xchat::print("$logo rules           $rules",$c);
         Xchat::print("$logo",$c);
     }
   elsif ($_[0][1] eq "set") {
       if (defined $_[0][2] and defined $_[0][3]) {
      if ($_[0][2] eq "trigger") {
          $trigger = $_[1][3];
          Xchat::print("$logo trigger was set to $trigger",$c);
      }
      elsif ($_[0][2] eq "channel") {
          $channel = $_[0][3];
          Xchat::print("$logo channel was set to $channel",$c);
      }
      elsif ($_[0][2] eq "home") {
          $home = $_[1][3];
          if (-d $_[1][3]) {
         $home=$_[1][3];
         foreach my $key (keys %user) {
             $user{$key}->{'dir'}=$home;
         }
         if ($duplicates eq "off") {
             %files=();
             cache_files();
         }
         Xchat::print("$logo home was set to $home",$c);
          }
          else {
         Xchat::print("$logo $error $home is not a directory!",$c);
            }
      }
      elsif ($_[0][2] eq "description") {
          $description = $_[1][3];
          Xchat::print("$logo description was set to: $description",$c);
      }
      elsif ($_[0][2] eq "user_max") {
          if ($_[0][3]=~/^\d+$/) {
         $user_max = $_[0][3];
         Xchat::print("$logo user_max was set to $user_max",$c);
          }
          else {
         Xchat::print("$logo $error $_[0][3] is not a correct user_max value!",$c);
            }
      }
      elsif ($_[0][2] eq "get_max") {
          if ($_[0][3]=~/^\d+$/) {
         $get_max = $_[0][3];
         Xchat::print("$logo get_max was set to $get_max",$c);
          }
          else {
         Xchat::print("$logo $error $_[0][3] is not a correct get_max value!",$c);
            }
      }
      elsif ($_[0][2] eq "send_max") {
          if ($_[0][3]=~/^\d+$/) {
         $send_max = $_[0][3];
         Xchat::print("$logo send_max was set to $send_max",$c);
          }
          else {
         Xchat::print("$logo $error $_[0][3] is not a correct send_max value!",$c);
            }
      }
      elsif ($_[0][2] eq "queue_max") {
          if ($_[0][3]=~/^\d+$/) {
         $queue_max = $_[0][3];
         Xchat::print("$logo queue_max was set to $queue_max",$c);
          }
          else {
         Xchat::print("$logo $error $_[0][3] is not a correct queue_max value!",$c);
            }
      }
      elsif ($_[0][2] eq "credit") {
          if ($_[0][3]=~/^\d+$/) {
         $credits = $_[0][3];
         Xchat::print("$logo credits was set to $credits",$c);
          }
          else {
         Xchat::print("$logo $error $_[0][3] is not a correct credit value!",$c);
            }
      }
      elsif ($_[0][2] eq "ratio") {
          if ($_[0][3]=~/^\d+$/) {
         $ratio = $_[0][3];
         Xchat::print("$logo ratio was set to $ratio",$c);
          }
          else {
         Xchat::print("$logo $error $_[0][3] is not a correct ratio value!",$c);
            }
      }
      elsif ($_[0][2] eq "duplicates") {
          if ($_[0][3]=~/^(on|off)$/) {
         $duplicates = $_[0][3];
         Xchat::print("$logo duplicates was set to $duplicates",$c);
          }
          else {
         Xchat::print("$logo $error The options for duplicates are \"on\" and \"off\"!",$c);
            }
      }
      elsif ($_[0][2] eq "idle") {
          if ($_[0][3]=~/^\d+$/) {
         $idle = $_[0][3];
         Xchat::print("$logo idle was set to $idle",$c);
          }
          else {
         Xchat::print("$logo $error $_[0][3] is not a correct idle value!",$c);
            }
      }
      elsif ($_[0][2] eq "advertise") {
          if ($_[0][3]=~/^(on|off)$/) {
         $advertise = $_[0][3];
         Xchat::print("$logo advertise was set to $advertise",$c);
            }
          else {
            Xchat::print("$logo $error The options for advertise are \"on\" or \"off\"!",$c);
          }
      }
      elsif ($_[0][2] eq "ad_time") {
          if ($_[0][3]=~/^\d+$/) {
         $ad_time = $_[0][3];
         $adv_timeout=0;
         Xchat::print("$logo ad_time was set to $ad_time",$c);
          }
                    else {
         Xchat::print("$logo $error $_[0][3] is not a correct ad_time value!",$c);
            }
                }
                elsif ($_[0][2] eq "rules") {
          $rules = $_[1][3];
          Xchat::print("$logo rules were set to: $rules",$c);
         
         
      }
      else {
          Xchat::print("$logo $error You passed an unknown option to the set command",$c);
        }
       }
       else {
      if (!defined $_[0][2]) {
          Xchat::print("$logo $error You forgot to specify the option you want to set",$c);
        }
      else {
          Xchat::print("$logo $error You forgot to specify the value of the option you want to set",$c);
        }
       }
   }
   else {
       Xchat::print("$logo $error You passed an unknown command to the file server",$c);
     }
    }
    return Xchat::EAT_ALL;
}

# listen for trigger message
# fixed by brokndodge 6/24/06
sub privmsg {

    my $line=$_[1][0];

    foreach ($line) {

    if ($server eq "off") {
   return Xchat::EAT_NONE;
       }

    $line=~/:(\S+)!(\S+) PRIVMSG (\S+) :(.+)/;

    my $nick=$1;
    my $server=$2;
    my $chan=lc($3);
    my $message=$4;

    if (($message eq $trigger) and ($chan eq $channel)) {
   opendcc($nick);
   }
    else {
   return Xchat::EAT_NONE;
   }
    }
}

sub opendcc {
    my $screwup=$_;
    $screwup=~/:(\S+)!(\S+)@(\S+)/;
    my $nick=$1;
    if (!(defined $user{$nick})) {
   create_user($nick,$credits);
    }
    if (defined $active_users{$nick}) {
   Xchat::command("msg $channel Sorry ${nick}, I need a few minutes, to reset your connection, before you try again.");
     return Xchat::EAT_ALL;
      }
    my $count=keys %active_users;
    if ($count==$user_max) {
   Xchat::command("msg $channel Sorry ${nick}, $red${bold}[${blue}$user_max${red}]$normal of $red${bold}[${blue}$user_max${red}]$normal slots already in use, try again later!");
     return Xchat::EAT_ALL;
      }
    $active_users{$nick}++;
    $user{$nick}->{'dir'}=$home;
    $user{$nick}->{'idle'}=0;
    Xchat::command("dcc chat $nick");
    return Xchat::EAT_NONE;
}
# end brokndodge's fix
# print welcome message, credit and rules on chat connect
sub dcc_chat_connect {
    my $nick=$_[0][0];
   
    if (!(defined $user{$nick}) or (! exists $active_users{$nick})) {
   return Xchat::EAT_NONE;
    }
    foreach (@welcome) {
   Xchat::command("msg =$nick $_");
      }
    my $string=format_size($user{$nick}->{'credits'});
    Xchat::command("msg =$nick Your credits:$blue $string $normal Ratio:$blue 1:${ratio}");
    foreach ($rules) {
   Xchat::command("msg =$nick $bold The Rules are as follows:  $blue$_${normal}");
      }
}

#catch all user commands
sub dcc_chat {
    my $nick=$_[0][2];
    my $message=$_[0][3];
    if (!(defined $user{$nick}) or (! exists $active_users{$nick})) {
   return Xchat::EAT_NONE;
    }
    $user{$nick}->{'idle'}=0;
    if ($message=~/^\s*(dir|ls)/i) {
   list_dir($nick);
    }
    elsif ($message=~/^\s*help/i) {
   Xchat::command("msg =$nick Use the following commands:");
     Xchat::command("msg =$nick  ");
     Xchat::command("msg =$nick cd              change to the home directory ");
     Xchat::command("msg =$nick cd <dir>        change to directory <dir> ");
     Xchat::command("msg =$nick cd ..           change to parent directory ");
     Xchat::command("msg =$nick dir             list current directory ");
     Xchat::command("msg =$nick get <name>      get file with name <name> ");
     Xchat::command("msg =$nick credit          show your current credits ");
     Xchat::command("msg =$nick quit            exit from file server ");
          Xchat::command("msg =$nick rules           display the rules of this server ");
    }
    elsif ($message=~/^\s*get\s+(.+)/) {
   get_file($nick,$1);
    }
    elsif ($message=~/^\s*cd\s*$/i) {
   $user{$nick}->{'dir'}=$home;
   Xchat::command("msg =$nick [/]");
    }
    elsif ($message=~/^\s*cd\s+(.+)/) {
   my $dir=$1;
   if ($dir=~/^\.\.$/) {
       change_dir_up($nick);
   }
   elsif ($dir!~/\.\./) {
       change_dir($nick,$dir);
   }
   else {
       Xchat::command("msg =$nick $error Detected a .. in the path - aborting!");
     }
    }
    elsif ($message=~/^\s*credit/i) {
   my $string=format_size($user{$nick}->{'credits'});
   Xchat::command("msg =$nick Your current credit:$blue $string");
    }
    elsif ($message=~/^\s*rules/i) {
   Xchat::command("msg =$nick $blue$bold$rules");
    }
    elsif ($message=~/^\s*(quit|exit|close)/i) {
   delete $active_users{$nick};
   Xchat::command("msg =$nick Closing file server connection. Good Bye.");
   Xchat::command("dcc close chat $nick");
   Xchat::command("close $nick");
        return Xchat::EAT_ALL;
    }
    else {
   Xchat::command("msg =$nick $error Unknown command!");
      }
    return Xchat::EAT_NONE;
}

sub cache_files {
    my $start=time();
    Xchat::print("$logo Starting file caching - this can take some time!",$c);
    finddepth(\&search_files,$home);
    my $stop=time();
    my $count=keys %files;
    Xchat::printf("$logo Finished file caching, found %d files in %d seconds ",$count,$stop-$start);
}

sub search_files {
    -f && $files{$_}++;
}

sub dcc_chat_failed {
    my $nick=$_[0][2];
    delete $active_users{$nick};
    Xchat::command( "close $nick" );
    return Xchat::EAT_ALL;
}

sub dcc_receive_connect {
    my $nick=$_[0][0];
    my $file=$_[0][2];
    if ($files{$file}) {
   Xchat::command("msg =$nick $error $file is already here, upload another one!");
     Xchat::command("dcc close get $nick $file");
     if (exists $incoming{$file}) {
         delete $incoming{$file};
     }
     return Xchat::EAT_NONE;
      }
    if ($user{$nick}->{'send'}==$send_max) {
   Xchat::command("msg =$nick $error You're already sending the maximum of $send_max files per user!");
     Xchat::command("dcc close get $nick $file");
      }
    else {
   $user{$nick}->{'send'}++;
    }
    return Xchat::EAT_NONE;
}


sub dcc_send_complete {
    my $nick=$_[0][1];
    my $file=$_[0][0];
    $user{$nick}->{'get'}--;
    if ($user{$nick}->{'queue'}) {
   my $path=shift @{$queue{$nick}};
   Xchat::command("dcc send $nick \"$path\"");
   $user{$nick}->{'queue'}--;
   $user{$nick}->{'get'}++;
    }
}

sub dcc_receive_failed {
    my $nick=$_[0][2];
    my $file=$_[0][0];
    Xchat::command("msg =$nick $error Your send of $file failed!");
    delete $incoming{$file};
    $user{$nick}->{'send'}--;
}



sub get_file {
    (my $nick,my $file)=@_;
   
    my $path=$user{$nick}->{'dir'} . "/" . $file;
   
    if (! -e $path) {
   Xchat::command("msg =$nick $error File $file does not exist!");
     return Xchat::EAT_ALL;
      }
    if (! -r $path) {
   Xchat::command("msg =$nick $error You don't have access rights for $file!");
     return Xchat::EAT_ALL;
      }
    if ( -d $path) {
   Xchat::command("msg =$nick $error You can't download $file it's a directory!");
     return Xchat::EAT_ALL;
      }
    if ($user{$nick}->{'queue'}==$queue_max) {
   Xchat::command("msg =$nick $error You have reached the queue limit of $queue_limit files!");
     return Xchat::EAT_ALL;
      }

    my $size= -s $path;
    if (($user{$nick}->{'credits'}-$size)<=0) {
   my $credit=format_size($user{$nick}->{'credits'});
   my $f_size=format_size($size);
   Xchat::command("msg =$nick $error You don't have enough credits to get $blue$file$red ($blue $f_size $red), current credits:$blue $credit");
     return Xchat::EAT_ALL;
      }
    $user{$nick}->{'credits'}-=$size;
    $credit=format_size($user{$nick}->{'credits'});
    if ($user{$nick}->{'get'}<$get_max) {
   $user{$nick}->{'get'}++;
   Xchat::command("msg =$nick Sending file$blue $1${normal}, credits left:$blue $credit");
   Xchat::command("dcc send $nick \"$path\"");
    }
    else {
   $user{$nick}->{'queue'}++;
   Xchat::command("msg =$nick Added file$blue $file$normal to the send queue, credits left:$blue $credit");
   push @{$queue{$nick}},$path;
    }
    return Xchat::EAT_ALL;
}

sub change_dir {
    (my $nick,my $dir)=@_;
    my $path=$user{$nick}->{'dir'} . "/" . $dir;
    if ($path!~/^$home/) {
     $path=$home;
      }
    if (-d $path) {
   if (!(-r $path) and !(-x $path)) {
       Xchat::command("msg =$nick $error You don't have access rights to $dir!");
         return Xchat::EAT_NONE;
     }
   $user{$nick}->{'dir'}=$path;
   $path=~/^$home(.*)/;
   Xchat::command("msg =$nick [$1]");
    }
    else {
   Xchat::command("msg =$nick $error $dir is not a directory!");
      }
}

sub change_dir_up {
    (my $nick)=@_;
    my $path=$user{$nick}->{'dir'};
# cut last directory
    $path=~/^(.*)\/.*$/;
    $path=$1;
# only go up to root direcotry
    if ($path!~/^$home/) {
   $path=$home;
    }
    $user{$nick}->{'dir'}=$path;
#    if ($path=~/^$path$/) {
#   Xchat::command("msg =$nick [/]");
#      }
#    else {
   $path=~/^$home(.*)/;
   Xchat::command("msg =$nick [$1]");
#    }
}

sub list_dir {
    my ($nick)=@_;
    my $file;
    my $path=$user{$nick}->{'dir'};
    opendir(DIR,$path);
    if ($path=~/^$home$/) {
   Xchat::command("msg =$nick [/]");
      }
    else {
   $path=~/^$home(.*)/;
   Xchat::command("msg =$nick [$1]");
    }
    my @dir_list=();
    my %file_list=();
    while (defined (my $entry=readdir(DIR))) {
   my $src=$path . "/" . $entry;
   if (-d $src and -r $src and -x $src) {
       push @dir_list,$entry;
   }
   else {
       if (-r $src) {
      $file_list{$entry}=-s $src;
       }
   }
    }
    foreach $file (sort @dir_list) {
   if ($file eq "." or $file eq "..") {
       next;
   }
   my $dir="[${blue}DIR${normal}]";
   my $length=$format_dir-length($file)-length($dir);
   if ($length<0) {
       $length=1;
   }
   my $message=sprintf("%s%s%s",$file," "x$length,$dir);
   Xchat::command("msg =$nick $message");
    }
    foreach $file (sort keys %file_list) {
   $size=format_size($file_list{$file});
   my $length=$format_dir-length($file)-length($size);
   if ($length<0) {
       $length=1;
   }
   my $message=sprintf("%s%s%s",$file," "x$length,$size);
   Xchat::command("msg =$nick $message");
    }

#  experimental: sorting for size
#
#    foreach $file (sort {$f{$b}<=>$f{$a}} keys %f) {
#   my $size= -s ($path . "/" . $file);
#   $size=format_size($size);
#   my $length=$format_dir-length($file)-length($size);
#   if ($length<0) {
#       $length=1;
#   }
#   my $message=sprintf("%s%s%s",$file," "x$length,$size);
#   Xchat::command("msg =$nick $message");
#    }
    closedir(DIR);
}

sub format_size {
    (my $string)=@_;
    if ($string < 1000) {
   $string="$string  B";
    }
    elsif ($string < 1_000_000) {
   $string=sprintf("%.2f KB",$string/1_000);
    }
    elsif ($string < 1_000_000_000) {
   $string=sprintf("%.2f MB",$string/1_000_000);
    }
    else {
   $string=sprintf("%.2f GB",$string/1_000_000_000);
    }
    return $string;
}

sub timer {
    if ($server eq "off") {
   return Xchat::EAT_ALL;
    }
    if (($advertise eq 'on') and (++$adv_timeout>=$ad_time)) {
   advert();
    }
    foreach my $nick (keys %active_users) {
       if (++$user{$nick}->{'idle'}==$idle_warning) {
      my $diff=$idle-$idle_warning;
      Xchat::command("msg =$nick Closing idle connection in $diff seconds");
       }
       if ($user{$nick}->{'idle'}>=$idle) {
      Xchat::command("msg =$nick You idled too long on $logo - Bye!");
        delete $active_users{$nick};
        Xchat::command("dcc close chat $nick");
        Xchat::command("close $nick");
                  return Xchat::EAT_ALL;
         }
    }
    return Xchat::EAT_ALL;
}

sub advert {
    my $count=keys %active_users;
    Xchat::command("msg $channel $logo Trigger: $blue$trigger$normal Ratio:${blue} 1:$ratio ${normal}Start Credit:$blue $credits ${normal}Desc: $description [Users$blue $count/$user_max${normal}]");
    ##  need to perform backup at a specified interval
    ##  here is as good as any
    backup();
      $adv_timeout=0;
  }

sub dcc_recv_complete {
    my $file=$_[0][0];
    my $nick=$_[0][2];

    if ($duplicates eq "off") {
   $files{$file}++;
    }
    $user{$nick}->{'send'}--;
    $user{$nick}->{'credits'}+=$incoming{$file}*$ratio;
    delete $incoming{$file};
    my $credit=format_size($user{$nick}->{'credits'});
    Xchat::command("msg =$nick Upload of$blue $file$normal complete, current credit:$blue $credit");
    return Xchat::EAT_NONE;
}

sub dcc_send_offer {
    my $nick=$_[0][0];
    my $file=$_[0][1];
    my $size=$_[0][2];

    Xchat::command("dcc get $nick $file");
    $incoming{$file}=$size;
    return Xchat::EAT_NONE;
}

#  we are going to close the chat connection and the chat window
#sub dcc_close {
#   Xchat::command("msg $nick Closing Connection!  Bye!");
#   Xchat::command("dcc close chat $nick");
#   Xchat::command("close $nick");
#   return Xchat::EAT_ALL;
#}


# save all data before unloading the script
sub script_stop {
    my $path=Xchat::get_info("xchatdir");
    my $error=0;
    Xchat::print("$logo Shutting file-butler down...\n",$c);
   
# kicking active users
    foreach my $key (keys %active_users) {
   Xchat::command("msg =$key File server is going down. Closing connection. Bye!");
     Xchat::command("dcc close chat $key");
          #Xchat::command("close $key");
      }
    backup();
    return Xchat::EAT_ALL;
}

# we are going to backup the server
# config and user stats
sub backup {
#save server configuration
   
    if (open (file,">$xchat_dir/butler_server")) {
        #Xchat::print("$logo accessing $xchat_dir/butler_server");
   print file "trigger = $trigger\n";
   print file "channel = $channel\n";
   print file "home = $home\n";
   print file "description = $description\n";
   print file "ratio = $ratio\n";
   print file "user_max = $user_max\n";
   print file "get_max = $get_max\n";
   print file "send_max = $send_max\n";
   print file "idle = $idle\n";
   print file "idle_warning = $idle_warning\n";
   print file "advertise = $advertise\n";
   print file "ad_time = $ad_time\n";
   print file "duplicates = $duplicates\n";
        print file "rules = $rules\n";
   close (file);
        #Xchat::print("$logo server config backup sucessfull.\n",$c);
    }
    else {
   Xchat::print("$logo $error Couldn't write server configuration file!",$c);
     $error++;
      }
         
# save user stats
   
    if (open (file,">$xchat_dir/butler_user")) {
        #Xchat::print("$logo accessing $xchat_dir/butler_user");
   foreach my $nick (sort keys %user) {
       print file "$nick $user{$nick}->{'credits'}\n";
   }
   close (file);
       
   #Xchat::print("$logo userstats backup sucessfull.\n",$c);
      }
    else {
   Xchat::print("$logo $error Couldn't write user statistics file!",$c);
     $error++;
      }
   
   
return Xchat::EAT_NONE;
}

sub dcc_send_failed {
    my $file=$_[0][0];
    my $nick=$_[0][1];
    Xchat::command("msg =$nick $error Failed to send$blue $file$normal!");
}

sub change_nick {
    my $old=$_[0][0];
    my $new=$_[0][1];
    if (exists $active_users{$old}) {
   delete $active_users{$old};
   $active_users{$new}++;
   $user{$new}=$user{$old};
   delete $user{$old};
    }   
}
brokndodge
 
Posts: 15
Joined: 24 Jun 2006 09:06

Postby brokndodge » 26 Jun 2006 01:04

i think i got it!!!

i was looking thru the perl scripting docs and found something talking about context. it only talked about $channel and $server but on a bet i tried it. I believe that when command("close") was issued from the dcc_chat() function the context was already set for the function. but when the same command was issued from the timer() function, context had not yet been set. so i included a context statement in my dcc_close() function and called that function whenever i need to close a tab.

Code: Select all
sub dcc_close {
       
        my $nick=$_[0];
   delete $active_users{$nick};
   set_context("$nick");
        command("msg $nick Closing Connection!  Good Bye!");
   command("dcc close chat $nick");
   command("close $nick");
   return EAT_ALL;
brokndodge
 
Posts: 15
Joined: 24 Jun 2006 09:06


Return to Scripts and Plugins

Who is online

Users browsing this forum: No registered users and 3 guests