<package name="simple-edit">
<domain name="papp" lang="en">

<macro name="remote_edit_parse*"><perl><![CDATA[
my $buf;
$request->read($buf, $request->header_in("Content-Length"));
if($request->header_in("Content-Type") =~ /text\//) {
     Convert::Scalar::utf8_valid $buf or die "format violation - only utf8 supported\n";
     Convert::Scalar::utf8_on $buf;
     $buf =~ y/\x{feff}//d;
}
$buf;
]]></perl></macro>

<perl><![CDATA[

our %mimetypes;

sub __ReadMimeTypes() {
   for my $file ("$ENV{HOME}/.mime.types", "/usr/local/etc/mime.types", "/usr/share/etc/mime.types", "/etc/mime.types") {
      open my $fh, "<$file" or next;
      while(<$fh>) {
        chomp; lc;
        my($type,@exts) = split;
        $mimetypes{$type} ||= $exts[0] if @exts;
      }
    }
}

__ReadMimeTypes;

]]></perl>

<macro name="remote_edit_store*" args="$fh"><perl><![CDATA[
	my $buf;
	my $len = $request->header_in("Content-Length");
	while($len) {
           	my $rlen = ($len > 8192) ? 8192 : $len;
		$request->read($buf, $rlen);
		print $fh $buf;
                $len -= $rlen;
	}
]]></perl></macro>


<callback name="remote_edit" args="$data $mode"><phtml><![CDATA[<:
   use HTTP::Date;
   my %flags = %{$data->{flags}};
   abort_with {
      if ($mode) {
         for my $c (qw(pver command ostype)) {
            die "Required header \"$c\" missing" unless exists $P{$c};
         }
         die "illegal version" unless $P{pver} eq "1.0";
         if($P{command} eq "store") {
                if(exists $data->{file}) {
                        my $dest = $data->{file};
                   	open my $fh, ">", "$dest.$$" or die "open $dest.$$";
                  	remote_edit_store($fh);
                   	close $fh;
                        rename "$dest.$$", $dest or die "can't rename to $dest";
                } else {
                	${$data->{ref}} = &remote_edit_parse;
                }
         	content_type "text/plain";
         	$request->status(200);
         	echo "update ok";
         } elsif ($P{command} eq "fetch") {
            abort_with { 
               		 if(exists $data->{file}) {
                            use PApp qw(abort_with_file);
                            my $file = $data->{file};
                            if(! -f $file && exists $data->{template}) {
                              $file = $data->{template};
                            }
                            open my $fh, "<", $file or die "can't open $file";
                            abort_with_file $fh, $data->{mime};
                         } else {
				content_type $data->{mime};
               		 	echo ${$data->{ref}};
                         }
            };
         } else {
            die "illegal command specified.";
         }
      } else {

         $flags{extension} ||= ".$mimetypes{$data->{mime}}" || ".no-mime.bin";
         $flags{Url} = "http://" . $request->hostname . ":" . $request->get_server_port . $data->{upd};
         $flags{"Content-Type"} = $data->{mime};
	 $flags{"Server-Date"} = time2str();
         $flags{"Xpcse-Protocol-Version"} = "1.0";
         my $flags;
         while(my ($x,$y) = each %flags) {
            $x =~ s/[ \t:\012\015]//g;
            $flags .= "$x: $y\015\012";
         }
         content_type "application/x-papp-edit", "utf-8";
         $request->header_out("Content-Disposition" => "filename=x.xpcse"); # for windows (file extension!)
         :><? "$flags\015\012":>
         <:
      }
   }
:>]]></phtml></callback>

<macro name="client_edit_surl*" args="$ref $mime %flags"><perl><![CDATA[
   my $data = {
      (ref $ref) ? (ref => $ref) : (file => $ref),
      mime => $mime || "text/plain",
      flags => { %flags },
   };
   $data->{upd} = surl SURL_EXEC($papp_ppkg->refer('remote_edit', $data, 1));
   surl SURL_EXEC($papp_ppkg->refer('remote_edit', $data, 0));
]]></perl></macro>

  
<macro name="client_edit_slink*" args="$content $ref $mime %flags"><perl><![CDATA[
   alink $content, client_edit_surl $ref, $mime, %flags;
]]></perl></macro>

<perl><![CDATA[

=head1 FUNCTIONS

=over 4

=item client_edit_surl $ref, $content-type, %flags

Returns a surl for remote editing ref

  $ref            A tied scalar that should be edited or a fully
                 qualified filename
  $content-type   Content-type like "image/jpg"
  @flags          Optional flags that affects processing.
                  Supported flags:

                      extension => ".png"
                        Extension like ".txt" (or "txt")

                      check_ms => 300
                        check interval for
                        filesystem updates

                      on_exit_only => 1
                        save only when client-app
                        is exiting

                      quiet => 1
                        suppress "Upload OK messages"

		      dirty_wait => 2
                        mtime must be stable for
                        dirty_wait check_ms rounds
                        before submitting

                      template => "/path/to/templatefile" 
                        use this file if source does not exists

  
=item client_edit_slink $content, $ref, $content-type, %flags

See C<client_edit_surl>

=back

=head1 SEE ALSO

L<PApp>

=head1 AUTHOR

 Marc Lehmann <pcg@goof.com>
 http://www.goof.com/pcg/marc/

=cut

]]></perl>

</domain>
</package>

