File Coverage

blib/lib/CGI/Application/Util/Diff.pm
Criterion Covered Total %
statement 42 235 17.8
branch 0 78 0.0
condition 0 36 0.0
subroutine 14 28 50.0
pod 3 14 21.4
total 59 391 15.0


line stmt bran cond sub pod time code
1             package CGI::Application::Util::Diff;
2              
3             # Author:
4             # Ron Savage
5              
6 1     1   20813 use base 'CGI::Application';
  1         3  
  1         1201  
7 1     1   14180 use strict;
  1         3  
  1         25  
8 1     1   5 use warnings;
  1         2  
  1         24  
9              
10 1     1   1071 use Algorithm::Diff qw/sdiff/;
  1         5496  
  1         69  
11              
12 1     1   8 use Carp;
  1         2  
  1         57  
13              
14 1     1   618 use CGI::Application::Util::Diff::Actions;
  1         2  
  1         65  
15 1     1   555 use CGI::Application::Util::Diff::Config;
  1         2  
  1         37  
16              
17 1     1   6 use Cwd; # For realpath.
  1         2  
  1         61  
18              
19 1     1   6508 use File::stat;
  1         16808  
  1         8  
20              
21 1     1   1023 use HTML::Entities::Interpolate; # For %Entitize.
  1         15234  
  1         8  
22 1     1   2147 use HTML::Template;
  1         15218  
  1         50  
23              
24 1     1   1064 use IPC::Capture;
  1         45092  
  1         40  
25              
26 1     1   1099 use JSON::XS;
  1         6614  
  1         67  
27              
28 1     1   784 use Path::Class; # For dir() and cleanup().
  1         18848  
  1         3525  
