config root man

Current Path : /usr/opt/perl530/lib/site_perl/5.30.2/ADN/

FreeBSD hs32.drive.ne.jp 9.1-RELEASE FreeBSD 9.1-RELEASE #1: Wed Jan 14 12:18:08 JST 2015 root@hs32.drive.ne.jp:/sys/amd64/compile/hs32 amd64
Upload File :
Current File : //usr/opt/perl530/lib/site_perl/5.30.2/ADN/Watch.pm

package ADN::Watch;
#
# Watch.pm:
#

#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// use Module
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

use strict;
use Exporter;
use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION );

#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Exporting
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

@ISA       = qw( Exporter );
$VERSION   = 1.00;

@EXPORT    = qw( );
@EXPORT_OK = qw( );

#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Module
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

sub conflict {
    my ($item, $pass) = @_;

    unless ($pass) { $pass = 3; }

    my $work = $item->{work};
    my $run  = $item->{file} . '.run';

    if ( -e $work ) {
        open READ, "<$work";
        my @list = <READ>;
        close READ;

        my $ps0   = $list[0];
        my $check = 0;

        my @ps = `$item->{ps} -ax | $item->{awk} '{print \$1}' | $item->{grep} -iv PID`;

        foreach (@ps) {
            if ($ps0 == $_) {
                $check = 1;
                last;
            }
        }

        if ($check == 0) {   #// Ctrl-C or Reboot ?
            if ( -e $run ) { unlink($run); }

            working($item, $work, $$);
            return undef;
        }

        if ( -e $run ) {
            my $num = `$item->{cat} $run`; chomp $num;

            if ($num >= $pass - 1) {
                unlink($run);

                $item->{num}  = $num + 1;
                $item->{time} = ADN::Utility::utime2date(time());

                report($item);

            } else {
                working($item, $run, ($num + 1));
            }

        } else {
            working($item, $run, 1);
        }

        print "Another Process is Running?\n";
        exit;

    } else {
        if ( -e $run ) { unlink($run); }

        working($item, $work, $$);
    }
}

sub working {
    my ($item, $file, $num) = @_;

    open  WRITE, "+>$file";
    print WRITE $num;
    close WRITE;

    `$item->{chmod} 640 $file`;
}

sub report {
    my ($item) = @_;

    my $host = `$item->{hostname}`; chomp $host;

    my $file = $item->{file} . '.report';
    my $subj = "Info: $item->{base} ($host)";

    my $body = <<"BODY";
$item->{time}  $item->{num} times passed. ($0) 
BODY

    open  FILE, "+>$file";
    print FILE $body;
    close FILE;

    `$item->{mail} -s "$subj" $item->{maddr} < $file`;

    unlink($file);
}

#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Module (require)
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

sub log_make {
    my ($item) = @_;

    my $utime = time();
    my $time  = ADN::Utility::utime2date($utime);
    my $time0 = substr(ADN::Utility::utime2date($utime), 0, 10);
    my $file  = $time0; $file =~ s/\///g;

    $item->{log}   = $item->{dir} . $file;
    $item->{utime} = $utime;
    $item->{time}  = $time;
    $item->{time0} = $time0;

    return $item;
}

sub log_last {
    my ($item) = @_;

    my $num = 0;

    #// log_subj, log_mode for bfcheck.pl

    if ( -e $item->{log} ) {
        my $str = `$item->{head} -1 $item->{log}`;

        chomp $str;
        $str =~ s/([\s\t]+)/ /g;

        if ($str =~ /$item->{delim} (.+)/) {
            $num = $1;
        }

        $item->{log_subj} = $item->{log};

    } else {
        `$item->{touch} $item->{log}`;

        my $time  = ADN::Utility::date2utime("$item->{time0} 00:00:00");
        my $time0 = substr(ADN::Utility::utime2date($time - 1), 0, 10);
        my $file0 = $time0; $file0 =~ s/\///g;

        my $log = $item->{dir} . $file0;

        if ( -e $log ) {
            my $str = `$item->{head} -1 $log`;

            chomp $str;
            $str =~ s/([\s\t]+)/ /g;

            if ($str =~ /$item->{delim} (.+)/) {
                $num = $1;
            }

            $item->{log_subj} = $log;
            $item->{log_mode} = 1;
        }
    }

    $item->{last_line} = $num;

    return $item;
}

sub log_count {
    my ($item) = @_;

    my $num = `$item->{wc} -l $item->{target} | $item->{awk} '{print \$1}'`;
    chomp $num;

    return $num;
}

1;

Man Man