util.pm

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

        /x) {
            ## If ]]> exists in the string, encode the > to >.
            $str =~ s/]]>/]]>/g;
            $str = '<![CDATA[' . $str . ']]>';
        } else {
            $str =~ s!($RE)!$Map{$1}!g;
        }
        $str;
    }
    sub decode_xml {
        my($str) = @_;
        if ($str =~ s/<!\[CDATA\[(.*?)]]>/$1/g) {
            ## Decode encoded ]]&gt;
            $str =~ s/]]&(gt|#62);/]]>/g;
        } else {
            $str =~ s!($RE_D)!$Map_Decode{$1}!g;
        }
        $str;
    }
}

sub remove_html {
    my($text) = @_;
    return $text if !defined $text;  # suppress warnings
    $text =~ s!<[^>]+>!!gs;
    $text =~ s!<!&lt;!gs;
    $text;
}

sub iso_dirify {
    my $s = $_[0];
    $s = convert_high_ascii($s);  ## convert high-ASCII chars to 7bit.
    $s = lc $s;                   ## lower-case.
    $s = remove_html($s);         ## remove HTML tags.
    $s =~ s!&[^;\s]+;!!g;         ## remove HTML entities.
    $s =~ s![^\w\s]!!g;           ## remove non-word/space chars.
    $s =~ tr! !_!s;               ## change space chars to underscores.
    $s;    
}

sub utf8_dirify {
    my $s = $_[0];
    $s = xliterate_utf8($s);      ## convert two-byte UTF-8 chars to 7bit ASCII
    $s = lc $s;                   ## lower-case.
    $s = remove_html($s);         ## remove HTML tags.
    $s =~ s!&[^;\s]+;!!g;         ## remove HTML entities.
    $s =~ s![^\w\s-]!!g;           ## remove non-word/space chars.
    $s =~ tr! !_!s;               ## change space chars to underscores.
    $s;    
}

sub dirify {
    ($MT::VERSION && MT->instance->{cfg}->PublishCharset eq 'utf-8')
        ? utf8_dirify(@_) : iso_dirify(@_);
}

my %HighASCII = (
    "\xc0" => 'A',    # A`
    "\xe0" => 'a',    # a`
    "\xc1" => 'A',    # A'
    "\xe1" => 'a',    # a'
    "\xc2" => 'A',    # A^
    "\xe2" => 'a',    # a^
    "\xc4" => 'Ae',   # A:
    "\xe4" => 'ae',   # a:
    "\xc3" => 'A',    # A~
    "\xe3" => 'a',    # a~
    "\xc8" => 'E',    # E`
    "\xe8" => 'e',    # e`
    "\xc9" => 'E',    # E'
    "\xe9" => 'e',    # e'
    "\xca" => 'E',    # E^
    "\xea" => 'e',    # e^
    "\xcb" => 'Ee',   # E:
    "\xeb" => 'ee',   # e:
    "\xcc" => 'I',    # I`
    "\xec" => 'i',    # i`
    "\xcd" => 'I',    # I'
    "\xed" => 'i',    # i'
    "\xce" => 'I',    # I^
    "\xee" => 'i',    # i^
    "\xcf" => 'Ie',   # I:
    "\xef" => 'ie',   # i:
    "\xd2" => 'O',    # O`
    "\xf2" => 'o',    # o`
    "\xd3" => 'O',    # O'
    "\xf3" => 'o',    # o'
    "\xd4" => 'O',    # O^
    "\xf4" => 'o',    # o^
    "\xd6" => 'Oe',   # O:
    "\xf6" => 'oe',   # o:
    "\xd5" => 'O',    # O~
    "\xf5" => 'o',    # o~
    "\xd8" => 'Oe',   # O/
    "\xf8" => 'oe',   # o/
    "\xd9" => 'U',    # U`
    "\xf9" => 'u',    # u`
    "\xda" => 'U',    # U'
    "\xfa" => 'u',    # u'
    "\xdb" => 'U',    # U^
    "\xfb" => 'u',    # u^
    "\xdc" => 'Ue',   # U:
    "\xfc" => 'ue',   # u:
    "\xc7" => 'C',    # ,C
    "\xe7" => 'c',    # ,c
    "\xd1" => 'N',    # N~
    "\xf1" => 'n',    # n~
    "\xdf" => 'ss',
);
my $HighASCIIRE = join '|', keys %HighASCII;
sub convert_high_ascii {
    my($s) = @_;
    $s =~ s/($HighASCIIRE)/$HighASCII{$1}/g;
    $s;
}