29              
30             our $VERSION = '1.03';
31              
32             # -----------------------------------------------
33              
34             sub build_form
35             {
36 0     0 0   my($self) = @_;
37 0           my($dir_action) = $self -> param('actions') -> get_dir_menu();
38 0           my(@dir_action) = map{qq|{text: "$$dir_action{$_}", value: "$_", onclick: {fn: onMenuItemClick} }|} sort keys %$dir_action;
  0            
39 0           my($file_action) = $self -> param('actions') -> get_file_menu();
40 0           my(@file_action) = map{qq|{text: "$$file_action{$_}", value: "$_", onclick: {fn: onMenuItemClick} }|} sort keys %$file_action;
  0            
41              
42             # Since this is Javascript, we must add a ',' to all elements but the last.
43             # We cannot add a ',' to all elements, and then use this:
44             # substr($dir_action[$#dir_action], -1, 1) = '';
45             # to chop a comma off the last element, because substr() won't work with an array element as an lvalue.
46              
47 0           for my $i (0 .. ($#dir_action - 1) )
48             {
49 0           $dir_action[$i] .= ',';
50             }
51              
52 0           for my $i (0 .. ($#file_action - 1) )
53             {
54 0           $file_action[$i] .= ',';
55             }
56              
57             # Build the form and the corresponding Javascript.
58              
59 0           $self -> param('js') -> param(confirm_action => $self -> param('actions') -> get_confirm_action());
60 0           $self -> param('js') -> param(dir_loop => [map{ {item => $_} } @dir_action]);
  0            
61 0           $self -> param('js') -> param(file_loop => [map{ {item => $_} } @file_action]);
  0            
62 0           $self -> param('js') -> param(form_action => $self -> param('config') -> get_form_action() );
63              
64             # Keep YUI happy by ensuring the HTML is one long string...
65              
66 0           my($form) = $self -> param('form') -> output();
67 0           $form =~ s/\n//g;
68              
69 0           $self -> log('Leaving build_form');
70              
71 0           return ($self -> param('js') -> output(), $form);
72              
73             } # End of build_form.
74              
75             # -----------------------------------------------
76              
77             sub cgiapp_init
78             {
79 0     0 1   my($self) = @_;
80              
81 0           $self -> param(config => CGI::Application::Util::Diff::Config -> new() );
82 0           $self -> tmpl_path($self -> param('config') -> get_tmpl_path() );
83 0           $self -> param(actions => CGI::Application::Util::Diff::Actions -> new() );
84 0           $self -> param(form => $self -> load_tmpl('form.tmpl') );
85 0           $self -> param(js => $self -> load_tmpl('form.js') );
86 0           $self -> run_modes(['diff', 'initialize']);
87              
88             # Connect to the database for logging.
89              
90 0   0       my($logger_class, $logger_file) = split(/=/, $self -> param('config') -> get_logger() || '');
91              
92 0 0         if ($logger_class)
93             {
94 0           my($class) = $logger_class;
95 0           $class =~ s|::|/|g;
96              
97 0           eval qq|require "$class.pm"|;
98              
99 0 0         if ($@)
100             {
101 0           Carp::carp "Unable to require '$class'. Logging disabled. Error: $@";
102             }
103             else
104             {
105 0           $self -> param('logger' => $logger_class -> new({config_file => $logger_file}) );
106              
107 0           my($q) = $self -> query();
108              
109 0           $self -> log('=' x 50);
110 0           $self -> log("Param: $_ => " . $q -> param($_) ) for $q -> param();
111 0           $self -> log('Leaving cgiapp_init');
112             }
113             }
114              
115             } # End of cgiapp_init.
116              
117             # -----------------------------------------------
118              
119             sub check_names
120             {
121 0     0 0   my($self, $left_name, $right_name) = @_;
122 0           my($message) = '';
123              
124 0 0 0       if ($left_name && ! $right_name)
    0 0        
    0 0        
125             {
126 0           $message = $self -> error_message(2);
127             }
128             elsif ($right_name && ! $left_name)
129             {
130 0           $message = $self -> error_message(1);
131             }
132             elsif ($left_name && $right_name)
133             {
134 0 0         if (! -d $left_name)
    0          
135             {
136 0           $message = $self -> error_message(3);
137             }
138             elsif (! -d $right_name)
139             {
140 0           $message = $self -> error_message(4);
141             }
142             }
143              
144 0           $self -> log('Leaving check_names');
145              
146 0           return $message;
147              
148             } # End of check_names.
149              
150             # -----------------------------------------------
151              
152             sub diff
153             {
154 0     0 0   my($self) = @_;
155 0           my($query) = $self -> query();
156 0   0       my($left_name) = $query -> param('left') || '';
157 0   0       my($right_name) = $query -> param('right') || '';
158 0   0       my($action) = $query -> param('action') || '';
159 0   0       my($target) = $self -> remove_span($query -> param('target') || '');
160 0           my($message) = $self -> check_names($left_name, $right_name);
161 0           my($output) = '';
162 0           my($result) = [];
163              
164 0 0 0       if ($left_name && $right_name && ! $message)
      0        
165             {
166 0 0         $output = $action ? $self -> process_action($action, \$left_name, \$right_name, $target) : '';
167              
168 0           my(@result);
169              
170 0           ($message, @result) = $self -> read_dirs($left_name, $right_name);
171              
172 0 0         if (! $message)
173             {
174 0           $result = $self -> format_result(@result);
175             }
176             }
177              
178 0           $self -> log("Leaving run mode 'diff'");
179              
180             # $left_name and $right_name are in double quotes to satisfy Path::Class.
181             # Encode HTML entities with HTML::Entities::Interpolate.
182              
183 0 0         return JSON::XS -> new() -> encode
184             ({
185             response =>
186             {
187             left => "$left_name",
188             message => $message ? $self -> format_span($Entitize{$message}) : '',
189             output => $output,
190             table => $result,
191             right => "$right_name",
192             }
193             });
194              
195             } # End of diff.
196              
197             # -----------------------------------------------
198              
199             sub error_message
200             {
201 0     0 0   my($self, $n, $s) = @_;
202 0           my(%message) =
203             (
204             1 => 'Left directory name not specified',
205             2 => 'Right directory name not specified',
206             3 => 'Left name is not a directory',
207             4 => 'Right name is not a directory',
208             5 => "Can't open($s): $!",
209             6 => "Unexpected action '$s'",
210             );
211              
212 0           return $message{$n};
213              
214             } # End of error_message.
215              
216             # -----------------------------------------------
217              
218             sub format_result
219             {
220 0     0 0   my($self, @result) = @_;
221 0           my(@sdiff) = sdiff([sort keys %{$result[0]}], [sort keys %{$result[1]}]);
  0            
  0            
222              
223 0           my($left, $left_name);
224 0           my(@output);
225 0           my($right, $right_name);
226              
227 0           for my $item (@sdiff)
228             {
229 0           $left = ${$result[0]}{$$item[1]};
  0            
230 0 0 0       $left_name = $$left{'type'} && ($$left{'type'} eq 'Dir') ? $self -> format_span($$item[1], 'green') : $$item[1];
231 0           $right = ${$result[1]}{$$item[2]};
  0            
232 0 0 0       $right_name = $$right{'type'} && ($$right{'type'} eq 'Dir') ? $self -> format_span($$item[2], 'green') : $$item[2];
233              
234 0 0         if ($$item[0] eq '-')
    0          
    0          
235             {
236 0           push @output,
237             {
238             left_size => $$left{'size'},
239             left_mtime => $$left{'mtime'},
240             match => $self -> format_span('x'),
241             name => $left_name,
242             right_size => '',
243             right_mtime => '',
244             type => $$left{'type'},
245             };
246             }
247             elsif ($$item[0] eq '+')
248             {
249 0           push @output,
250             {
251             left_size => '',
252             left_mtime => '',
253             match => $self -> format_span('x'),
254             name => $right_name,
255             right_size => $$right{'size'},
256             right_mtime => $$right{'mtime'},
257             type => $$right{'type'},
258             };
259             }
260             elsif ($$item[0] eq 'u')
261             {
262             # Currently, we only check that the sizes match.
263              
264 0 0         if ($$left{'size'} eq $$right{'size'})
265             {
266 0           push @output,
267             {
268             left_size => $$left{'size'},
269             left_mtime => $$left{'mtime'},
270             match => '',
271             name => $left_name,
272             right_size => $$right{'size'},
273             right_mtime => $$right{'mtime'},
274             type => $$left{'type'},
275             };
276             }
277             else
278             {
279 0           push @output,
280             {
281             left_size => $$left{'size'},
282             left_mtime => $$left{'mtime'},
283             match => $self -> format_span('x'),
284             name => $left_name,
285             right_size => $$right{'size'},
286             right_mtime => $$right{'mtime'},
287             type => $$left{'type'},
288             };
289             }
290             }
291             else # 'c'.
292             {
293 0 0         if ($$item[1] lt $$item[2])
294             {
295 0           push @output,
296             {
297             left_size => $$left{'size'},
298             left_mtime => $$left{'mtime'},
299             match => $self -> format_span('x'),
300             name => $left_name,
301             right_size => '',
302             right_mtime => '',
303             type => $$left{'type'},
304             };
305 0           push @output,
306             {
307             left_size => '',
308             left_mtime => '',
309             match => $self -> format_span('x'),
310             name => $right_name,
311             right_size => $$right{'size'},
312             right_mtime => $$right{'mtime'},
313             type => $$right{'type'},
314             };
315             }
316             else
317             {
318 0           push @output,
319             {
320             left_size => '',
321             left_mtime => '',
322             match => $self -> format_span('x'),
323             name => $right_name,
324             right_size => $$right{'size'},
325             right_mtime => $$right{'mtime'},
326             type => $$right{'type'},
327             };
328 0           push @output,
329             {
330             left_size => $$left{'size'},
331             left_mtime => $$left{'mtime'},
332             match => $self -> format_span('x'),
333             name => $left_name,
334             right_size => '',
335             right_mtime => '',
336             type => $$left{'type'},
337             };
338             }
339             }
340             }
341              
342 0           $self -> log('Leaving format_result');
343              
344 0           return [sort{$$a{'name'} cmp $$b{'name'} } @output];
  0            
345              
346             } # End of format_result.
347              
348             # -----------------------------------------------
349              
350             sub format_span
351             {
352 0     0 0   my($self, $s, $color) = @_;
353 0   0       $color ||= 'red';
354              
355 0           return qq|$s|;
356              
357             } # End of format_span.
358              
359             # -----------------------------------------------
360              
361             sub initialize
362             {
363 0     0 0   my($self) = @_;
364 0           my(@form) = $self -> build_form();
365              
366             # Generate the Javascript which will be called upon page load.
367              
368 0           my($head_init) = <
369             make_left_name_focus();
370             EJS
371              
372             # Generate the Javascript which will do all the work.
373              
374 0           my($head_js) = <
375             $form[0]
376              
377             function make_left_name_focus(eve)
378             {
379             document.util_diff_form.left.focus();
380             }
381             EJS
382              
383             # Generate the web page itself. This is not loaded by sub cgiapp_init(),
384             # because, with AJAX, we only need it the first time the script is run.
385              
386 0           my($page) = $self -> load_tmpl('web.page.tmpl');
387              
388 0           $page -> param(content => $form[1]);
389 0           $page -> param(head_init => $head_init);
390 0           $page -> param(head_js => $head_js);
391 0           $page -> param(yui_url => $self -> param('config') -> get_yui_url() );
392              
393 0           $self -> log("Leaving run mode 'initialize'");
394              
395 0           return $page -> output();
396              
397             } # End of initialize.
398              
399             # -----------------------------------------------
400              
401             sub log
402             {
403 0     0 1   my($self, $s) = @_;
404              
405 0 0         if ($self -> param('logger') )
406             {
407 0           $self -> param('logger') -> log($s);
408             }
409              
410             } # End of log.
411              
412             # -----------------------------------------------
413              
414             sub process_action
415             {
416 0     0 0   my($self, $action, $left_name, $right_name, $target) = @_;
417              
418 0           my(%command, $command);
419              
420 0           $command{'dir'} = $self -> param('actions') -> get_dir_commands();
421 0           $command{'file'} = $self -> param('actions') -> get_file_commands();
422 0           my($output) = [];
423              
424 0 0         if ($action eq 'dir_cd_both')
    0          
    0          
    0          
    0          
    0          
    0          
    0          
425             {
426             # We want to handle the case where the user goes into a directory,
427             # and then back out again by clicking on '..', but Path::Class::dir::cleanup()
428             # calls File::Spec::canonpath(), which does not clean-up '/a/b/..' to '/a'.
429              
430 0           $$left_name = Cwd::realpath(dir($$left_name, $target) );
431 0           $$right_name = Cwd::realpath(dir($$right_name, $target) );
432             }
433             elsif ($action eq 'dir_cd_left')
434             {
435 0           $$left_name = Cwd::realpath(dir($$left_name, $target) );
436             }
437             elsif ($action eq 'dir_cd_right')
438             {
439 0           $$right_name = Cwd::realpath(dir($$right_name, $target) );
440             }
441             elsif ($action =~ /(dir|file)_(cp|mv)_left2right/)
442             {
443 0           my($type) = $1;
444 0           my($act) = $2;
445 0           my($key) = "${type}_${act}_left2right";
446 0           my($left) = file($$left_name, $target);
447 0           my($right) = file($$right_name, $target);
448 0           $command = qq|$command{$type}{$key} "$left" "$right"|;
449             }
450             elsif ($action =~ /(dir|file)_(cp|mv)_right2left/)
451             {
452 0           my($type) = $1;
453 0           my($act) = $2;
454 0           my($key) = "${type}_${act}_right2left";
455 0           my($left) = file($$left_name, $target);
456 0           my($right) = file($$right_name, $target);
457 0           $command = qq|$command{$type}{$key} "$right" "$left"|;
458             }
459             elsif ($action eq 'file_diff')
460             {
461 0           my($left) = file($$left_name, $target);
462 0           my($right) = file($$right_name, $target);
463 0           $command = qq|$command{'file'}{'file_diff'} "$left" "$right"|;
464             }
465             elsif ($action =~ /(dir|file)_rm_both/)
466             {
467 0           my($type) = $1;
468 0           my($key) = "${type}_rm_both";
469 0 0         my($left) = $type eq 'dir' ? dir($$left_name) : file($$left_name, $target);
470 0 0         my($right) = $type eq 'dir' ? dir($$right_name) : file($$right_name, $target);
471 0           $command = qq|$command{$type}{$key} "$left" "$right"|;
472             }
473             elsif ($action =~ /(dir|file)_rm_(left|right)/)
474             {
475 0           my($type) = $1;
476 0           my($side) = $2;
477 0           my($key) = "${type}_rm_$side";
478 0 0         my($left) = $type eq 'dir' ? dir($$left_name) : file($$left_name, $target);
479 0 0         my($right) = $type eq 'dir' ? dir($$right_name) : file($$right_name, $target);
480 0 0         my($thing) = $side eq 'left' ? $left : $right;
481 0           $command = qq|$command{$type}{$key} "$thing"|;
482             }
483             else
484             {
485 0           $output = $self -> error_output(6, $action);
486             }
487              
488 0 0         if ($command)
489             {
490 0           $self -> log(qq|Running command: $command|);
491              
492             # We use IPC::Capture with autochomp false so we can split the output string.
493              
494 0           my($ipc) = IPC::Capture -> new({filter => 'all_output'});
495 0           my($result) = $ipc -> run($command);
496 0           @$output = split(/\n/, $result);
497              
498 0 0         if ($action eq 'file_diff')
499             {
500 0           my($limit) = $self -> param('actions') -> get_max_diff_line_count();
501              
502 0 0         if ($#$output >= $limit)
503             {
504 0           my($diff) = $#$output + 1 - $limit;
505 0           $#$output = $limit - 1;
506              
507 0 0         push @$output, "Output truncated by $diff line" . ($diff == 1 ? '' : 's');
508             }
509             }
510              
511             # Log before calling $Entitize{...}!
512              
513 0           $self -> log('First few lines of output');
514              
515 0 0         for my $i (0 .. ( ($#$output >= 4) ? 4 : $#$output) )
516             {
517 0           $self -> log($$output[$i]);
518             }
519              
520 0           @$output = map{ {line => $Entitize{$_} } } @$output;
  0            
521             }
522              
523 0           $self -> log("Leaving run mode 'process_action'");
524              
525 0           return $output;
526              
527             } # End of process_action.
528              
529             # -----------------------------------------------
530              
531             sub read_dir
532             {
533 0     0 0   my($self, $dir_name) = @_;
534              
535 0 0         opendir(INX, $dir_name) || return ($self -> error_message(5, $dir_name), []);
536 0           my(@file_name) = readdir INX;
537 0           closedir INX;
538              
539 0           my(%file_name);
540             my($name);
541 0           my($stat);
542              
543 0           for my $file_name (@file_name)
544             {
545 0           $name = file($dir_name, $file_name);
546 0           $stat = stat($name);
547 0 0         $file_name{$file_name} =
548             {
549             mtime => scalar localtime($stat -> mtime() ),
550             size => $stat -> size(),
551             type => -d $name ? 'Dir' : 'File',
552             };
553             }
554              
555 0           $self -> log('Leaving read_dir');
556              
557 0           return ('', {%file_name});
558              
559             } # End of read_dir.
560              
561             # -----------------------------------------------
562              
563             sub read_dirs
564             {
565 0     0 0   my($self, $left, $right) = @_;
566 0           my(@left_result) = $self -> read_dir($left);
567 0           my(@right_result) = $self -> read_dir($right);
568              
569 0           $self -> log('Leaving read_dirs');
570              
571 0   0       return ($left_result[0] || $right_result[0], $left_result[1], $right_result[1]);
572              
573             } # End of read_dirs.
574              
575             # -----------------------------------------------
576              
577             sub remove_span
578             {
579 0     0 0   my($self, $s) = @_;
580 0           $s =~ s|^(.+)$|$1|;
581              
582 0           return $s;
583              
584             } # End of remove_span.
585              
586             # -----------------------------------------------
587              
588             sub teardown
589             {
590 0     0 1   my($self) = @_;
591              
592 0           $self -> log('Leaving ' . __PACKAGE__);
593              
594             } # End of teardown.
595              
596             # -----------------------------------------------
597              
598             1;
599              
600             =head1 NAME
601              
602             C - Diff 2 directories or files, or run other commands
603              
604             =head1 Synopsis
605              
606             A classic CGI script:
607              
608             use strict;
609             use warnings;
610              
611             use CGI;
612             use CGI::Application::Dispatch;
613              
614             # ---------------------
615              
616             my($cgi) = CGI -> new();
617              
618             CGI::Application::Dispatch -> dispatch
619             (
620             args_to_new => {QUERY => $cgi},
621             prefix => 'CGI::Application::Util',
622             table =>
623             [
624             '' => {app => 'Diff', rm => 'initialize'},
625             '/diff' => {app => 'Diff', rm => 'diff'},
626             ],
627             );
628              
629             A modern FCGI script:
630              
631             use strict;
632             use warnings;
633              
634             use CGI::Application::Dispatch;
635             use CGI::Fast;
636             use FCGI::ProcManager;
637              
638             # ---------------------
639              
640             my($proc_manager) = FCGI::ProcManager -> new({processes => 2});
641              
642             $proc_manager -> pm_manage();
643              
644             my($cgi);
645              
646             while ($cgi = CGI::Fast -> new() )
647             {
648             $proc_manager -> pm_pre_dispatch();
649              
650             CGI::Application::Dispatch -> dispatch
651             (
652             args_to_new => {QUERY => $cgi},
653             prefix => 'CGI::Application::Util',
654             table =>
655             [
656             '' => {app => 'Diff', rm => 'initialize'},
657             '/diff' => {app => 'Diff', rm => 'diff'},
658             ],
659             );
660              
661             $proc_manager -> pm_post_dispatch();
662             }
663              
664             =head1 Description
665              
666             C diffs 2 directories or files, or runs other commands. on the web server's machine.
667              
668             The output of a directory diff is a table, where the I column contains a red 'x' if there is a mis-match in the sizes
669             of a file or sub-directory in the 2 given directories.
670              
671             You click on a file name, or any field in the row, and a menu appears (beside the I button) which contains the actions available.
672              
673             The output of a file diff is the output of the shell's I command.
674              
675             Available actions are in the file lib/CGI/Application/Util/Diff/.htutil.diff.actions.conf. They are listed below.
676              
677             There is an action confirmation option in this file, which you are strongly advised to leave as is.
678              
679             The confirmation is effected by means of a call to the Javascript confirm() function.
680              
681             I hope this will be the first in a set of such tools. I plan to release any of my own under the same
682             namespace C.
683              
684             Since I expect this set to grow, I've decided to immediately adopt a Javascript library, rather than struggle
685             with a more ad hoc approach. And the Yahoo User Interface, YUI, is the one I like the most.
686              
687             This module was developed using YUI V 2.7.0b.
688              
689             =head1 Security
690              
691             This module does not incorporate any security protection whatsoever.
692              
693             If you need any more convincing that this module is unsafe because it runs shell commands,
694             there is plenty of info on the net about this topic. For instance:
695              
696             http://hea-www.harvard.edu/~fine/Tech/cgi-safe.html
697              
698             =head1 Actions
699              
700             =head2 Overview
701              
702             The actions will actually be run under the user who is running the web server.
703              
704             This is often a fake human called I or I.
705              
706             Such special user accounts normally have deliberately restricted permissions, so you might find the commands don't appear to do anything.
707              
708             How you solve that on your machine is a security issue you must deal with.
709              
710             =head2 Details
711              
712             This is the contents of .htutil.diff.actions.conf:
713              
714             [global]
715            
716             # This option, when 1, causes a Javascript confirm() message box
717             # to pop-up before the action is sent to the server.
718             # If not present, the value defaults to 1.
719            
720             confirm_action = 1
721            
722             # The option limits output of the file_diff action.
723             # If not present, the value defaults to 100.
724            
725             max_diff_line_count = 100
726            
727             # Actions
728             # -------
729             # Format: Name = Shell command (except for 'cd') = Javascript menu text.
730             # The duplication is deliberate. It allows 'action' to be validated, because the first token
731             # on each line is sent to the client, and returned by the CGI form field 'action'
732             # when the user selects an action from the menu.
733             #
734             # Also, in CGI::Application::Util::Diff::Actions, all of these keys are stored in a single hash.
735             #
736             # For Perl equivalents of these shell commands, see:
737             # o File::Copy::Recursive
738             # o File::Tools
739             # o File::Util
740            
741             [dir]
742            
743             # The 'cd' commands don't actually use the shell's 'cd',
744             # and neither do they use Perl's 'chdir'.
745             # Rather, the CGI form fields 'left' and 'right'
746             # have the chosen directory appended. This emulates 'cd'.
747            
748             dir_cd_both = cd = Change directory on both sides
749             dir_cd_left = cd = Change directory on left side
750             dir_cd_right = cd = Change directory on right side
751            
752             # For here on down, they are shell commands.
753             # Warning: Don't use anything which prompts, e.g. mv -i,
754             # or your app will hang, making you look r-e-a-l-l-y stupid!
755            
756             dir_cp_left2right = cp -fprv = Copy directory from left side to right
757             dir_cp_right2left = cp -fprv = Copy directory from right side to left
758            
759             dir_mv_left2right = mv -fv = Move directory from left side to right
760             dir_mv_right2left = mv -fv = Move directory from right side to left
761            
762             dir_rm_both = rm -frv = Remove directory from both sides
763             dir_rm_left = rm -frv = Remove directory from left side
764             dir_rm_right = rm -frv = Remove directory from right side
765            
766             [file]
767            
768             file_cp_left2right = cp -fpv = Copy file from left side to right
769             file_cp_right2left = cp -fpv = Copy file from right side to left
770            
771             file_diff = diff = Run 'diff' on left and right files
772            
773             file_mv_left2right = mv -fv = Move file from left side to right
774             file_mv_right2left = mv -fv = Move file from right side to left
775            
776             file_rm_both = rm -frv = Remove file from both sides
777             file_rm_left = rm -frv = Remove file from left side
778             file_rm_right = rm -frv = Remove file from right side
779              
780             =head2 A Note on Diff
781              
782             The file_diff action, unlike the other actions, has the potential to output a great deal of text.
783              
784             To help protect against that, the file .htutil.diff.actions.conf has a [global] section containing the line:
785              
786             max_diff_line_count = 100
787              
788             This is the maximum number of lines of output from diff which are transferred from this module to the web client.
789              
790             It's set large enough to give you a clear indicator that the 2 files being diffed are indeed different,
791             without being so large as to overwhelm the web client.
792              
793             =head1 Contents
794              
795             C ships with:
796              
797             =over 4
798              
799             =item Two instance scripts: util.diff.cgi and util.diff
800              
801             I is a trivial C script, while I is a fancy script which uses C.
802              
803             Both use C.
804              
805             Trivial here refers to using a classic C-style script, while fancy refers to using a modern C-style script.
806              
807             The word fancy was chosen because it allows you to use fancier URLs. For samples, see I, below.
808              
809             The scripts are shipped as httpd/cgi-bin/util.diff.cgi and htdocs/local/util.diff.
810              
811             These directory names were chosen because you'll be installing I in your web server's cgi-bin/
812             directory, whereas you'll install I in a directory under your web server's doc root.
813              
814             For home-grown modules, I use the namespace Local::*, and for local web server scripts I use the
815             directory local/ under Apache's doc root.
816              
817             For C, see http://fastcgi.coremail.cn/.
818              
819             C is a replacement for the older C. For C, see http://www.fastcgi.com/drupal/.
820              
821             Also, edit I and I to fix the 'use lib' line. See the I in those files for details.
822              
823             =item A set of C templates: *.tmpl
824              
825             See htdocs/assets/templates/cgi/application/util/diff/*.
826              
827             =item A config file for C
828              
829             See lib/CGI/Application/Util/Diff/.htutil.diff.conf.
830              
831             =item A config file for C
832              
833             See lib/CGI/Application/Util/Diff/.htutil.diff.actions.conf.
834              
835             =item A config file for C
836              
837             See lib/CGI/Application/Util/.htutil.logger.conf.
838              
839             =item A patch to httpd.conf, if you run Apache and FCGID.
840              
841             See httpd/conf/httpd.conf.
842              
843             Yes, I realise that if you run FCGID you already have this patch installed, but there's nothing
844             wrong with having such information documented in various places.
845              
846             =back
847              
848             Lastly, the config files .htutil.*.conf are installed by both Build.PL and Makefile.PL.
849              
850             =head1 Bells and Whistles
851              
852             For a huge range of features, in a package developed over many years, see Webmin:
853              
854             http://www.webmin.com/
855              
856             However, I could not see anything in Webmin's standard packages which offered the same features as this module.
857             And that's probably because of security concerns.
858              
859             =head1 Logging
860              
861             C ships with a default logging module, C.
862              
863             The option to activate logging is 'logging', in .htutil.diff.conf.
864              
865             If this line is missing, no attempt is made to log.
866              
867             Note: The logger's own config file, .htutil.logger.conf by default, might also turn logging off.
868              
869             The default 'logging' line looks something like:
870              
871             logger=CGI::Application::Util::Logger=/some/dir/CGI/Application/Util/.htutil.logger.conf
872              
873             You'll notice it refers to the Util/ directory, not the Util/Diff/ directory.
874              
875             This is because this logging mechanism is meant to be shared among all modules in the
876             C namespace.
877              
878             This version of C does not contain a menuing system for such utilities,
879             because there is as yet only this 1 module, but later versions will.
880              
881             If the logging class cannot be loaded (with 'require'), the error is ignored, and no logging takes place,
882             but a message is written to the web-server's log with C.
883              
884             =head1 Distributions
885              
886             This module is available as a Unix-style distro (*.tgz).
887              
888             See http://savage.net.au/Perl-modules/html/installing-a-module.html for
889             help on unpacking and installing distros.
890              
891             =head1 Installation
892              
893             At the very least, you will need to patch .htutil.diff.conf, since that's where C's
894             tmpl_path is stored, if using another path.
895              
896             Config file options are documented in the config file itself.
897              
898             Also, you may want to edit .htutil.logger.conf and .htutil.diff.actions.conf.
899              
900             =head2 Install the module
901              
902             Note: I and I refer to C. If you are not going to use
903             the fancy script, you don't need C.
904              
905             Install C as you would for any C module:
906              
907             Run I: shell>sudo cpan CGI::Application::Util::Diff
908              
909             or unpack the distro, and then either:
910              
911             perl Build.PL
912             ./Build
913             ./Build test
914             sudo ./Build install
915              
916             or:
917              
918             perl Makefile.PL
919             make (or dmake)
920             make test
921             make install
922              
923             =head2 Install the C files.
924              
925             Copy the distro's htdocs/assets/ directory to your doc root.
926              
927             =head2 Install the trivial instance script
928              
929             Copy the distro's httpd/cgi-bin/util.diff.cgi to your cgi-bin/ directory,
930             and make I executable.
931              
932             =head2 Install the fancy instance script
933              
934             Copy the distro's htdocs/local/ directory to your doc root, and make I executable.
935              
936             =head2 Configure C to use /local/util.diff
937              
938             If in fancy mode, add these to C's httpd.conf:
939              
940             LoadModule fcgid_module modules/mod_fcgid.so
941              
942             and:
943              
944            
945             SetHandler fcgid-script
946             Options ExecCGI
947             Order deny,allow
948             Deny from all
949             Allow from 127.0.0.1
950            
951              
952             Of course, use of '/local' is not mandatory; you could use any URL fragment there.
953              
954             And don't forget to restart C after editing it's httpd.conf.
955              
956             =head2 Start testing
957              
958             Point your broswer at http://127.0.0.1/cgi-bin/util.diff.cgi (trivial script), or
959             http://127.0.0.1/local/util.diff (fancy script).
960              
961             =head1 FAQ
962              
963             =over 4
964              
965             =item The command did nothing!
966              
967             What you mean is that it did not perform according to your false expectations, and/or you did not read
968             the section called Actions.
969              
970             The user running the web server is the user who runs these actions, and hence their limited permissions
971             means the actions are limited in what they are allowed to do.
972              
973             =item The log always contains the word 'message'!
974              
975             Right! The log is a database table, and the column heading you refer to I be there.
976              
977             =back
978              
979             =head1 Author
980              
981             C was written by Ron Savage Iron@savage.net.auE> in 2009.
982              
983             Home page: http://savage.net.au/index.html
984              
985             =head1 Copyright
986              
987             Australian copyright (c) 2009, Ron Savage.
988             All Programs of mine are 'OSI Certified Open Source Software';
989             you can redistribute them and/or modify them under the terms of
990             The Artistic License, a copy of which is available at:
991             http://www.opensource.org/licenses/index.html
992              
993             =cut