view release on metacpan or  search on metacpan

MiniWiki.pm  view on Meta::CPAN

    }
  }

  my $text = "";

  if ($preview_wikitext) {
    $text .= qq(<div class="previewborder">);
	$text .= &render(&prettify("PREVIEW of " . $preview_wikitext));
	$text .= qq(</div>);
  }

  $text .= &prettify("Edit: $fileuri");
  $text .= "<form method=\"post\" action=\"${vroot}/(save)${uri}\" enctype=\"multipart/form-data\"><fieldset>\n";

  
  if (is_binary($fileuri)) {
    $text .= "<input type=\"file\" name=\"text\">\n";
  } else {
    $text .= "<textarea rows=20 cols=80 class='areas' name=\"text\" wrap=virtual>\n";
	if ($preview_wikitext) {
	  $text .= $preview_wikitext;
	} elsif (-f "${datadir}/${fileuri},v") {
      open (IN, '<', "${datadir}/${fileuri}")
	  	|| return fatal_error($r, "Couldn't read ${fileuri}");
      $text .= encode_entities(join('', <IN>));
      close (IN);
    }
    $text .= "</textarea>"
  }
  
  $text .= qq(<p>Comment: <input type=text size=30 maxlength=60 name=comment value="$comment">&nbsp;);
  $text .= qq(<input type="submit" name="Save" value="Preview">\n);
  $text .= qq(<input type="submit" name="Save" value="Save"></fieldset></form>);

  $template->param('vroot', $vroot);
  $template->param('title', $uri);
  $template->param('body', $text);
  $template->param('editlink', "$vroot/\(edit\)\/$uri");
  $template->param('loglink', "$vroot/\(log\)\/$uri");
  $template->param("lastmod", &get_lastmod("${datadir}/${fileuri},v"));

  my $output = $template->output;
  $output =~ s/\n(\s*)\n(\s*)\n/\n\n/g;

  $r->send_http_header('text/html');
  print $output;

  return OK;
}


## This function determines when a given file was last changed
## and returns a string about that.
sub get_lastmod {
  my ($filename) = @_;

  my $lastmod = "never";
  if (-f $filename) {
    my $mtime = stat($filename)->mtime;
    my $date = &ParseDateString("epoch $mtime");
    $lastmod = &UnixDate($date, "%B %d, %Y  %i:%M %p");
  }

  return "$lastmod";
}