sub xliterate_utf8 {
    my ($str) = @_;
    my %utf8_table = (
          "\xc3\x80" => 'A',    # A`
          "\xc3\xa0" => 'a',    # a`
          "\xc3\x81" => 'A',    # A'
          "\xc3\xa1" => 'a',    # a'
          "\xc3\x82" => 'A',    # A^
          "\xc3\xa2" => 'a',    # a^
          "\xc3\x84" => 'Ae',   # A:
          "\xc3\xa4" => 'ae',   # a:
          "\xc3\x83" => 'A',    # A~
          "\xc3\xa3" => 'a',    # a~
          "\xc3\x88" => 'E',    # E`
          "\xc3\xa8" => 'e',    # e`
          "\xc3\x89" => 'E',    # E'
          "\xc3\xa9" => 'e',    # e'
          "\xc3\x8a" => 'E',    # E^
          "\xc3\xaa" => 'e',    # e^
          "\xc3\x8b" => 'Ee',   # E:
          "\xc3\xab" => 'ee',   # e:
          "\xc3\x8c" => 'I',    # I`
          "\xc3\xac" => 'i',    # i`
          "\xc3\x8d" => 'I',    # I'
          "\xc3\xad" => 'i',    # i'
          "\xc3\x8e" => 'I',    # I^
          "\xc3\xae" => 'i',    # i^
          "\xc3\x8f" => 'Ie',   # I:
          "\xc3\xaf" => 'ie',   # i:
          "\xc3\x92" => 'O',    # O`
          "\xc3\xb2" => 'o',    # o`
          "\xc3\x93" => 'O',    # O'
          "\xc3\xb3" => 'o',    # o'
          "\xc3\x94" => 'O',    # O^
          "\xc3\xb4" => 'o',    # o^
          "\xc3\x96" => 'Oe',   # O:
          "\xc3\xb6" => 'oe',   # o:
          "\xc3\x95" => 'O',    # O~
          "\xc3\xb5" => 'o',    # o~
          "\xc3\x98" => 'Oe',   # O/
          "\xc3\xb8" => 'oe',   # o/
          "\xc3\x99" => 'U',    # U`
          "\xc3\xb9" => 'u',    # u`
          "\xc3\x9a" => 'U',    # U'
          "\xc3\xba" => 'u',    # u'
          "\xc3\x9b" => 'U',    # U^
          "\xc3\xbb" => 'u',    # u^
          "\xc3\x9c" => 'Ue',   # U:
          "\xc3\xbc" => 'ue',   # u:
          "\xc3\x87" => 'C',    # ,C
          "\xc3\xa7" => 'c',    # ,c
          "\xc3\x91" => 'N',    # N~
          "\xc3\xb1" => 'n',    # n~
          "\xc3\x9f" => 'ss',   # double-s
    );
    
    $str =~ s/([\200-\377]{2})/$utf8_table{$1}||''/ge;
    $str;
}

sub first_n_words {
    my($text, $n) = @_;
    $text = remove_html($text);
    my @words = split /\s+/, $text;
    my $max = @words > $n ? $n : @words;
    return join ' ', @words[0..$max-1];
}

