Merge branch 'ma/test-libcurl-prereq' into maint-2.46
[git/gitster.git] / contrib / long-running-filter / example.pl
bloba677569ddd95f4ce567570ad68111e37a5ed8508
1 #!/usr/bin/perl
3 # Example implementation for the Git filter protocol version 2
4 # See Documentation/gitattributes.txt, section "Filter Protocol"
6 # Please note, this pass-thru filter is a minimal skeleton. No proper
7 # error handling was implemented.
10 use strict;
11 use warnings;
13 my $MAX_PACKET_CONTENT_SIZE = 65516;
15 sub packet_bin_read {
16 my $buffer;
17 my $bytes_read = read STDIN, $buffer, 4;
18 if ( $bytes_read == 0 ) {
20 # EOF - Git stopped talking to us!
21 exit();
23 elsif ( $bytes_read != 4 ) {
24 die "invalid packet: '$buffer'";
26 my $pkt_size = hex($buffer);
27 if ( $pkt_size == 0 ) {
28 return ( 1, "" );
30 elsif ( $pkt_size > 4 ) {
31 my $content_size = $pkt_size - 4;
32 $bytes_read = read STDIN, $buffer, $content_size;
33 if ( $bytes_read != $content_size ) {
34 die "invalid packet ($content_size bytes expected; $bytes_read bytes read)";
36 return ( 0, $buffer );
38 else {
39 die "invalid packet size: $pkt_size";
43 sub packet_txt_read {
44 my ( $res, $buf ) = packet_bin_read();
45 unless ( $buf =~ s/\n$// ) {
46 die "A non-binary line MUST be terminated by an LF.";
48 return ( $res, $buf );
51 sub packet_bin_write {
52 my $buf = shift;
53 print STDOUT sprintf( "%04x", length($buf) + 4 );
54 print STDOUT $buf;
55 STDOUT->flush();
58 sub packet_txt_write {
59 packet_bin_write( $_[0] . "\n" );
62 sub packet_flush {
63 print STDOUT sprintf( "%04x", 0 );
64 STDOUT->flush();
67 ( packet_txt_read() eq ( 0, "git-filter-client" ) ) || die "bad initialize";
68 ( packet_txt_read() eq ( 0, "version=2" ) ) || die "bad version";
69 ( packet_bin_read() eq ( 1, "" ) ) || die "bad version end";
71 packet_txt_write("git-filter-server");
72 packet_txt_write("version=2");
73 packet_flush();
75 ( packet_txt_read() eq ( 0, "capability=clean" ) ) || die "bad capability";
76 ( packet_txt_read() eq ( 0, "capability=smudge" ) ) || die "bad capability";
77 ( packet_bin_read() eq ( 1, "" ) ) || die "bad capability end";
79 packet_txt_write("capability=clean");
80 packet_txt_write("capability=smudge");
81 packet_flush();
83 while (1) {
84 my ($command) = packet_txt_read() =~ /^command=(.+)$/;
85 my ($pathname) = packet_txt_read() =~ /^pathname=(.+)$/;
87 if ( $pathname eq "" ) {
88 die "bad pathname '$pathname'";
91 packet_bin_read();
93 my $input = "";
95 binmode(STDIN);
96 my $buffer;
97 my $done = 0;
98 while ( !$done ) {
99 ( $done, $buffer ) = packet_bin_read();
100 $input .= $buffer;
104 my $output;
105 if ( $command eq "clean" ) {
106 ### Perform clean here ###
107 $output = $input;
109 elsif ( $command eq "smudge" ) {
110 ### Perform smudge here ###
111 $output = $input;
113 else {
114 die "bad command '$command'";
117 packet_txt_write("status=success");
118 packet_flush();
119 while ( length($output) > 0 ) {
120 my $packet = substr( $output, 0, $MAX_PACKET_CONTENT_SIZE );
121 packet_bin_write($packet);
122 if ( length($output) > $MAX_PACKET_CONTENT_SIZE ) {
123 $output = substr( $output, $MAX_PACKET_CONTENT_SIZE );
125 else {
126 $output = "";
129 packet_flush(); # flush content!
130 packet_flush(); # empty list, keep "status=success" unchanged!