stat\( results from the CPAN

Apache-MiniWiki

view release on metacpan or search on metacpan

    if ($@) {
      return fatal_error($r, "Error while retrieving $fileuri: $@");
    }
  }

  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;

MiniWiki.pm view on Meta::CPAN

      }
    }
  
    $template->param('vroot', $vroot || "no vroot");
    $template->param('title', $uri);
    $template->param('body', $newtext);
    $template->param('editlink', "$vroot/\(edit\)\/$uri");
    $template->param('loglink', "$vroot/\(log\)\/$uri");
    $template->param('pageurl', "http://$ENV{SERVER_NAME}:$ENV{SERVER_PORT}$ENV{REQUEST_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;
}

# returns a string containing the contents of the given filename
sub get_file($) {
	my ($filename) = @_;

	my $data = "";
	
	open (FILE, "$filename") || die "$filename - $!";
	while (<FILE>) {
		$data .= $_;
	}
	close (FILE);

	return $data;
}

# write the given data to the given filename
sub put_file($$) {
  my ($filename, $data) = @_;

  open (OUT, "> $filename") || die $!;
  print OUT $data;
  close(OUT);
}

# returns the name of the last page that was editted in the wiki
sub get_lastchanged {
  open (CMD, "cd ${datadir}; /bin/ls -1at *,v | head -1 |") || die $!;
  my $filename = <CMD>;
  close (CMD);
	$filename =~ s/\t|\r|\n//g;
	$filename =~ s/ $//g;
	$filename =~ s/^ //g;
  return $filename;
}

# returns the timestamp of the given filename in the datadir
sub get_mtime($) {
  my ($filename) = @_;
  if (-f "$datadir/$filename") {
    my $mtime = stat("$datadir/$filename")->mtime;
  }
}

