view release on metacpan or  search on metacpan

bin/zen  view on Meta::CPAN

      # override require last_mtime
      my $stat = stat($path);
      my $mtime = $stat->mtime;
      if (!$last_mtime) {
        write_error(409, "Conflict", "Missing query parameter 'last_modified' l=$l");
        print Dumper $cgi;
        return;
      }
      if ($last_mtime != $mtime) {
        write_error(409, "Conflict", "last modified doesn't match: $mtime");
        return;
      }
    }
    my $data = $cgi->param('PUTDATA');
    if ($l == 0) {
      write_file($path, $data);
    } elsif ($l > 0) {
      $data .= "\n" unless !$data || substr($data, -1) eq "\n";
      open my $fh, '<', $path or die "Can not open file: $!";
      my $x = '';
      my $y = '';
      while (<$fh>) {
        if ($l > 1) {
          $x .= $_;
          $l--;
        } elsif ($l == 1) {
          if ($n <= 0) {
            $y .= $_;
          } else {
            $n--;
          }
        }
      }
      close $fh;
      write_file($path, $x.$data.$y);
    } else {
      print "HTTP/1.0 400 Bad request\r\n";
      return;
    }
    my $mtime = stat($path)->mtime;
    if ($mtime) {
      print "HTTP/1.0 200 OK\r\n";
      print "Last-Modified: $mtime\r\n";
      print "Content-Length: 0\r\n\r\n";
    } else {
      print "HTTP/1.0 500 Server error\r\n";
    }
  }
  
  sub on_get_file {
    my ($cgi, $path) = @_;
  
    if (-d $path) {
      print "HTTP/1.1 301 Moved Permanently\r\n";
      print "Location: ", $cgi->path_info(), "/\r\n";
      print "\r\n";
      return;
    }
  
    unless (-f $path) {
      print "HTTP/1.0 404 Not found\r\n";
      print $cgi->header,
        $cgi->start_html('Not found'),
        $cgi->h1('Not found'),
        $path,
        $cgi->end_html;
      return;
    }
  
    my $raw = $cgi->param('raw') || 0;
    my $l = $cgi->param('l') || 0;
    my $n = $cgi->param('n') || 0;
    if ($path =~ m/\.(md|zen)$/ && ($raw ne '1')) {
      print "HTTP/1.0 200 OK\r\n";
      my $action = $cgi->param('action');
      my $section = $cgi->param('section');
      $action = 'view' unless $action;
      my $zenCommand = 'zen';
      $zenCommand = 'perl ./zen.pl' if -f './zen.pl';
      if ($action eq 'exec') {
         print "Content-Type: text/plain\r\n\r\n";
         open FH, "$zenCommand --exec \"$section\" $path|";
      } else {
        if (!$section) {
           print "Content-Type: text/html\r\n\r\n";
           open FH, "$zenCommand --live --html $path|";
        } else {
           print "Content-Type: text/plain\r\n\r\n";
           open FH, "$zenCommand --section \"$section\" $path|";
        }
      }
      while (<FH>) {
         print $_;
      }
      close FH;
    } elsif ($raw eq '1' && $l > 0) {
      my $mtime = stat($path)->mtime;
      print "HTTP/1.0 200 OK\r\n";
      print "Last-Modified: $mtime\r\n";
      print "Content-Type: text/plain\r\n\r\n";
      open my $fh, '<', $path or die "Can not open file: $!";
      while (<$fh>) {
        if ($l == 1) {
          last if $n == 0;
          print $_;
          $n--;
        } else {
          $l--;
        }
      }
      close $fh;
    } else {
      my ($ext) = $path =~ /\.([^.]+)$/;
      my $mime_type = $mimeTypes{lc($ext)} || 'application/octet-stream';
      open my $fh, '<:raw', $path or die "Cannot open file: $!";
      my $mtime = stat($path)->mtime;
      my $filesize = -s $path;
      print "HTTP/1.1 200 OK\r\n";
      print "Content-Type: $mime_type\r\n";
      print "Last-Modified: $mtime\r\n";
      print "Content-Length: $filesize\r\n";
      print "\r\n";
  
      # Print the binary content of the file to the CGI output
      binmode STDOUT;
      while (read $fh, my $buffer, 4096) {
          print $buffer;
      }
      close $fh;
    }
  }
  
  sub on_list_dir {
    my ($cgi, $path) = @_;
  
    if (!-d $path) {
      write_error(404, "Not found");
      return;
    }
  
    my @contents = ();
    opendir(my $dh, $path) or die "Cannot open directory: $!";
    while (my $file = readdir $dh) {
      next if $file =~ /^\./;
      next if $file =~ /~$/;
      my $filepath = "$path/$file";
      my $mtime = stat($filepath)->mtime;
      push @contents, {
        name => -d $filepath ? "$file/" : $file,
        size => -s "$path/$file",
        mtime => $mtime,
      };
    }
    @contents = sort { $a->{name} cmp $b->{name} } @contents;
  
    my $fmt = $cgi->param('fmt');
    if ($fmt) {
      if ($fmt eq "csv") {
        print "HTTP/1.1 200 OK\r\n";
        print "\r\n";
        for (@contents) {
          print "$_->{name},$_->{size},$_->{mtime}\n";
        }
        return;
      } elsif ($fmt eq 'json') {
        print "HTTP/1.1 200 OK\r\n";
        print "\r\n";
        print JSON::encode_json(\@contents);
        return;
      } else {
        write_error(400, "Bad parameter: unsupported fmt");
        return;
      }
    }
  
    print "HTTP/1.0 200 OK\r\n\r\n";
    print "<!doctype html>\n<html>\n  <head>\n    <meta charset=\"utf-8\">\n    <meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n    <title>Index</title>\n    <style>\n      :root {\n        --navbar-height: 1.6rem;\n      }\...
    print "<div class=\"xxpad\"><h1>Index</h1>\n";
    print "<table>\n";
    print "<thead><tr class=\"sticky-top\"><th>Name</th><th>Size</th><th>Last Modified</th></tr></thead>\n";
    for (@contents) {
       my $timestr = strftime('%FT%TZ%z', localtime($_->{mtime}));
       print "<tr>";
       print "<td><a href=\"$_->{name}\">$_->{name}</a></td>";
       print "<td class=\"align-right\">$_->{size}</td>";
       print "<td>$timestr</td>";
       print "</tr>\n";
    }
    print "</table></div>";
    print "  </body>\n</html>";
  }
  
  sub on_hello {
      my $cgi  = shift;   # CGI.pm object
                              return if !ref $cgi;
  
      my $name = $cgi->param('name');