view release on metacpan or  search on metacpan

lib/App/Phoebe/WebDAV.pm  view on Meta::CPAN

            my $col = $doc->createElement('D:collection');
            $prop->addChild($col);
          }
          $okprops->addChild($prop);
        } else {
          my $prefix = $prefixes{$ns};
          if (!defined $prefix) {
            $prefix = 'i' . $i++;
	    # mod_dav sets <response> 'xmlns' attribute - whatever
            #$nfprops->setAttribute("xmlns:$prefix", $ns);
            $resp->setAttribute("xmlns:$prefix", $ns);
            $prefixes{$ns} = $prefix;
          }
          $prop = $doc->createElement("$prefix:$name");
          $nfprops->addChild($prop);
        }
      }
    } elsif ($reqinfo eq 'propname') {
      $prop = $doc->createElement('D:creationdate');
      $okprops->addChild($prop);
      $prop = $doc->createElement('D:getcontentlength');
      $okprops->addChild($prop);
      $prop = $doc->createElement('D:getcontenttype');
      $okprops->addChild($prop);
      $prop = $doc->createElement('D:getlastmodified');
      $okprops->addChild($prop);
      $prop = $doc->createElement('D:resourcetype');
      $okprops->addChild($prop);
    } else {
      $prop = $doc->createElement('D:creationdate');
      $prop->appendText($ctime);
      $okprops->addChild($prop);
      $prop = $doc->createElement('D:getcontentlength');
      $prop->appendText($size);
      $okprops->addChild($prop);
      $prop = $doc->createElement('D:getcontenttype');
      $prop->appendText($mime);
      $okprops->addChild($prop);
      $prop = $doc->createElement('D:getlastmodified');
      $prop->appendText($mtime);
      $okprops->addChild($prop);
      $prop = $doc->createElement('D:resourcetype');
      if ($is_dir) {
	my $col = $doc->createElement('D:collection');
	$prop->addChild($col);
      }
      $okprops->addChild($prop);
    }
    if ($okprops->hasChildNodes) {
      my $propstat = $doc->createElement('D:propstat');
      $propstat->addChild($okprops);
      my $stat = $doc->createElement('D:status');
      $stat->appendText('HTTP/1.1 200 OK');
      $propstat->addChild($stat);
      $resp->addChild($propstat);
    }
    if ($nfprops->hasChildNodes) {
      my $propstat = $doc->createElement('D:propstat');
      $propstat->addChild($nfprops);
      my $stat = $doc->createElement('D:status');
      $stat->appendText('HTTP/1.1 404 Not Found');
      $propstat->addChild($stat);
      $resp->addChild($propstat);
    }
  }
  my $str = $doc->toString(1);
  my $len = length($str);
  $log->debug("RESPONSE: 207\n" . $doc->toString(1));
  $stream->write("HTTP/1.1 207 Multi-Status\r\n");
  $stream->write("Content-Type: application/xml; charset=\"utf-8\"\r\n");
  $stream->write("Content-Length: $len\r\n");
  if ($path =~ m!/(page|raw|file|login)$!) {
    $stream->write("Content-Location: $path/\r\n");
  }
  $stream->write("\r\n");
  $stream->write($str);
}

sub to_url {
  my $space = shift;
  my $resource = shift;
  my $href;
  $href .= "/" . uri_escape_utf8($space) if $space;
  # split doesn't produce empty fields at the end
  my $d = substr($resource, -1) eq "/";
  $href .= join("/", map { uri_escape_utf8($_) } split (/\//, $resource));
  $href .= "/" if $d;
  return $href;
}

sub put {
  my ($stream, $host, $space, $path, $id, $headers, $buffer) = @_;
  return unless authorize($stream, $host, $space, $headers);
  return remove($stream, $host, $space, $path, $id, $headers) if length($buffer) == 0;
  my $mime = $headers->{"content-type"} // guess_mime_type(\$buffer);
  return webdav_error($stream, "Content type not known") unless $mime;
  return webdav_error($stream, "Page name is missing") unless $id;
  return webdav_error($stream, "Page names must not control characters") if $id =~ /[[:cntrl:]]/;
  # We don't need to close the stream because this is called via process_gemini
  # which always closes the stream in the end.
  if ($path eq "/file/$id") {
    with_lock($stream, $host, $space, sub { write_file($stream, $host, $space, $id, $buffer, $mime) } );
  } else {
    my $text = decode_utf8 $buffer // "";
    $text =~ s/\r\n/\n/g; # fix DOS EOL convention
    with_lock($stream, $host, $space, sub { write_page($stream, $host, $space, $id, $text) } );
  }
  return 1;
}

sub write_page {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $text = shift;
  my $dir = wiki_dir($host, $space);
  my $file = "$dir/page/$id.gmi";
  my $revision = 0;
  my $new = 0;
  if (-e $file) {