—
—
—
—
—

              
#$Id: filelist.pm 966 2012-05-25 18:29:30Z pro $ $URL: svn://svn.setun.net/dcppp/trunk/lib/Net/DirectConnect/filelist.pm $
HideShow 8 lines of Pod
=head1 SYNOPSIS
generate dc++ xml filelist
perl filelist.pm /path/to/dir
=cut
package    # no cpan
  Net::DirectConnect::filelist;
use 5.10.0;
use strict;
use utf8;
use warnings;
no warnings qw(uninitialized);
use Encode;
use Data::Dumper;    #dev only
$Data::Dumper::Sortkeys = $Data::Dumper::Useqq = $Data::Dumper::Indent = 1;
#use Net::DirectConnect;
use Net::DirectConnect::adc;
our $VERSION = ( split( ' ', '$Revision: 966 $' ) )[1];
HideShow 15 lines of Pod
=tofix
$0 =~ m|^(.+)[/\\].+?$|;                #v0
our $root_path ||= $1 . '/' if $1;
$root_path =~ s|\\|/|g;
warn "rp[$root_path]";
eval "use lib '$root_path./stat/pslib'";
eval "use lib '$root_path./../../../examples/stat/pslib'; 
      use psmisc; use pssql;
use Net::DirectConnect;
use base 'Net::DirectConnect';      
      "; #use Net::DirectConnect; 
      #psmisc::use_try ('Net::DirectConnect');
