util.pm

1. 记录每个帖子的访问人情况

# Copyright 2001-2005 Six Apart.
# SCRiPTMAFiA 2005 - THE DiRTY HANDS ON YOUR SCRiPTS
#
# $Id: Util.pm 10838 2005-03-30 23:55:20Z ezra $

package MT::Util;
use strict;

use MT::ConfigMgr;
use MT::Request;
use Exporter;
@MT::Util::ISA = qw( Exporter );
use vars qw( @EXPORT_OK );
@EXPORT_OK = qw( start_end_day start_end_week start_end_month
                 start_end_period week2ymd munge_comment
                 html_text_transform encode_html decode_html
                 iso2ts offset_time offset_time_list first_n_words
                 archive_file_for format_ts dirify remove_html
                 days_in wday_from_ts encode_js get_entry spam_protect
                 is_valid_email encode_php encode_url decode_url encode_xml
                 decode_xml is_valid_url discover_tb convert_high_ascii 
		 mark_odd_rows dsa_verify perl_sha1_digest
		 perl_sha1_digest_hex dec2bin bin2dec xliterate_utf8 
                 start_background_task launch_background_tasks substr_wref );

sub leap_day {
    my ($y, $m, $d) = @_;
    return $m == 2 && $d == 29 &&
        ($y % 4 == 0) && ($y % 100 != 0 || $y % 400 == 0);
}

sub leap_year {
    my $y = shift;
    return ($y % 4 == 0) && ($y % 100 != 0 || $y % 400 == 0);
}

{
    my @In_Year = (
        [ 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 ],
        [ 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366 ],
    );

    sub wday_from_ts {
        my($y, $m, $d) = @_;
        my $leap = leap_year($y) ? 1 : 0;
        $y--;

        ## Copied from Date::Calc.
        my $days = $y * 365;
        $days += $y >>= 2;
        $days -= int($y /= 25);
        $days += $y >> 2;
        $days += $In_Year[$leap][$m-1] + $d;
        $days % 7;
    }

    sub yday_from_ts {
        my($y, $m, $d) = @_;
        my $leap = $y % 4 == 0 && ($y % 100 != 0 || $y % 400 == 0) ? 1 : 0;
        $In_Year[$leap][$m-1] + $d;
    }
}

sub iso2ts {
    my($blog, $iso) = @_;
    return undef
        unless $iso =~ /^(\d{4})(?:-?(\d{2})(?:-?(\d\d?)(?:T(\d{2}):(\d{2}):(\d{2})(?:\.\d+)?(Z|[+-]\d{2}:\d{2})?)?)?)?/;
    my($y, $mo, $d, $h, $m, $s, $offset) =
        ($1, $2 || 1, $3 || 1, $4 || 0, $5 || 0, $6 || 0, $7);
    if ($offset && !MT::ConfigMgr->instance->IgnoreISOTimezones) {
        $mo--;
        $y -= 1900;
        my $time = timegm($s, $m, $h, $d, $mo, $y);
        ## If it's not already in UTC, first convert to UTC.
        if ($offset ne 'Z') {
            my($sign, $h, $m) = $offset =~ /([+-])(\d{2}):(\d{2})/;
            $offset = $h * 3600 + $m * 60;
            $offset *= -1 if $sign eq '-';
            $time -= $offset;
        }
        ## Now apply the offset for this weblog.
        ($s, $m, $h, $d, $mo, $y) = offset_time_list($time, $blog);
        $mo++;
        $y += 1900;
    }
    sprintf "%04d%02d%02d%02d%02d%02d", $y, $mo, $d, $h, $m, $s;
}

use Time::Local qw( timegm );
sub ts2iso {
    my ($blog, $ts) = @_;
    my ($yr, $mo, $dy, $hr, $mn, $sc) = unpack('A4A2A2A2A2A2A2', $ts);
    $ts = timegm($sc, $mn, $hr, $dy, $mo-1, $yr-1900);
    ($sc, $mn, $hr, $dy, $mo, $yr) = offset_time_list($ts, $blog, '-');
    $yr += 1900;
    $mo += 1;
    sprintf("%04d-%02d-%02dT%02d:%02d:%02dZ", $yr, $mo, $dy, $hr, $mn, $sc);
}

