view release on metacpan or  search on metacpan

t/oddmuse-wiki.pl  view on Meta::CPAN

sub WriteIndex {
  WriteStringToFile($IndexFile, join(' ', @IndexList));
}

sub RefreshIndex {
  @IndexList = ();
  %IndexHash = ();
  # If file exists and cannot be changed, error!
  my $locked = RequestLockDir('index', undef, undef, IsFile($IndexFile));
  foreach (Glob("$PageDir/*.pg"), Glob("$PageDir/.*.pg")) {
    next unless m|/.*/(.+)\.pg$|;
    my $id = $1;
    push(@IndexList, $id);
    $IndexHash{$id} = 1;
  }
  WriteIndex() if $locked;
  ReleaseLockDir('index') if $locked;
}

sub AddToIndex {
  my ($id) = @_;
  $IndexHash{$id} = 1;
  @IndexList = sort(keys %IndexHash);
  WriteIndex();
}

sub DoSearch {
  my $string = shift || GetParam('search', '');
  my $re = UnquoteHtml($string);
  return DoIndex() if $string eq '';
  eval { qr/$re/ } or $re = quotemeta($re);
  my $replacement = GetParam('replace', undef);
  my $raw = GetParam('raw', '');
  my @results;
  if ($replacement or GetParam('delete', 0)) {
    return unless UserIsAdminOrError();
    if (GetParam('preview', '')) { # Preview button was used
      print GetHeader('', Ts('Preview: %s', $string . " → " . $replacement));
      print $q->start_div({-class=>'content replacement'});
      print GetFormStart(undef, 'post', 'replace');
      print GetHiddenValue('search', $string);
      print GetHiddenValue('replace', $replacement);
      print GetHiddenValue('delete', GetParam('delete', 0));
      print $q->submit(-value=>T('Go!')) . $q->end_form();
      @results = ReplaceAndDiff($re, UnquoteHtml($replacement));
    } else {
      print GetHeader('', Ts('Replaced: %s', $string . " → " . $replacement));
      print $q->start_div({-class=>'content replacement'});
      @results = ReplaceAndSave($re, UnquoteHtml($replacement));
      foreach (@results) {
	PrintSearchResult($_, quotemeta($replacement || $re)); # the replacement is not a valid regex
      }
    }
  } else {
    if ($raw) {
      print GetHttpHeader('text/plain');
      print RcTextItem('title', Ts('Search for: %s', $string)), RcTextItem('date', TimeToText($Now)),
	RcTextItem('link', $q->url(-path_info=>1, -query=>1)), "\n" if GetParam('context', 1);
    } else {
      print GetHeader('', Ts('Search for: %s', $string)), $q->start_div({-class=>'content search'});
      print $q->p({-class=>'links'}, SearchMenu($string));
    }
    @results = SearchTitleAndBody($re, \&PrintSearchResult, SearchRegexp($re));
  }
  print SearchResultCount($#results + 1), $q->end_div() unless $raw;
  PrintFooter() unless $raw;
}

sub SearchMenu {
  return ScriptLink('action=rc;rcfilteronly=' . UrlEncode(shift),
		    T('View changes for these pages'));
}

sub SearchResultCount { $q->p({-class=>'result'}, Ts('%s pages found.', (shift))); }

sub PageIsUploadedFile {
  my $id = shift;
  return if $OpenPageName eq $id;
  if ($IndexHash{$id}) {
    my $file = GetPageFile($id);
    open(my $FILE, '<:encoding(UTF-8)', encode_utf8($file))
      or ReportError(Ts('Cannot open %s', GetPageFile($id))
		     . ": $!", '500 INTERNAL SERVER ERROR');
    while (defined($_ = <$FILE>) and $_ !~ /^text: /) {
    }          # read lines until we get to the text key
    close $FILE;
    return unless length($_) > 6;
    return TextIsFile(substr($_, 6)); # pass "#FILE image/png\n" to the test
  }
}

sub SearchTitleAndBody {
  my ($regex, $func, @args) = @_;
  my @found;
  my $lang = GetParam('lang', '');
  foreach my $id (Filtered($regex, AllPagesList())) {
    my $name = NormalToFree($id);
    my ($text) = PageIsUploadedFile($id); # set to mime-type if this is an uploaded file
    local ($OpenPageName, %Page); # this is local!
    if (not $text) { # not uploaded file, therefore allow searching of page body
      OpenPage($id); # this opens a page twice if it is not uploaded, but that's ok
      if ($lang) {
	my @languages = split(/,/, $Page{languages});
	next if (@languages and not grep(/$lang/, @languages));
      }
      $text = $Page{text};
    }
    if (SearchString($regex, $name . "\n" . $text)) { # the real search code
      push(@found, $id);
      $func->($id, @args) if $func;
    }
  }
  return @found;
}

sub Filtered { # this is overwriten in extensions such as tags.pl
  my ($string, @pages) = @_;
  my $match = GetParam('match', '');
  @pages = grep /$match/i, @pages if $match;
  return @pages;
}

sub SearchString {
  my ($string, $data) = @_;
  my @strings = grep /./, $string =~ /\"([^\"]+)\"|(\S+)/g; # skip null entries
  foreach my $str (@strings) {
    return 0 unless ($data =~ /$str/i);
  }
  return 1;