=cut
use base 'Net::DirectConnect';
#use lib '../../../examples/stat/pslib';    # REMOVE
#use lib 'stat/pslib';                      # REMOVE
use lib::abs('pslib');
use psmisc;    # REMOVE
use pssql;     # REMOVE
our %config;
*config = *main::config;
$config{ 'log_' . $_ } //= 0 for qw (dmp dcdmp dcdbg trace);
$config{ 'log_' . $_ } //= 1 for qw (screen default);
Net::DirectConnect::use_try 'Sys::Sendfile' unless $^O =~ /win/i;
Net::DirectConnect::use_try 'Sys::Sendfile::FreeBSD' if $^O =~ /freebsd/i;
#Net::DirectConnect::use_try 'IO::AIO';
my ( $tq, $rq, $vq );
sub skip ($$) {
  my ( $file, $match ) = @_;
  return unless length $match;
  #say join ' ', ('skptst', $file, $match,);
  for my $m ( ref $match eq 'ARRAY' ? @$match : $match ) {
    return 1 if ref $m eq 'Regexp' and $file =~ $m;
    return 1 if !ref $m and $file eq $m;
  }
}
sub new {
  my $standalone = !ref $_[0];
  my $self = ref $_[0] ? shift() : bless {}, $_[0];
  shift if $_[0] eq __PACKAGE__;
  #local %_ = @_;
  #$self->{$_} = $_{$_} for keys %_;
  $self->func(@_);
  $self->init_main(@_);
  $self->{'log'} = sub (@) {
    my $dc = ref $_[0] ? shift : $self || {};
    #print "PL[$_[0]]";
    psmisc::printlog shift(), "[$dc->{'number'}]", @_,;
  },;
  $self->{no_sql} //= 0;
  #
  # adjustable
  #
  $self->{files}             //= 'files.xml';
  $self->{tth_cheat}         //= 1_000_000;         #try find file with same name-size-date
  $self->{tth_cheat_no_date} //= 0;                 #--//-- only name-size
  $self->{file_min}          //= 0;                 #skip files  smaller
  $self->{filelist_scan}     //= 3600 * 1;          #every seconds, 0 to disable
  $self->{filelist_reload}   //= 300;               #check and load filelist if new, every seconds
  $self->{file_send_by}      //= 1024 * 1024 * 1;
  $self->{skip_hidden}       //= 1;
  $self->{skip_symlink}      //= 0;
  $self->{skip_dir} //= [ qr'(?:^|/)Incomplete(?:/|$)', ( !$self->{skip_hidden} ? () : qr{(?:^|/)\.} ), ];
  $self->{skip_file} //=
    [ qr/\.(?:partial|(?:dc)tmp)$/i, qr/^~uTorrentPartFile_/i, ( !$self->{skip_hidden} ? () : qr{(?:^|/)\.} ), ];
  # $self->{sharesize_mul}  //= 3; # make share bigger * sharefiles_mul
  # $self->{sharesize_add}  //= 10_000_000_000; #add to share size virtual bytes
  # $self->{sharefiles_mul} //=3; #same for files for keeping size/files rate
  # $self->{sharefiles_add} //= 10_000;
  # $self->{no_auto_load_partial} //= 1;
  #
  # ==========
  #
  #$self->{share_full}        //= {};
  #$self->{share_tth}         //= {};
##$config{share_root} //= '';
  $self->{'share'} = [ $self->{'share'} ] unless ref $self->{'share'};
  tr{\\}{/} for @{ $self->{'share'} || [] };
  Net::DirectConnect::adc::func($self);
  $self->ID_get();
  #$self->log('idr:', $self->{'INF'}{'ID'});
  #$self->ID_get();
  unless ( $self->{no_sql} ) {
    local %_ = (
      'driver' => 'sqlite',
      #'dbname' => 'files',
      'database' => 'files',
      #'auto_connect'        => 1,
      #'log' => sub { shift if ref $_[0]; $self->log(@_) if $self },
      'log' => $self->{'log'},
      #'cp_in'               => 'cp1251',
      'connect_tries' => 0, 'connect_chain_tries' => 0, 'error_tries' => 0, 'error_chain_tries' => 0,
      #insert_by => 1000,
      #nav_all => 1,
      #{}
      #},
      'upgrade' => sub {
        my $db = shift if ref $_[0];
        $db->do("ALTER TABLE filelist ADD COLUMN $_")
          for 'hit INTEGER UNSIGNED NOT NULL DEFAULT 0 ', 'sch INTEGER UNSIGNED NOT NULL DEFAULT 0 ';
        #$db->do("UPDATE filelist SET hit=0, sch=0 WHERE hit IS NULL");
      },
    );
    $self->{sql}{$_} //= $_{$_} for keys %_;
    my ($short) = $self->{sql}{'driver'} =~ /mysql/;
    my %table = (
      'filelist' => {
        'path' => pssql::row(
          undef,
          'type'    => 'VARCHAR',
          'length'  => ( $short ? 150 : 255 ),
          'default' => '',
          'index'   => 1,
          'primary' => 1
        ),
        'file' => pssql::row(
          undef,
          'type'    => 'VARCHAR',
          'length'  => ( $short ? 150 : 255 ),
          'default' => '',
          'index'   => 1,
          'primary' => 1
        ),
        'tth'  => pssql::row( undef, 'type'        => 'VARCHAR', 'length' => 40, 'default' => '', 'index' => 1 ),
        'size' => pssql::row( undef, 'type'        => 'BIGINT',  'index'  => 1, ),
        'time' => pssql::row( 'time', ), #'index' => 1,
                     #'added'  => pssql::row( 'added', ),
                     #'exists' => pssql::row( undef, 'type' => 'SMALLINT', 'index' => 1, ),
        'hit' => pssql::row( undef, 'type' => 'INTEGER UNSIGNED NOT NULL DEFAULT 0 ', ),
        'sch' => pssql::row( undef, 'type' => 'INTEGER UNSIGNED NOT NULL DEFAULT 0', ),
      },
    );
    if ( $self->{db} ) {
      #warn 'preFL',Dumper $self->{db}{table}; #$config{'sql'};
      $self->{db}{table}{$_} = $table{$_} for keys %table;
      $self->{db}{upgrade} = $_{upgrade};
    }
    local %_ = ( 'table' => \%table, );
    $self->{sql}{$_} //= $_{$_} for keys %_;
    #warn ('sqlore:',Data::Dumper::Dumper $self->{'sql'}, \%_),
    $self->{db} ||= pssql->new( %{ $self->{'sql'} || {} }, );
    ( $tq, $rq, $vq ) = $self->{db}->quotes();
    #$self->log('db', Dumper $self->{db});
    #$self->log('db', 'flist', $self->{db});
  }
  $self->{filelist_make} //= sub {
    my $self = shift if ref $_[0];
    my $notth;
    return unless psmisc::lock( 'sharescan', timeout => 0, old => 86400 );
    $self->log( 'err', "sorry, cant load Net::DirectConnect::TigerHash for hashing" ), $notth = 1,
      unless Net::DirectConnect::use_try 'Net::DirectConnect::TigerHash';    #( $INC{"Net/DirectConnect/TigerHash.pm"} );
                                                                             #$self->log( 'info',"ntth=[$notth]");    exit;
    $self->log( 'err', 'forced db upgrade on make' ), $self->{db}->upgrade() if $self->{upgrade_force};
    my $stopscan;
    my $level     = 0;
    my $levelreal = 0;
    my ( $sharesize, $sharefiles );
    my $interrupted;
    my $printinfo = sub () {
      $self->log( 'sharesize', psmisc::human( 'size', $sharesize ), $sharefiles, scalar keys %{ $self->{share_full} } );
    };
    local $SIG{INT} = sub { ++$stopscan; ++$interrupted; $self->log( 'warn', "INT rec, stopscan" ) };
    local $SIG{INFO} = sub { $printinfo->(); };
    #$self->{'INF'}{'ID'}
    psmisc::file_rewrite $self->{files}, qq{<?xml version="1.0" encoding="utf-8" standalone="yes"?>
<FileListing Version="1" }, ( !$self->{'INF'}{'ID'} ? () : qq{CID="$self->{'INF'}{'ID'}" } ),
      qq{Base="/" Generator="Net::DirectConnect $Net::DirectConnect::VERSION">
};
#<FileListing Version="1" CID="KIWZDBLTOFWIQOT6NWP7UOPJVDE2ABYPZJGN5TZ" Base="/" Generator="Net::DirectConnect $Net::DirectConnect::VERSION">
#};
    my %o;
    my $o = sub { our $n; $o{ $_[0] } = ++$n; @_ };
    our %table2filelist = (
      $o->( file => 'Name' ),
      $o->( size => 'Size' ),
      $o->( tth  => 'TTH' ),
      $o->( time => 'TS' ),
      $o->( hit  => 'HIT' ),
      $o->( sch  => 'SCH' )
    );
    #warn Dumper   \%o, \%table2filelist;
    my $filelist_line = sub($) {
      for my $f (@_) {
        next if !length $f->{file} or !length $f->{'tth'};
        #$f = {%$f};
        $sharesize += $f->{size};
        ++$sharefiles if $f->{size};
        #$f->{file} = Encode::encode( 'utf8', Encode::decode( $self->{charset_fs}, $f->{file} ) ) if $self->{charset_fs};
        psmisc::file_append $self->{files}, "\t" x $level,
          #qq{<File Name="$f->{file}" Size="$f->{size}" TTH="$f->{tth}" TS="$f->{time}"/>\n};
          qq{<File}, (
          map { qq{ $table2filelist{$_}="} . psmisc::html_chars( $a = $f->{$_} ) . qq{"} }
          sort { $o{$a} <=> $o{$b} } grep { $table2filelist{$_} and $f->{$_} } keys %$f
          ),
          qq{/>\n};
        #$self->{share_full}{ $f->{tth} } = $f->{full} if $f->{tth};    $self->{share_full}{ $f->{file} } ||= $f->{full};
        $f->{'full'} ||= $f->{'path'} . '/' . $f->{'file'};
HideShow 7 lines of Pod
=cu
      $self->{share_full}{ $f->{'tth'} } = $f->{'full_local'}, $self->{share_tth}{ $f->{'full_local'} } = $f->{'tth'},
        $self->{share_tth}{ $f->{'file'} } = $f->{'tth'},
        if $f->{'tth'};
      $self->{share_full}{ $f->{'file'} } ||= $f->{'full_local'};
=cut
  #$self->log 'set share', "[$f->{file}], [$f->{tth}] = [$self->{share_full}{ $f->{tth} }],[$self->{share_full}{ $f->{file} }]";
  #$self->log Dumper $self->{share_full};
      }
    };
    my $scandir;
    $scandir = sub (@) {
      for my $dir (@_) {
        #$self->log( 'scandir', $dir, 'charset', $self->{charset_fs} );
        #$self->log( 'warn', 'stopscan', $stopscan),
        last if $stopscan;
        $dir =~ tr{\\}{/};
        $dir =~ s{/+$}{};
        opendir( my $dh, $dir ) or ( $self->log( 'err', "can't opendir [$dir]: $!\n" ), next );
        #$self->log( 'dev','sd', __LINE__,$dh);
        #@dots =
        ( my $dirname = $dir );
        $dirname =
          #Encode::encode 'utf8',
          Encode::decode $self->{charset_fs}, $dirname, Encode::FB_WARN if $self->{charset_fs};
        #$self->log( 'dev','sd', __LINE__,$dh);
        next if skip( $dirname, $self->{skip_dir} ) or ( $self->{skip_symlink} and -l $dirname );
        unless ($level) {
          for ( split '/', $dirname ) {
            psmisc::file_append( $self->{files}, "\t" x $level, qq{<Directory Name="$_">\n} ), ++$level, if length $_;
          }
        } else {
          $dirname =~
            #W s/^\w://;
            #$dirname =~
            s{.*/}{};
          psmisc::file_append( $self->{files}, "\t" x $level, qq{<Directory Name="$dirname">\n} ), ++$level, ++$levelreal,
            if length $dirname;
        }
        #$self->log( 'dev','sd', __LINE__,$dh);
        #Net::DirectConnect::
        psmisc::schedule( [ 10, 10 ], our $my_every_10sec_sub__ ||= sub { $printinfo->() } );
        #$self->log( 'readdir', );
      FILE: for my $file ( readdir($dh) ) {
          #$self->log( 'scanfile', $file, );
          #$self->log( 'warn', 'stopscan', $stopscan),
          last if $stopscan;
          next if $file =~ /^\.\.?$/;
          #$file = Encode::encode( 'utf8', Encode::decode( $self->{charset_fs}, $file ) ) if $self->{charset_fs};
          my $f = { path => $dir, path_local => $dir, file => $file, file_local => $file, full_local => "$dir/$file", };
          #$f->{full_local} = "$f->{path_local}/$f->{file_local}";
          #print("d $f->{full}:\n"),
          $f->{dir} = -d $f->{full_local};
          #filelist_line($f),
          if ( $f->{dir} ) {
            #next  FILE if  skip ($f->{file}, $self->{skip_dir});
            $scandir->( $f->{full_local} );
            next;
          }
          $f->{size} = -s $f->{full_local} if -f $f->{full_local};
          next if $f->{size} < $self->{file_min};
          $f->{file} =    #Encode::encode 'utf8',
            Encode::decode $self->{charset_fs}, $f->{file}, Encode::FB_WARN if $self->{charset_fs};
          $f->{path} =    #Encode::encode 'utf8',
            Encode::decode $self->{charset_fs}, $f->{path}, Encode::FB_WARN if $self->{charset_fs};
          next FILE if skip( $f->{file}, $self->{skip_file} ) or ( $self->{skip_symlink} and -l $f->{file} );
          #$self->log( 'encfile', $f->{file} , "chs:$self->{charset_fs}");
          $f->{full} = "$f->{path}/$f->{file}";
          $f->{time} = int( $^T - 86400 * -M $f->{full_local} );    #time() -
#$self->log 'timed', $f->{time}, psmisc::human('date_time', $f->{time}), -M $f->{full_local}, int (86400 * -M $f->{full_local}), $^T;
#'res=',
#join "\n",     grep { !/^\.\.?/ and
#/^\./ &&     -f "$dir/$_"     }
#print " ", $file;
#todo - select not all cols
#         $self->log('preselect', $self->{no_sql});
          unless ( $self->{no_sql} ) {
            #$self->log('select go',);# Dumper $f);
            my $indb =
              $self->{db}->line( "SELECT * FROM ${tq}filelist${tq} WHERE"
                . " ${rq}path${rq}="
                . $self->{db}->quote( $f->{path} )
                . " AND ${rq}file${rq}="
                . $self->{db}->quote( $f->{file} )
                . " AND ${rq}size${rq}="
                . $self->{db}->quote( $f->{size} )
                . " AND ${rq}time${rq}="
                . $self->{db}->quote( $f->{time} )
                . " LIMIT 1" );
            #$self->log('select', Dumper $indb);
            #$self->log ('dev', 'already scaned', $indb->{size}),
            $filelist_line->( { %$f, %$indb } ), next, if $indb->{size} ~~ $f->{size};
            #$db->select('filelist', {path=>$f->{path},file=>$f->{file}, });
            #$self->log Dumper ;
            #print "\n";
            #my $tth;
            if ( $f->{size} > $self->{tth_cheat} ) {
              my $indb =
                $self->{db}->line( "SELECT * FROM ${tq}filelist${tq} WHERE "
                  . "${rq}file${rq}="
                  . $self->{db}->quote( $f->{file} )
                  . " AND ${rq}size${rq}="
                  . $self->{db}->quote( $f->{size} )
                  . ( $self->{tth_cheat_no_date} ? () : " AND ${rq}time${rq}=" . $self->{db}->quote( $f->{time} ) )
                  . " LIMIT 1" );
              #$self->log 'sel', Dumper $indb;
              if ( $indb->{tth} ) {
                $self->log( 'dev', "already summed", %$f, '     as    ', %$indb );
                $f->{$_} ||= $indb->{$_} for keys %$indb;
                #filelist_line($f);
                #next;
              }
            }
          }
          if ( !$notth and !$f->{tth} ) {
            #$self->log 'calc', $f->{full}, "notth=[$notth]";
            my $time = time();
            $f->{tth} = Net::DirectConnect::TigerHash::tthfile( $f->{full_local} );
            my $per = time - $time;
            $self->log(
              'time', $f->{full}, psmisc::human( 'size', $f->{size} ),
              'per', psmisc::human( 'time_period', $per ),
              'speed ps', psmisc::human( 'size', $f->{size} / ( $per or 1 ) ),
              'total', psmisc::human( 'size', $sharesize )
              )
              if
              #$f->{size} > 100_000 or
              $per > 1;
          }
          #$f->{tth} = $f->{size} > 1_000_000 ? 'bigtth' : tthfile( $f->{full} );    #if -f $full;
          #print Dumper $self->{share_full};
          #next;
          #print ' ', tthfile($full) if -f $full ; #and -s $full < 1_000_000;
          #print ' ', $f->{tth};
          #print ' ', $f->{size};    #if -f $f->{full};
          #print join ':',-M $f->{full}, $^T + 86400 * -M $f->{full},$f->{time};
          #print "\n";
          $filelist_line->($f);
          $self->{db}->insert_hash( 'filelist', $f ) if !$self->{no_sql} and $f->{tth};
        }
        --$level;
        --$levelreal;
        psmisc::file_append $self->{files}, "\t" x $level, qq{</Directory>\n};    #<!-- $levelreal $level -->
        closedir $dh;
      }
      if ( $levelreal < 0 ) {
        #psmisc::file_append $self->{files}, "<!-- backing to root $levelreal $level -->\n";
        psmisc::file_append $self->{files}, "\t" x $level, qq{</Directory>\n} while --$level >= 0;
        $levelreal = $level = 0;
      }
      #$level
    };
    #else {
    $self->log(
      'info', "making filelist $self->{files} from",
      @_, @{ $self->{'share'} || [] },
      'EXISTS=',
      grep { -d } @_,
      @{ $self->{'share'} || [] },
    );
    #$self->{db}->do('ANALYZE filelist') unless $self->{no_sql};
    $self->{db}->analyze('filelist') unless $self->{no_sql};
    local %_;
    $scandir->($_) for ( grep { !$_{$_}++ and -d } @_, @{ $self->{'share'} || [] }, );
    #undef $SIG{INT};
    #undef $SIG{INFO};
    psmisc::file_append $self->{files}, qq{</FileListing>};
    psmisc::file_append $self->{files};
    $self->{db}->flush_insert() unless $self->{no_sql};
    local $_;
    if (
      psmisc::use_try 'IO::Compress::Bzip2'
      and ($_ = !IO::Compress::Bzip2::bzip2( $self->{files} => $self->{files} . '.bz2' )
        or $self->log( "bzip2 failed: ", $IO::Compress::Bzip2::Bzip2Error ) and 0 )
      )
    {
      #$self->log('bzip',$self->{files} => $self->{files} . '.bz2');
      () = $IO::Compress::Bzip2::Bzip2Error;    #no warning
    } else {
      $self->log( 'dev', 'using system bzip2', $_, $!, ':', `bzip2 --force --keep "$self->{files}"` );
    }
#unless $interrupted;
#$self->{share_full}{ $self->{files} . '.bz2' } = $self->{files} . '.bz2';  $self->{share_full}{ $self->{files} } = $self->{files};
#}
    psmisc::unlock('sharescan');
    $printinfo->();
    #$SIG{INT} = $SIG{KILL} = undef;
    return ( $sharesize, $sharefiles );
  };
  $self->{share_add_file} //= sub {
    my $self = shift if ref $_[0];
    my ( $full_local, $tth, $file ) = @_;
    $full_local =~ m{([^/\\]+)$} unless $file;
    $file //= $1;    # unless length $file;
                     #$full_local = Encode::encode $self->{charset_fs}, Encode::decode 'utf8', $full_local;
    $self->{share_full}{$tth} = $full_local, $self->{share_tth}{$full_local} = $tth, $self->{share_tth}{$file} = $tth, if $tth;
    $self->{share_full}{$file} ||= $full_local if $file;
    #$self->share_changed();
  };
  $self->{share_changed} //= sub {
    my $self = shift if ref $_[0];
    #$self->log('dev', "share_changed");
    if ( $self->{'status'} eq 'connected' ) {
      if ( $self->{adc} ) { $self->cmd( 'I', 'INF', undef, 'SS', 'SF' ); }
      else                { $self->cmd('MyINFO'); }
    }
  };
  $self->{filelist_load} //= sub {    #{'cmd'}
    my $self = shift if ref $_[0];
    $self->log( 'err', 'forced db upgrade on load' ), $self->{db}->upgrade() if $self->{upgrade_force};