sub ts2epoch {
    my ($blog, $ts) = @_;
    my ($yr, $mo, $dy, $hr, $mn, $sc) = unpack('A4A2A2A2A2A2A2', $ts);
    $ts = timegm($sc, $mn, $hr, $dy, $mo-1, $yr-1900);
}

# substring treating HTML character-entity references as single characters
sub substr_wref {
    my ($str, $start, $width) = @_;
    my @character_entities = $str =~ /(&[^;]*;|.)/g;
    join '', @character_entities[$start..$start+$width-1];
}

use vars qw( %Languages );
sub format_ts {
    my($format, $ts, $blog, $lang) = @_;
    my %f;
    unless ($lang) {
        $lang = $blog && $blog->language ? $blog->language : 'en';
    }
    unless (defined $format) {
        $format = $Languages{$lang}[3] || "%B %e, %Y %I:%M %p";
    }
    my $cache = MT::Request->instance->cache('formats');
    unless ($cache) {
        MT::Request->instance->cache('formats', $cache = {});
    }
    if (my $f_ref = $cache->{$ts . $lang}) {
        %f = %$f_ref;
    } else {
        my $L = $Languages{$lang};
        my @ts = @f{qw( Y m d H M S )} = unpack 'A4A2A2A2A2A2', $ts;
        $f{w} = wday_from_ts(@ts[0..2]);
        $f{j} = yday_from_ts(@ts[0..2]);
        $f{'y'} = substr $f{Y}, 2;
        $f{b} = substr_wref $L->[1][$f{'m'}-1] || '', 0, 3;
        $f{B} = $L->[1][$f{'m'}-1];
        $f{a} = substr_wref $L->[0][$f{w}] || '', 0, 3;
        $f{A} = $L->[0][$f{w}];
        ($f{e} = $f{d}) =~ s!^0! !;
        $f{I} = $f{H};
        $f{I} = $f{H};
        if ($f{I} > 12) {
            $f{I} -= 12;
            $f{p} = $L->[2][1];
        } elsif ($f{I} == 0) {
            $f{I} = 12;
            $f{p} = $L->[2][0];
        } elsif ($f{I} == 12) {
            $f{p} = $L->[2][1];
        } else {
            $f{p} = $L->[2][0];
        }
        $f{I} = sprintf "%02d", $f{I};
        ($f{k} = $f{H}) =~ s!^0! !;
        ($f{l} = $f{I}) =~ s!^0! !;
        $f{j} = sprintf "%03d", $f{j};
        $f{Z} = '';
        $cache->{$ts . $lang} = \%f;
    }
    my $date_format = $Languages{$lang}->[4] || "%B %d, %Y";
    my $time_format = $Languages{$lang}->[5] || "%I:%M %p";
    $format =~ s!%x!$date_format!g;
    $format =~ s!%X!$time_format!g;
    ## This is a dreadful hack. I can't think of a good format specifier
    ## for "%B %Y" (which is used for monthly archives, for example) so
    ## I'll just hardcode this, for Japanese dates.
    if ($lang eq 'jp') {
        $format =~ s!%B %Y!$Languages{$lang}->[6]!g;
    }
    $format =~ s!%(\w)!$f{$1}!g if defined $format;
    $format;
}