sub munge_comment {
    my($text, $blog) = @_;
    unless ($blog->allow_comment_html) {
        $text = remove_html($text);
        if ($blog->autolink_urls) {
            $text =~ s!(https?://\S+)!<a href="$1">$1</a>!g;
        }
    }
    $text;
}

my %DynamicURIs = (
    'Individual' => 'entry/<$MTEntryID$>',
    'Weekly'     => 'archives/week/<$MTArchiveDate format="%Y/%m/%d"$>',
    'Monthly'    => 'archives/<$MTArchiveDate format="%Y/%m"$>',
    'Daily'      => 'archives/<$MTArchiveDate format="%Y/%m/%d"$>',
    'Category'   => 'section/<$MTCategoryID$>',
);


# basename must be unique across the entire blog it starts as dirified
# title and, if that already exists, an appended ctr is incremented
# until we get a non-existent basename
sub make_unique_basename {
    my ($entry) = @_;
    my $blog = $entry->blog;
    my $title = $entry->title;
    unless ($title) {
        if (my $text = $entry->text) {
            $title = MT::Util::first_n_words($text, 5);
        }
        $title = 'Post' unless $title;
    }
    my $base = substr(dirify($title), 0, 15);
    $base =~ s/_+$//;
    $base = 'post' if $base eq '';
    my $i = 1;
    my $base_copy = $base;

    while (MT::Entry->count({ blog_id => $blog->id,
                              basename => $base })) {
        $base = $base_copy . '_' . $i++;
    }
    $base;
}

##
## archive_file_for takes an entry to determine the timestamps,
## but if the entry is not available it uses the time_start
## and time_end values
##
sub archive_file_for {
    my($entry, $blog, $at, $cat, $map, $timestamp) = @_;
    return if $at eq 'None';
    my $file;
    if ($blog->is_dynamic) {
        require MT::TemplateMap;
        $map = MT::TemplateMap->new;
        $map->file_template($DynamicURIs{$at});
    }
    unless ($map) {
        my $cache = MT::Request->instance->cache('maps');
        unless ($cache) {
            MT::Request->instance->cache('maps', $cache = {});
        }
        unless ($map = $cache->{$blog->id . $at}) {
            require MT::TemplateMap;
            $map = MT::TemplateMap->load({ blog_id => $blog->id,
                                           archive_type => $at,
                                           is_preferred => 1 });
            $cache->{$blog->id . $at} = $map if $map;
        }
    }
    my $file_tmpl = $map ? $map->file_template : '';
    my($ctx);
    if ($file_tmpl) {
        require MT::Template::Context;
        $ctx = MT::Template::Context->new;
        $ctx->stash('blog', $blog);
    }
    local $ctx->{__stash}{category};
    $timestamp = $entry->created_on() if $entry;
    if ($at eq 'Individual') {
	Carp::croak "archive_file_for Individual archive needs an entry" 
	    unless $entry;
        if ($file_tmpl) {
            $ctx->stash('entry', $entry);
            $ctx->{current_timestamp} = $entry->created_on;
        } else {
	    if ($blog->old_style_archive_links) {
		$file = sprintf("%06d", $entry->id);
            } else {
		my $basename = $entry->basename();
		$basename ||= dirify($entry->title());
		$file = sprintf("%04d/%02d/%s", 
				unpack('A4A2', $entry->created_on),
				$basename);
	    }
        }
    } elsif ($at eq 'Daily') {
	if ($file_tmpl) {
	    ($ctx->{current_timestamp}, $ctx->{current_timestamp_end}) =
		start_end_day($timestamp);
        } else {
            my $start = start_end_day($timestamp);
            my($year, $mon, $mday) = unpack 'A4A2A2', $start;
	    if ($blog->old_style_archive_links) {
		$file = sprintf("%04d_%02d_%02d", $year, $mon, $mday);
	    } else {
		$file = sprintf("%04d/%02d/%02d/index", $year, $mon, $mday);
	    }
        }
    } elsif ($at eq 'Weekly') {
        if ($file_tmpl) {
            ($ctx->{current_timestamp}, $ctx->{current_timestamp_end}) =
                start_end_week($timestamp);
        } else {
            my $start = start_end_week($timestamp);
            my($year, $mon, $mday) = unpack 'A4A2A2', $start;
	    if ($blog->old_style_archive_links) {
		$file = sprintf("week_%04d_%02d_%02d", $year, $mon, $mday);
	    } else {
		$file = sprintf("%04d/%02d/%02d-week/index", $year, $mon, $mday);
	    }
        }
    } elsif ($at eq 'Monthly') {
        if ($file_tmpl) {
            ($ctx->{current_timestamp}, $ctx->{current_timestamp_end}) =
                start_end_month($timestamp);
        } else {
            my $start = start_end_month($timestamp);
            my($year, $mon) = unpack 'A4A2', $start;
	    if ($blog->old_style_archive_links) {
		$file = sprintf("%04d_%02d", $year, $mon);
	    } else {
		$file = sprintf("%04d/%02d/index", $year, $mon);
	    }
        }
    } elsif ($at eq 'Category') {
        my $this_cat = $cat ? $cat : $entry->category;
        if ($file_tmpl) {
            $ctx->stash('archive_category', $this_cat);
	    $ctx->{inside_mt_categories} = 1;
            $ctx->{__stash}{category} = $this_cat;
        } else {
            if (!$this_cat) {
		return "";
	    }
            my $label = '';
	    $label = dirify($this_cat->label);
	    if ($label !~ /\w/) {
		$label = $this_cat ? "cat" .  $this_cat->id : "";
	    }
	    if ($blog->old_style_archive_links) {
		$file = sprintf("cat_%s", $label);
	    } else {
		$file = sprintf("%s/index", $this_cat->category_path);
	    }

        }
    } else {
        return $entry->error(MT->translate(
            "Invalid Archive Type setting '[_1]'", $at ));
    }
    if ($file_tmpl) {
        require MT::Builder;
        my $build = MT::Builder->new;
        my $tokens = $build->compile($ctx, $file_tmpl) 
	    or return $blog->error($build->errstr());
        defined($file = $build->build($ctx, $tokens)) 
	    or return $blog->error($build->errstr());
    } else {
        my $ext = $blog->file_extension || 'html';
        $file .= '.' . $ext;
    }
    $file;
}

{
    my %Helpers = ( Monthly => \&start_end_month,
                    Weekly => \&start_end_week,
                    Daily => \&start_end_day,
                  );
    sub get_entry {
        my($ts, $blog_id, $at, $order) = @_;
        my($start, $end) = $Helpers{$at}->($ts);
        if ($order eq 'previous') {
            $order = 'descend';
            $ts = $start;
        } else {
            $order = 'ascend';
            $ts = $end;
        }
        my $entry = MT::Entry->load(
            { blog_id => $blog_id,
              status => MT::Entry::RELEASE() },
            { limit => 1,
              'sort' => 'created_on',
              direction => $order,
              start_val => $ts });
        $entry;
    }
}

sub is_valid_email {
    my($addr) = @_;
    return 0 if $addr =~ /[\n\r]/;
    my $specials = '\(\)<>\@,;:\[\]';
    if ($addr =~ /^\s*([^\" \t\n\r$specials]+@[^ \t\n\r$specials]+\.[^ \t\n\r$specials][^ \t\n\r$specials]+)\s*$/)
    {
        return $1;
    } else {
        return 0;
    }
}


sub is_valid_url {
    my($url, $stringent) = @_;

    $url ||= "";

    # strip spaces
    $url =~ s/^\s*//;
    $url =~ s/\s*$//;