sub render($) {
    my ($newtext) = @_;
  
    # While the text contains Wiki-style links, we go through each one and
    # change them into proper HTML links.
    while ($newtext =~ /\[\[([^\]|]*)\|?([^\]]*)\]\]/) {
    my $rawname = $1;
    my $revision;
    if ($rawname =~ /\//) {
      ($rawname, $revision) = split (/\//, $rawname);
    }
    my $desc = $2 || $rawname;
    my $tmplink;
  
    my $tmppath = uri_to_filename($rawname);
    $tmppath =~ s/^_//;

    if (-f "${datadir}/$tmppath,v") {
      my $link;
      if (is_img($rawname)) {
        $link = qq{<a href="$vroot/$rawname"><img src="$vroot/(thumb)$rawname" alt="$desc"></a>};
	  }
      else {
        $link = qq{<a href="$vroot/$rawname">$desc</a>};
      }
      if (is_binary($rawname) || is_img($rawname)) {
        $link .= qq { <sup><a href="$vroot/(edit)$rawname">[E]</a></sup>};
      }
      $newtext =~ s/\[\[[^\]]*\]\]/$link/;
    } else {
      $tmplink = "$desc <a href=\"${vroot}\/(edit)/${rawname}\"><sup>?<\/sup><\/a>";
      $newtext =~ s/\[\[[^\]]*\]\]/$tmplink/;
    }
    }
    $newtext =~ s/\\\[\\\[/\[\[/g;
  
    $newtext =~ s/-{3,}/<hr\/>/g;

    return $newtext;
}

# this function gets the diff for a file and displays it to the user
# in a semi-nice format.
sub diff_function {
  my ($r, $uri) = @_;

  my %args = $r->args;

  my (@rev) = grep { defined } @args{qw(rev1 rev2)};
  for (@rev) {
    if (/^([0-9\.]+)$/) {
	  $_ = $1;
	} else {
	  &pretty_error($r, "Invalid revision, must be a digit.");
	}
  }

MiniWiki.pm view on Meta::CPAN

  if ($@) {
    return fatal_error($r, "Error generating log for $fileuri : $@");
  }

  my $logbody = "History for $uri\n\n";

  $logbody = &prettify($logbody);

  $logbody .= qq|<a href="#diff_form">Compare revisions</a><br/><br/>\n|;

  my $server = $r->server->server_hostname;

  foreach my $line (@rlog_complete) {
    if ($line =~ /Initial checkin|empty log message|=============/) {
      next;
    } elsif ($line !~ /:/ && $line !~ /----/ && $line !~ /revision|date/i) {
      chomp($line);
      $line = "&nbsp;" x 5 . "<i>$line</i><br/>\n" if $line;
    } elsif ($line !~ /^(revision |date: )/) {
      next;
    } elsif ($line =~ /^revision /) {
      my ($word, $revision) = split (' ', $line);
      $line = qq|<a href="${vroot}/$uri?rev=$revision">View</a> or |;
      $line .= qq|<a href="${vroot}/(diff)/$uri?rev1=$revision">Diff</a> or |;
      $line .= qq|<a href="${vroot}/(revert)/$uri?rev=$revision">Revert</a>  |;
      $line .= qq|revision $revision:<br/>\n|;
      $line .= "&nbsp;" x 5;
    } elsif ($line =~ /date:/ and $line =~ /state:/) {
      $line =~ s/\n|\t//g;
      $line .= "<br/>\n";
    } else {
      $line .= "<br/>";
    }
    $logbody .= "$line";
  }

  $logbody .= &diff_form($uri);

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

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

  return OK;
}

# this function creates a thumbnail on the fly for the given uri.
# if the image is bigger then the cutoff, it gets resized. If not, it 
# is left alone.
sub thumb_function {
	my ($r, $uri, $revision) = @_;

	my $fileuri = $datadir . "/" . uri_to_filename($uri);
	my $thumburi = $datadir . "/THUMB_" . uri_to_filename($uri);
	
	my $file_mtime = stat($fileuri)->mtime;
		
	my ($subtype) = &is_img($uri);
	#$r->send_http_header("image/$subtype");

	if (-f $thumburi && stat($thumburi)->mtime > $file_mtime) {
		# if the thumbnail is newer then the big image,
		# then obviously a new one hasn't been uploaded. 
		# Don't call ImageMagick to check the size.
		# Use the existing thumb.
		return send_file($r, $thumburi);
	}

	use Image::Magick;
	my $image = Image::Magick->new;

	my ($width, $height, $size, $format) = $image->Ping($fileuri);

	if ($width < $max_width && $height < $max_height) {
		# don't scale it down
		return send_file($r, $fileuri);
	}
	else {
		if (!-f $thumburi || stat($thumburi)->mtime < $file_mtime) {
			my $resize_ratio;
			if ($width > $height) {
				# eg. .2 = 1200 / 240
				$resize_ratio = $width / $max_width;
			} else {
				$resize_ratio = $height / $max_height;
			}
			$width /= $resize_ratio;
			$height /= $resize_ratio;
			$image->Read($fileuri);
			$image->Resize("${width}x${height}");
			$image->Write($thumburi);
		}
		return send_file($r, $thumburi);
	}
}

## let mod_perl efficiently take care of sending a file to the browser
sub send_file {
	my ($r, $filename) = @_;

	my $subr = $r->lookup_file($filename);
	$r->headers_out(%{$subr->headers_out});
	$r->send_http_header($subr->content_type);
	return $subr->run;
}

# this function returns the HTML for a form that allows the
# user to specify two revisions to compare, in either unidiff or context
# formats. It is called by the log and diff viewing functions, 
# diff_function and log_function.
sub diff_form($) {
  my ($uri) = @_;

  my $form .= <<END;
<hr/>
<a name="#diff_form">
<form method=get action="$vroot/(diff)/$uri">
1st revision: <input type=text size=5 name=rev1> 
2nd revision: <input type=text size=5 name=rev2>
Format: <select name=m>
<option value=>Normal</c>
<option value=c>Context</c>
</select>
<input type=submit value=" Compare "><br/>
<i>(Leave 2nd revision field blank to compare against latest)</i>
</form>
END
  $form;
}

# This function loads the template, if one exists. If there is no template,
# then a default template consisting of just a plain body is used.
sub get_template {
  my ($r) = @_;

  if (!( -f "${datadir}/template,v" and -r "${datadir}/template,v")) {
    $r->log_error("${datadir}/template,v is not a readable file! Using default.");

    my $template_text = <<END_TEMPLATE;

( run in 1.443 second using v1.01-cache-2.11-cpan-39bf76dae61 )