# This function is the standard viewer. It loads a file and displays it
# to the user.
sub view_function {
  my ($r, $uri, $revision) = @_;
  my $mvtime;

  if (not $revision) {
    $revision = '';
  }
  elsif ($revision =~ /^([\d\.]+)$/) {
  	$revision = $1;
  }
  else {
    return &pretty_error($r, "Invalid revision");
  }
  
  my $fileuri = uri_to_filename($uri);

  # If the file doesn't exist as an RCS file,
  # then we return NOT_FOUND to Apache.
  if (! (-f "${datadir}/${fileuri},v" and -r "${datadir}/${fileuri},v")) {
	return NOT_FOUND;
  }

  # If we don't have a checked out file, check it out. Can't really do caching here,
  # as we also deal with multiple revisions of the files. If there is a performance
  # bottleneck here, in the future we may need to look at other means of caching.
  my $file;
  eval { 
    $file = &rcs_open($r, $fileuri);
    $file->co("-r$revision"); 
  };
  if ($@) {
    return fatal_error($r, "Error retriving $fileuri, check revision: $@");
  }

  if (is_binary($fileuri)) {
    # If we're running under mod_perl, we can use its interface
    # to Apache's I/O routines to send binary files more efficiently.
	my ($img_ext) = &is_img($fileuri);
    if (exists $ENV{MOD_PERL}) {
	  return send_file($r, "${datadir}/${fileuri}");
    } else {
		if ($img_ext) {
		  $r->send_http_header("image/$img_ext");
		} else {
		  $r->send_http_header("application/octet-stream");
		}
      my $file;
      open (FILE, "${datadir}/${fileuri}");
      { local undef $/; $file = <FILE>; }
      print $file;
    }
	return OK;

MiniWiki.pm  view on Meta::CPAN

	my $records = {};
	
	open (LS, "cd $datadir; /bin/ls -1at *,v | grep -v template |")
	 || return fatal_error($r, "Could not get a listing: $!");
	
	my $day_counter = 0;
	my $page_counter = 0;
  
	while (my $page = (<LS>)) {
		chomp ($page);
		$page =~ s/(,v)$//g;

		my $pagelink = $page;
		$pagelink =~ s/ /%20/g;

		my $obj = &rcs_open($r, $page);

		my $incomment = 0;

		# parse the meta information
		my ($revision, $datestamp, $comment, $lines, $title); 
		foreach my $line ($obj->rlog("-r")) {
			chomp ($line);

			if ($line =~ /------------/) {
				$incomment = 1;
			}
			elsif ($line =~ /============/) {
				$incomment = 0;
			}
			elsif ($incomment) {
				if ($line =~ /^date: /) {
					my @fields = split ('; ', $line);
					$datestamp = (split(': ', $fields[0]))[1] if $fields[0];
					$lines = (split(': ', $fields[3]))[1] if $fields[3];
					$lines ||= '?';
				}
				elsif ($line =~ /^revision 1/) {
					$revision = $line;
					$revision =~ s/^revision 1//g;
				}
				elsif ($line !~ /empty log message/) {
					$comment .= $line;
				}
			}
		}

		$title = &get_page_title($page);

		# no wiki words
		$title =~ s/\[|\]//g;

		$lines =~ s/ /\//;

		$comment = ucfirst($comment);

		# convert from RCS's GMT timestamps to PST.
		my $fixedtime = &ParseDateString($datestamp);
		my $delta = &ParseDateDelta("$timediff hours");
		$fixedtime = &DateCalc($fixedtime, $delta);
		my $nicetime = &UnixDate($fixedtime, "%i:%M %p");
		$fixedtime = &UnixDate($fixedtime, "%Y/%m/%d %H:%M:%S");

		my ($date, $time) = split (/\ /, $fixedtime);
		my ($year, $month, $day) = split (/\//, $date);

		$records->{$year}->{$month}->{$day}->{"$time"} = {
			page => $pagelink,
			title => encode_entities($title),
			comment => encode_entities($comment),
			lines => encode_entities($lines),
			nicetime => encode_entities($nicetime)
		};
		$page_counter++;
		if ($args{maxpages} && ($page_counter >= $args{maxpages})) {
			goto close_LS;
		}
	}

	close_LS:
	
	close (LS);

	$day_counter = 0;
	$page_counter = 0;

	foreach my $year (reverse sort keys %{$records}) {
		foreach my $month (reverse sort keys %{$records->{$year}}) {
			foreach my $day (reverse sort keys %{$records->{$year}->{$month}}) {
				my $date = &ParseDateString("$year$month$day");
				$date = &UnixDate($date, "%B %d, %Y");
				$changes .= "&nbsp;&nbsp;<b><i>$date</i></b><br/>\n";
				foreach my $time (reverse sort keys %{$records->{$year}->{$month}->{$day}}) {
					my $record = $records->{$year}->{$month}->{$day}->{$time};
					my $nicetime = $record->{nicetime};
					$changes .= qq|
&nbsp;&nbsp;&nbsp;
$nicetime <a href="$vroot/$record->{page}">$record->{title}</a>
					|;
					$changes .= qq| - $record->{comment}. | if $record->{comment};
					$changes .= qq|Changes:
						<a href="${vroot}/(log)/$record->{page}">$record->{lines}</a>
						| if $record->{lines};
					$changes .= qq|<br/>\n|;
					$page_counter++;
					if ($args{maxpages} && ($page_counter >= $args{maxpages})) {
						goto finish;
					}
				}
				$changes .= "<br/>\n";
				$day_counter++;
				if ($args{maxdays} && ($day_counter >= $args{maxdays})) {
					goto finish;
				}
			}
			$changes .= "\n<hr/>\n";
		}
	}

	finish:

	$changes .= "<br/>\n";
	$changes .= "Current date: <b>" . `/bin/date` . "</b><br/>\n";

	return $changes;
}

# If enabled as a PerlAccessHandler, allows public viewing of
# a Wiki, but leaves existing authentication in place for editing
# content.
sub access_handler {
  my $r = shift;

  return OK unless $r->some_auth_required;

  my $uri = $r->uri;
  unless ($uri =~ /\((edit|save|revert)\)/) {
    $r->set_handlers(PerlAuthenHandler => [\&OK]);
    $r->set_handlers(PerlAuthzHandler => [\&OK])
      if grep { lc($_->{requirement}) ne 'valid-user' } @{$r->requires};
  }

  return OK;
}

## is the link a binary upload?
## are file uploads enabled?
sub is_binary {
  my $uri = shift;
  return 0 if $uploads =~ /^n/i;
  return ($uri =~ /\.(.+)$/ && grep /$1/i, @binfmts);