view release on metacpan or  search on metacpan

bin/elog  view on Meta::CPAN

        $e->{referer} = $2;
    }
    else {
        $e->{mesg} = $line;
    }
    return $e;
}

# For dates that look like "Tue Sep 08 13:58:21.123456 2015"
sub parse_date {
    my ($str) = @_;
    return () if !$str;
    $str =~ m{^(\w+) \s+ (\w+) \s+ (\d+) \s+ (\d+) : (\d+) : (\d+) (\.(\d+))? \s+ (\d+)}x
        or die "Can't parse date \"$str\"\n";
    my $dow = $1;
    my $monthstr = $2;
    my $day = $3;
    my $hour = $4;
    my $min = $5;
    my $sec = $6;
    my $usec = $8;
    my $year = $9;
    my $month = $months{$monthstr} or die "Unknown month $monthstr\n";
    my $time = POSIX::mktime($sec, $min, $hour, $day, $month - 1, $year - 1900, 0, 0, -1);
    return $time;
}

sub same_error {
    my ($e1, $e2) = @_;
    if (!$e1 || !$e2) {
        return 0;
    }
    elsif (!$e1->{date} && !$e2->{date}) {
        return 1;
    }
    elsif ($e1->{pid} && $e2->{pid}) {
        if ($e1->{pid} eq $e2->{pid}) {
            return 1;
        }
        else {
            return 0;
        }
    }
    elsif (
        $e1->{date} eq $e2->{date} &&
        $e1->{type} eq $e2->{type} &&
        $e1->{client} eq $e2->{client} &&
        $e1->{script} eq $e2->{script}
    ) {
        return 1;
    }
    else {
        return 0;
    }
}

sub show_list {
    for my $log (@logs) {
        my $selected = $log->{selected} ? "*" : " ";
        my $size = "-";
        my $updated = "";
        if (-e $log->{file}) {
            $size = human_readable(-s $log->{file});
            my $mtime = (stat($log->{file}))[9];
            $updated = time_diff_str($mtime, $now);
        }
        my $file = $log->{file};
        my $line = sprintf "%s %-60s %-10s %s", $selected, $file, $size, $updated;
        print "$line\n";
    }
}

sub show_detailed_list {
    for my $log (@logs) {
        my $size = "-";
        my $updated = "";
        if (-e $log->{file}) {
            $size = human_readable(-s $log->{file});
            my $mtime = (stat($log->{file}))[9];
            $updated = datestr($mtime) . " (" . time_diff_str($mtime, $now) . ")";
        }
        my $vhost = $log->{vhost};
        print "$log->{file}\n";
        if ($log->{selected}) {
            print "    selected\n";
        }
        print "    size $size\n";
        if ($updated) {
            print "    updated $updated\n";
        }
        if ($vhost) {
            if ($vhost->{file}) {
                print "    config $vhost->{file}\n";
            }
            if ($vhost->{docroot}) {
                print "    docroot $vhost->{docroot}\n";
            }
            if ($vhost->{absdocroot}) {
                print "    absdocroot $vhost->{absdocroot}\n";
            }
        }
        my $rotations = get_rotations($log->{file});
        for my $r (@$rotations) {
            my $size = human_readable(-s $r->{file});
            my $mtime = (stat($r->{file}))[9];
            my $updated = datestr($mtime) . " (" . time_diff_str($mtime, $now) . ")";
            print "    rotation $r->{name} $size $updated\n";
        }
    }
}

sub human_readable {
    my ($size) = @_;
    my @power = ("B", "KB", "MB", "GB", "TB", "PB", "EB", "ZB", "YB");
    my $i = 0;
    my $abs_size = abs $size;
    for ($i = 0; $i < @power; $i++) {
        last if $abs_size < 1024;
        $abs_size /= 1024;
    }
    my $str = sprintf("%.1f %s", $abs_size, $power[$i]);
    $str =~ s/\.0//;
    $str = "-$str" if $size < 0;
    return $str;
}

sub select_log {
    my $name = $opts{name};
    if ($name) {
        my $regex = qr/^$name/;
        for my $log (@logs) {
            if ($log->{name} eq $name || $log->{file} eq $name || $log->{name} =~ $regex) {
                select_log_rotation($log);
                last;
            }
        }
        # If the name doesn't match one of the discovered log files,
        # treat it as a filename.
        if (!$selected_log) {
            my $log = add_log($name);
            select_log_rotation($log);
        }
        return;
    }

    # Select the log that is for the docroot closest to your current
    # working directory, it's not just a contained directory of the
    # docroot, because you can be one level above the docroot, you
    # would still want the error log for it. for example, you were in
    # /home/username123/www/foo.com and the log is for a docroot at
    # /home/username123/www/foo.com/public_html. Also you could be in
    # /home/username123/www/foo.com/public_html/images. So it will choose the
    # log with the most characters at the beginning matching.
    #
    # We make sure to append a / to directory names to ensure we choose
    # the exact matching directory when two exist with same prefix for
    # example you were in /www/foo.com and there are logs for docroots
    # /www/foo.com and /www/foo.comYEP, you want to see the log for
    # /www/foo.com.
    if (@logs) {
        my $cwd = Cwd::cwd();
        $cwd .= "/" if $cwd !~ m{/$};
        for my $log (@logs) {
            my $docroot = "";
            if ($log->{vhost} && $log->{vhost}{absdocroot}) {
                $docroot = $log->{vhost}{absdocroot} . "/";
            }