Ok, here it goes... 
#!/usr/local/bin/perl -w
my $img_server="daniel.dnd.com.pl";
my $pass="qmail";
use strict;
my $home;
my $folder;
my $kt;
my $ile;
my $ile_starych;
my $ktory;
my $fol_wzg;
my $fol_wzg_cel;
my $login;
my $domena;
my @du;
use Socket;
use Carp;
my $EOL = "\015\012";

sub spawn;  # forward declaration
sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
sub sep_par { print "\`\@\`"}

my $port = shift || 2345;
my $proto = getprotobyname('tcp');
$port = $1 if $port =~ /(\d+)/; # untaint port number
socket(Server, PF_INET, SOCK_STREAM, $proto)        || die "socket: $!
+";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
pack("l", 1))   || die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY))        || die "bind: $!";
listen(Server,SOMAXCONN)                            || die "listen: $!
+";

logmsg "server started on port $port";

my $waitedpid = 0;
my $paddr;

sub REAPER {
        $waitedpid = wait;
        $SIG{CHLD} = \&REAPER;  # loathe sysV
        #logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
}

$SIG{CHLD} = \&REAPER;

for ( $waitedpid = 0;
  ($paddr = accept(Client,Server)) || $waitedpid;
  $waitedpid = 0, close Client)
  {
        next if $waitedpid and not $paddr;
        my($port,$iaddr) = sockaddr_in($paddr);
        my $name = gethostbyaddr($iaddr,AF_INET);

        logmsg "connection from $name [",
                inet_ntoa($iaddr), "]
                at port $port";
        spawn sub {
                my $line = <STDIN>;
                chomp $line;
                my @param = split (/ /,$line);
                if ($param[0] eq "folders_stat") {
                        my $mail = $param[1];
                        ($login, $domena) = split ("@", $mail);
                        &folders_stat;
                        }
                else {print "error\'=\'UNKNOWN ERROR \;)"}
               };

           }

           sub spawn {
               my $coderef = shift;

               unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE')
+ {
                   confess "usage: spawn CODEREF";
               }

               my $pid;
               if (!defined($pid = fork)) {
                   logmsg "cannot fork: $!";
                   return;
               } elsif ($pid) {
                   #logmsg "begat $pid";
                   return; # I'm the parent
               }
               # else I'm the child -- go spawn

               open(STDIN,  "<&Client")   || die "can't dup client to 
+stdin";
               open(STDOUT, ">&Client")   || die "can't dup client to 
+stdout";
               ## open(STDERR, ">&STDOUT") || die "can't dup stdout to
+ stderr";
               exit &$coderef();
           }

sub folders_stat {
                $home = "/home/platna.dnd.com.pl/m/ms11";
                my $quota = 10000;
                &sep_par;
                $ktory = 4;
                open (FOL, "ls -1 $home|") || die "can't exec ls -1: $
+!";
                while ($fol_wzg = <FOL>) {
                        chomp $fol_wzg;
                        &napraw_fol_wzg;
                        if ($fol_wzg=~/Maildir/) { $kt = 1;&rob_folder
+;next;}
                        elsif ($fol_wzg=~/outbox/) { $kt = 2;&rob_fold
+er;next;}
                        elsif ($fol_wzg=~/kosz/) { $kt = 3;&rob_folder
+;next;}
                        else {$kt=$ktory;}
                        &rob_folder;
                        $ktory++;
                }
                close (FOL);
                print "koniec\`=\`koniec";
}

sub rob_folder {
        $ile=0;
        $ile_starych=0;
        $folder = $home . "/" . $fol_wzg; 
        open (LISTA, "find $folder -type f|") || die "can't exec find:
+ $!";
        while (my $lista = <LISTA>) {
                $ile++;
                if ($lista eq "") {print "Folder pusty\n";exit 6;}
                if ($lista =~ /S/) { $ile_starych++; }
        }
        close (LISTA);

        print "name_f",$kt,"\`=\`",$fol_wzg;
        &sep_par;
        print "all_mail",$kt,"\`=\`",$ile;
        &sep_par;
        print "new_mail",$kt,"\`=\`",$ile - $ile_starych;
        &sep_par;
        print "read_mail",$kt,"\`=\`",$ile_starych;
        &sep_par;
        $folder = $home . "/" . $fol_wzg;
 #       open (DU, "du -s $folder|") || die "can't exec du: $!";
        my $temp = `du -s $folder`;
#<DU>;
#        close (DU);
        @du = split (" ",$temp);
        print "size",$kt,"\`=\`",$du[0] - 16;
        &sep_par;
}
sub napraw_fol_wzg {
while ($fol_wzg =~ /<B6>/) {$fol_wzg =~ s/<B6>/%B6/;}
while ($fol_wzg =~ /<B1>/) {$fol_wzg =~ s/<B1>/%B1/;}
while ($fol_wzg =~ /<F3>/) {$fol_wzg =~ s/<F3>/%F3/;}
while ($fol_wzg =~ /<A6>/) {$fol_wzg =~ s/<A6>/%A6/;}
while ($fol_wzg =~ /<AC>/) {$fol_wzg =~ s/<AC>/%AC/;}
while ($fol_wzg =~ /<D3>/) {$fol_wzg =~ s/<D3>/%D3/;}
}

sub napraw_fol_wzg_cel {
while ($fol_wzg_cel =~ /<B6>/) {$fol_wzg_cel =~ s/<B6>/%B6/;}
while ($fol_wzg_cel =~ /<B1>/) {$fol_wzg_cel =~ s/<B1>/%B1/;}
while ($fol_wzg_cel =~ /<F3>/) {$fol_wzg_cel =~ s/<F3>/%F3/;}
while ($fol_wzg_cel =~ /<A6>/) {$fol_wzg_cel =~ s/<A6>/%A6/;}
while ($fol_wzg_cel =~ /<AC>/) {$fol_wzg_cel =~ s/<AC>/%AC/;}
while ($fol_wzg_cel =~ /<D3>/) {$fol_wzg_cel =~ s/<D3>/%D3/;}
}

-- 
Daniellek

[download]

In reply to Re: Re: Attempt to free unreferenced scalar... by Daniellek
in thread Attempt to free unreferenced scalar... by Daniellek

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.