HideShow 18 lines of Pod
=old
  if ( $config{filelist} and open my $f, '<', $config{filelist} ) {
    $self->log "loading filelist..";
    local $/ = '<';
    while (<$f>) {
      if ( my ( $file, $time, $tiger ) = /^File Name="([^"]+)" TimeStamp="(\d+)" Root="([^"]+)"/i ) {
        #$self->{'share_tth'}{ $params->{TR} }
        $file =~ tr{\\}{/};
        $self->{share_full}{$tiger} = $file;
        $self->{share_tth}{$file}   = $tiger;
      }
      #<File Name="c:\distr\neo\tmp" TimeStamp="1242907656" Root="3OPSFH2JD2UPBV4KIZAPLMP65DSTMNZRTJCYR4A"/>
    }
    close $f;
    $self->log ".done:", ( scalar keys %{ $self->{share_full} } ), "\n";
  }
=cut
    #$self->log( "filelist_load try", $global{shareloaded}, -s $self->{files}, );    #ref $_[0]
    return
      if !$self->{files}
        or $Net::DirectConnect::global{shareloaded} == -s $self->{files}
        or
        ( $Net::DirectConnect::global{shareloaded} and !psmisc::lock( 'sharescan', readonly => 1, timeout => 0, old => 86400 ) )
        or !open my $f, '<:encoding(utf8)', $self->{files};
    my ( $sharesize, $sharefiles );
    #$self->log( 'info', "loading filelist", -s $f );
    $Net::DirectConnect::global{shareloaded} = -s $f;
    local $/ = '<';
    %{ $self->{share_full} } = %{ $self->{share_tth} } = ();
    my $dir;
    while (<$f>) {
      #<Directory Name="distr">
      #<File Name="3470_2.x.rar" Size="18824575" TTH="CL3SVS5UWWSAFGKCQZTMGDD355WUV2QVLNNADIA"/>
      if ( my ( $file, $size, $tth, $ts ) = m{^File Name="([^"]+)" Size="(\d+)" TTH="([^"]+)"}i ) {
        my $full_local = ( my $full = "$dir/$file" );
        #$self->log 'loaded', $dir, $file  , $full;
        #$full_local = Encode::encode $self->{charset_fs}, $full if $self->{charset_fs};
        $full_local = Encode::encode $self->{charset_fs},
          #Encode::decode 'utf8',
          $full_local, Encode::FB_WARN;
        $self->share_add_file( $full_local, $tth, $file );
        ++$sharefiles;
        $sharesize += $size;
        #$self->{'share_tth'}{ $params->{TR} }
        #$file =~ tr{\\}{/};
      } elsif ( my ($curdir) = m{^Directory Name="([^"]+)">}i ) {
        $dir .= ( ( !length $dir and $^O ~~ [ 'MSWin32', 'cygwin' ] ) ? () : '/' ) . $curdir;
        #$self->log 'now in', $dir;
        #$self->{files}
      } elsif (m{^/Directory>}i) {
        $dir =~ s{(?:^|/)[^/]+$}{};
        #$self->log 'now ba', $dir;
      }
    }
    $self->{share_full}{ $self->{files} . '.bz2' } = $self->{files} . '.bz2';
    $self->{share_full}{ $self->{files} } = $self->{files};
    #    $self->{'INF'}{'SS'} = $self->{'sharesize'} = $sharesize;
    #    $self->{'INF'}{'SF'} = $sharefiles;
    $self->log(
      'info',
      "loaded filelist size",
      $Net::DirectConnect::global{shareloaded},
      ' : files=', $sharefiles, 'bytes=',
      psmisc::human( 'size', $sharesize ),
      scalar keys %{ $self->{share_full} },
      "bzsize=", -s $self->{files} . '.bz2',
    );
    psmisc::unlock('sharescan');
    #$_[0]->( $sharesize, $sharefiles ) if ref $_[0] ~~ 'CODE';
    #( $self->{share_size} , $self->{share_files} ) = ( $sharesize, $sharefiles );
    $sharefiles *= $self->{sharefiles_mul} if $self->{sharefiles_mul};
    $sharefiles += $self->{sharefiles_add};
    $sharesize *= $self->{sharesize_mul} if $self->{sharesize_mul};
    $sharesize += $self->{sharesize_add};
    $self->{sharefiles} = $self->{INF}{SF} = $sharefiles, $self->{INF}{SS} = $self->{sharesize} = $sharesize, if $sharesize;
    $self->share_changed();
    return ( $sharesize, $sharefiles );
  };
  $self->{search_stat_update} = sub {
    my $self = shift if ref $_[0];
    my $tth = shift or return;
    my $field = shift || 'hit';
    my $updated = $self->{db}->do(
      "UPDATE ${tq}filelist${tq} SET ${rq}$field${rq}=${rq}$field${rq}+${vq}1${vq} WHERE "
        #$self->{db}->do( "UPDATE ${tq}filelist${tq} SET ${rq}$field${rq}=${rq}$field${rq}+1 WHERE "
        #$self->{db}->do( "UPDATE ${tq}filelist${tq} SET $field=$field+1 WHERE "
        . "${rq}tth${rq}=" . $self->{db}->quote($tth)
        #. ( $self->{db}{no_update_limit} ? () : " LIMIT ${vq}2${vq}" ) );
        . ( $self->{db}{no_update_limit} ? () : " LIMIT 1" )
    );
    $self->log( 'dev', "counter $field increased[$updated] on [$tth]" ) if $updated;
  };
  $self->{handler_int}{Search} //= sub {
    my $self = shift if ref $_[0];
    #$self->log ( 'dev', 'Search stat', Dumper @_) ;
    #$self->log ( 'dev', 'Search stat', Dumper $_[1]{tth}) ;
    $self->search_stat_update( $_[1]{tth}, 'sch' );
  };
  $self->{handler_int}{SCH} //= sub {
    my $self = shift if ref $_[0];
    #$self->log ( 'dev', 'SCH stat', Dumper @_) ;
    $self->search_stat_update( $_[-1]{TR}, 'sch' );
  };
  $self->{'periodic'}{ __FILE__ . __LINE__ } = sub {
    my $self = shift if ref $_[0];
    #$self->log (  'periodic in filelist', $self->{filelist_scan}, caller );
    psmisc::schedule(
      #[10, $self->{filelist_scan}],
      $self->{filelist_scan},
      our $sharescan_sub__ ||= sub {
        my $self = shift;
        $self->log(
          'info',
          'filelist actual age seconds:',
          ( time - $^T + 86400 * -M $self->{files} ),
          '<', $self->{filelist_scan}
        );
        return
          if -e $self->{files}
            and -s $self->{files} > 200
            and $self->{filelist_scan} > time - $^T + 86400 * -M $self->{files};
        #$self->log( 'starter==','$0=',$0, $INC{'Net/DirectConnect/filelist.pm'}, $^X, 'share=', @{ $self->{'share'} } );
        #$0 !~ m{(.*\W)?share.pl$}
        $self->{'filelist_builder'} ? psmisc::start $self->{'filelist_builder'}, @{ $self->{'share'} } : psmisc::start $^X,
          $INC{'Net/DirectConnect/filelist.pm'}, @{ $self->{'share'} };
        #: psmisc::startme( 'filelist', grep { -d } @ARGV );
      },
      $self
    ) if $self->{filelist_scan};
    #Net::DirectConnect::
    psmisc::schedule(
      #10,    #dev! 300!
      $self->{filelist_reload},
      #our $filelist_load_sub__ ||=
      sub {
        my $self = shift;
        #psmisc::startme( 'filelist', grep { -d } @ARGV );
        #my($sharesize,$sharefiles) =
        $self->filelist_load(
          #sub {
          #my ( $sharesize, $sharefiles ) = @_;
          #$dc->{INF}{SS} = $sharesize, $dc->{INF}{SF} = $sharefiles, $dc->{sharesize} = $sharesize, if $sharesize;
##todo! change INF cmd or myinfo
          #}
        );
      },
      $self
    ) if $self->{filelist_scan};
    },
    #psmisc::startme( 'filelist', grep { -d } @ARGV )  if  !-e $config{files} or !-e $config{files}.'.bz2';
    $self->{handler_int}{file_recieved} = sub {
    my $self = shift if ref $_[0];
    my ( $full, $filename ) = @_;
    #$self->{'file_recv_tth'} =
    my ($tth) = $filename =~ m{^TTH/(\w+)};
HideShow 11 lines of Pod
=z
return unless $tth;
$self->{share_full}{$tth} = $as;
my ($name) = $as =~   m{^([^/\\]+)$};
return unless $name;
        $self->{share_full}{$tth} = $full_local, $self->{share_tth}{$full_local} = $tth, $self->{share_tth}{$file} = $tth,
          if $tth;
        $self->{share_full}{$file} ||= $full_local;
=cut
    $self->log( 'dev', 'adding downloaded file to share', $full, $tth ),
      $self->share_add_file( $full, $tth ), $self->share_changed()
      if !$self->{'file_recv_filelist'} and !$self->{'no_auto_share_downloaded'};  # unless $self->{'no_auto_share_downloaded'};
         #TODO          $self->{db}->insert_hash( 'filelist', $f ) if !$self->{no_sql} and $f->{tth};
    ;
    };
  $self->filelist_load() unless $standalone;    # (caller)[0] ~~ __PACKAGE__;
                                                #$self->log('initok');
  return $self;
}
eval q{ #do
  use lib '../..';
  use Net::DirectConnect;
  print "making\n";
  __PACKAGE__->new(@ARGV)->{db}->upgrade(), exit if $ARGV[0] eq 'upgrade';
  __PACKAGE__->new(@ARGV)->filelist_make(@ARGV),;
}, print $@ unless caller;
1;