{
    my @Days_In = ( -1, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
    sub days_in {
        my($m, $y) = @_;
        return $Days_In[$m] unless $m == 2;
        return $y % 4 == 0 && ($y % 100 != 0 || $y % 400 == 0) ?
            29 : 28;
    }
}

sub start_end_period {
    my $at = shift;
    if ($at eq 'Individual') {
        return $_[0];
    } elsif ($at eq 'Daily') {
        return start_end_day(@_);
    } elsif ($at eq 'Weekly') {
        return start_end_week(@_);
    } elsif ($at eq 'Monthly') {
        return start_end_month(@_);
    } 
}

sub start_end_day {
    my $day = substr $_[0], 0, 8;
    return $day . '000000' unless wantarray;
    ($day . "000000", $day . "235959");
}

sub start_end_week {
    my($ts) = @_;
    my($y, $mo, $d, $h, $m, $s) = unpack 'A4A2A2A2A2A2', $ts;
    my $wday = wday_from_ts($y, $mo, $d);
    my($sd, $sm, $sy) = ($d - $wday, $mo, $y);
    if ($sd < 1) {
        $sm--;
        $sm = 12, $sy-- if $sm < 1;
        $sd += days_in($sm, $sy);
    }
    my $start = sprintf "%04d%02d%02d%s", $sy, $sm, $sd, "000000";
    return $start unless wantarray;
    my($ed, $em, $ey) = ($d + 6 - $wday, $mo, $y);
    if ($ed > days_in($em, $ey)) {
        $ed -= days_in($em, $ey);
        $em++;
        $em = 1, $ey++ if $em > 12;
    }
    my $end = sprintf "%04d%02d%02d%s", $ey, $em, $ed, "235959";
    ($start, $end);
}

sub is_leap_year {
     ($_[0] % 4 && !$_[0] % 100) || $_[0] % 400;
}

my @prev_month_doy = (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
my @prev_month_doly = (0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335);
sub week2ymd {
    my($y, $week) = @_;
    require MT::DateTime;
    my $jan_one_dow_m1 = (MT::DateTime->ymd2rd($y, 1, 1) + 6) % 7;
    $week-- if $jan_one_dow_m1 < 4;
    my $day_of_year = $week * 7 - $jan_one_dow_m1 + 1;
    if ($day_of_year < 1) {
        $y--;
        $day_of_year = (is_leap_year($y) ? 366 : 365) + $day_of_year;
    }
    my $ref = is_leap_year($y) ?
        \@prev_month_doly : \@prev_month_doy;
    my $m;
    my $i = @$ref;
    for my $days (reverse @$ref) {
        if ($day_of_year > $days) {
            $m = $i;
            last;
        }
        $i--;
    }
    ($y, $m, $day_of_year - $ref->[$m-1]);
}

sub start_end_month {
    my($ts) = @_;
    my($y, $mo) = unpack 'A4A2', $ts;
    my $start = sprintf "%04d%02d01000000", $y, $mo;
    return $start unless wantarray;
    my $end = sprintf "%04d%02d%02d235959", $y, $mo, days_in($mo, $y);
    ($start, $end);
}

sub offset_time_list { gmtime offset_time(@_) }

sub offset_time {
    my($ts, $blog, $dir) = @_;
    my $offset;
    if (defined $blog) {
        if (!ref($blog)) {
            require MT::Blog;
            $blog = MT::Blog->load($blog);
        }
        $offset = $blog && $blog->server_offset ? $blog->server_offset : 0;
    } else {
        $offset = MT::ConfigMgr->instance->TimeOffset;
    }
    $offset += 1 if (localtime $ts)[8];
    $offset *= -1 if $dir && $dir eq '-';
    $ts += $offset * 3600;
    $ts;
}

sub html_text_transform {
    my $str = shift;
    $str ||= '';
    my @paras = split /\r?\n\r?\n/, $str;
    for my $p (@paras) {
        if ($p !~ m@^</?(?:h1|h2|h3|h4|h5|h6|table|ol|dl|ul|menu|dir|p|pre|center|form|fieldset|select|blockquote|address|div|hr)@) {
            $p =~ s!\r?\n!<br />\n!g;
            $p = "<p>$p</p>";
        }
    }
    join "\n\n", @paras;
}

{
    my %Map = (':' => '&#58;', '@' => '&#64;', '.' => '&#46;');
    sub spam_protect {
        my($str) = @_;
        my $look = join '', keys %Map;
        $str =~ s!([$look])!$Map{$1}!g;
        $str;
    }
}

sub encode_js {
    my($str) = @_;
    return '' unless defined $str;
    $str =~ s!(['"\\])!\\$1!g;
    $str =~ s!\n!\\n!g;
    $str =~ s!\f!\\f!g;
    $str =~ s!\r!\\r!g;
    $str =~ s!\t!\\t!g;
    $str;
}

sub encode_php {
    my($str, $meth) = @_;
    return '' unless defined $str;
    if ($meth eq 'qq') {
        $str = encode_phphere($str);
        $str =~ s!"!\\"!g;    ## Replace " with \"
    } elsif (substr($meth, 0, 4) eq 'here') {
        $str = encode_phphere($str);
    } else {
        $str =~ s!\\!\\\\!g;  ## Replace \ with \\
        $str =~ s!'!\\'!g;    ## Replace ' with \'
    }
    $str;
}

sub encode_phphere {
    my($str) = @_;
    $str =~ s!\\!\\\\!g;      ## Replace \ with \\
    $str =~ s!\$!\\\$!g;      ## Replace $ with \$
    $str =~ s!\n!\\n!g;       ## Replace character \n with string \n
    $str =~ s!\r!\\r!g;       ## Replace character \r with string \r
    $str =~ s!\t!\\t!g;       ## Replace character \t with string \t
    $str;
}

sub encode_url {
    my($str) = @_;
    $str =~ s!([^a-zA-Z0-9_.~-])!uc sprintf "%%%02x", ord($1)!eg;
    $str;
}

sub decode_url {
    my($str) = @_;
    $str =~ s!%([0-9a-fA-F][0-9a-fA-F])!pack("H*",$1)!eg;
    $str;
}

{
    my $Have_Entities = eval 'use HTML::Entities; 1' ? 1 : 0;

    sub encode_html {
        my($html, $can_double_encode) = @_;
        return '' unless defined $html;
        $html =~ tr!\cM!!d;
        if ($Have_Entities && !MT::ConfigMgr->instance->NoHTMLEntities) {
            $html = HTML::Entities::encode_entities($html);
        } else {
            if ($can_double_encode) {
                $html =~ s!&!&amp;!g;
            } else {
                ## Encode any & not followed by something that looks like
                ## an entity, numeric or otherwise.
                $html =~ s/&(?!#?[xX]?(?:[0-9a-fA-F]+|\w{1,8});)/&amp;/g;
	    }
	    $html =~ s!"!&quot;!g;    #"
            $html =~ s!<!&lt;!g;
            $html =~ s!>!&gt;!g;
	  }
        $html;
    }

    sub decode_html {
        my($html) = @_;
        return '' unless defined $html;
        $html =~ tr!\cM!!d;
        if ($Have_Entities && !MT::ConfigMgr->instance->NoHTMLEntities) {
            $html = HTML::Entities::decode_entities($html);
        } else {
            $html =~ s!&quot;!"!g;  #"
            $html =~ s!&lt;!<!g;
            $html =~ s!&gt;!>!g;
            $html =~ s!&amp;!&!g;
        }
        $html;
    }
}

{
    my %Map = ('&' => '&amp;', '"' => '&quot;', '<' => '&lt;', '>' => '&gt;',
               '\'' => '&apos;');
    my %Map_Decode = reverse %Map;
    my $RE = join '|', keys %Map;
    my $RE_D = join '|', keys %Map_Decode;

    sub encode_xml {
        my($str, $nocdata) = @_;
	$nocdata ||= MT::ConfigMgr->instance->NoCDATA;
        if (!$nocdata && $str =~ m/
            <[^>]+>  ## HTML markup
            |        ## or
            &(?:(?!(\#([0-9]+)|\#x([0-9a-fA-F]+))).*?);
                     ## something that looks like an HTML entity.