← Back to branch summary

~ubuntu-branches/ubuntu/precise/topal/precise

« back to all changes in this revision

Viewing changes to externals-simple.adb

  • Committer: Bazaar Package Importer
  • Author(s): Phil Brooke
  • Date: 2008-07-18 07:57:38 UTC
  • mto: This revision was merged to the branch mainline in revision 3.
  • Revision ID: james.westby@ubuntu.com-20080718075738-i1szqvmxz0evz32p
Tags: upstream-62
Import upstream version 62

Show diffs side-by-side

added added

removed removed

Lines of Context:
externals-simple.adb
1
 
--
2
 
--
3
 
--
4
 
--
 
1
-- Topal: GPG/GnuPG and Alpine/Pine integration
 
2
-- Copyright (C) 2001--2008  Phillip J. Brooke
 
3
--
 
4
-- This program is free software: you can redistribute it and/or modify
 
5
-- it under the terms of the GNU General Public License version 3 as
 
6
-- published by the Free Software Foundation.
 
7
--
 
8
-- This program is distributed in the hope that it will be useful,
 
9
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
 
10
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
11
-- GNU General Public License for more details.
 
12
--
 
13
-- You should have received a copy of the GNU General Public License
 
14
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
5
15
 
6
16
with Ada.IO_Exceptions;
7
17
with Ada.Text_IO;
145
142
   exception
146
143
      when others =>
147
144
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
148
 
                              "Exception raised in Externals.Simple.Cat_Append");
 
145
                              "Exception raised in Externals.Simple.Cat_Append("&D1&","&D2&")");
149
146
         raise;
150
147
   end Cat_Append;
151
148
 
152
149
   procedure Chmod (P : in String;
153
150
                    D : in String) is
154
151
   begin
155
 
      if ForkExec(Misc.Value_Nonempty(Config.Chmod_Binary),
 
152
      if ForkExec(Misc.Value_Nonempty(Config.Binary(Chmod)),
156
153
                  UBS_Array'(0 => ToUBS("chmod"),
157
154
                             1 => ToUBS(P),
158
155
                             2 => ToUBS(D))) /= 0 then
167
164
 
168
165
   procedure Clear is
169
166
   begin
170
 
      if ForkExec(Misc.Value_Nonempty(Config.Clear_Binary),
 
167
      if ForkExec(Misc.Value_Nonempty(Config.Binary(Clear)),
171
168
                  UBS_Array'(0 => ToUBS("clear"))) /= 0 then
172
169
         Misc.Error("`clear' failed.");
173
170
      end if;
180
177
 
181
178
   procedure Date_Append (D : in String) is
182
179
   begin
183
 
      if ForkExec_Append(Misc.Value_Nonempty(Config.Date_Binary),
 
180
      if ForkExec_Append(Misc.Value_Nonempty(Config.Binary(Date)),
184
181
                         UBS_Array'(0 => ToUBS("date")),
185
182
                         D) /= 0 then
186
183
         Misc.Error("`date >> " & D & "' failed.");
192
189
         raise;
193
190
   end Date_Append;
194
191
 
 
192
   procedure Date_1_Append (A, D : in String) is
 
193
   begin
 
194
      if ForkExec_Append(Misc.Value_Nonempty(Config.Binary(Date)),
 
195
                         UBS_Array'(0 => ToUBS("date"),
 
196
                                    1 => ToUBS(A)),
 
197
                         D) /= 0 then
 
198
         Misc.Error("`date " & A & " >> " & D & "' failed.");
 
199
      end if;
 
200
   exception
 
201
      when others =>
 
202
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
 
203
                              "Exception raised in Externals.Simple.Date_1_Append");
 
204
         raise;
 
205
   end Date_1_Append;
 
206
 
195
207
   function Date_String return String is
196
208
      use Ada.Text_IO;
197
209
      use Misc;
198
 
      Target : String := Temp_File_Name("thedate");
 
210
      Target : constant String := Temp_File_Name("thedate");
199
211
      TL     : UBS;
200
212
      F1     : File_Type;
201
213
   begin
202
 
      if ForkExec_Out(Misc.Value_Nonempty(Config.Date_Binary),
 
214
      if ForkExec_Out(Misc.Value_Nonempty(Config.Binary(Date)),
203
215
                      UBS_Array'(0 => ToUBS("date"),
204
216
                                 1 => ToUBS("+%Y%m%d%H%M%S")),
205
217
                      Target) /= 0 then
225
237
                        F2 : in String) return Boolean is
226
238
      E : Integer;
227
239
   begin
228
 
      E := ForkExec_Out(Misc.Value_Nonempty(Config.Diff_Binary),
 
240
      E := ForkExec_Out(Misc.Value_Nonempty(Config.Binary(Diff)),
229
241
                        UBS_Array'(0 => ToUBS("diff"),
230
242
                                   1 => ToUBS("--brief"),
231
243
                                   2 => ToUBS(F1),
249
261
 
250
262
   procedure Dos2Unix_U (D : in String) is
251
263
   begin
252
 
      if ForkExec(Misc.Value_Nonempty(Config.Dos2Unix_Binary),
 
264
      if ForkExec(Misc.Value_Nonempty(Config.Binary(Dos2Unix)),
253
265
                  UBS_Array'(0 => ToUBS("dos2unix"),
254
266
                             1 => ToUBS("-u"),
255
267
                             2 => ToUBS(D))) /= 0 then
264
276
 
265
277
   procedure Dos2Unix (D : in String) is
266
278
   begin
267
 
      if ForkExec(Misc.Value_Nonempty(Config.Dos2Unix_Binary),
 
279
      if ForkExec(Misc.Value_Nonempty(Config.Binary(Dos2Unix)),
268
280
                  UBS_Array'(0 => ToUBS("dos2unix"),
269
281
                             1 => ToUBS(D))) /= 0 then
270
282
         Misc.Error("`dos2unix " & D & "' failed.");
302
314
         raise;
303
315
   end Echo_Append;
304
316
 
 
317
   procedure Echo_Append_N (E : in String;
 
318
                            D : in String) is
 
319
      use Misc;
 
320
      use Character_IO;
 
321
      F : File_Type;
 
322
   begin
 
323
      begin
 
324
         Open(File => F,
 
325
              Mode => Append_File,
 
326
              Name => D);
 
327
      exception
 
328
         when Ada.IO_Exceptions.Name_Error =>
 
329
            -- Try again with a create.
 
330
            Create(File => F,
 
331
                   Mode => Append_File,
 
332
                   Name => D);
 
333
      end;
 
334
      Character_IO_Put(F, E);
 
335
      Close(F);
 
336
   exception
 
337
      when others =>
 
338
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
 
339
                              "Exception raised in Externals.Simple.Echo_Append_N");
 
340
         raise;
 
341
   end Echo_Append_N;
 
342
 
305
343
   procedure Echo_Out (E : in String;
306
344
                       D : in String) is
307
345
      use Ada.Text_IO;
342
380
                          D1 : in String;
343
381
                          D2 : in String) return Integer is
344
382
   begin
345
 
      return ForkExec_InOut(Misc.Value_Nonempty(Config.Grep_Binary),
 
383
      return ForkExec_InOut(Misc.Value_Nonempty(Config.Binary(Grep)),
346
384
                            UBS_Array'(0 => ToUBS("grep"),
347
385
                                 1 => ToUBS("-i"),
348
386
                                       2 => ToUBS(T)),
357
395
 
358
396
   procedure Mkdir_P (D : in String) is
359
397
   begin
360
 
      if ForkExec(Misc.Value_Nonempty(Config.Mkdir_Binary),
 
398
      if ForkExec(Misc.Value_Nonempty(Config.Binary(Mkdir)),
361
399
                  UBS_Array'(0 => ToUBS("mkdir"),
362
400
                             1 => ToUBS("-p"),
363
401
                             2 => ToUBS(D))) /= 0 then
376
414
      if not Test_F(D1) then
377
415
         Misc.Error("`" & D1 & "' does not exist to be moved!");
378
416
      end if;
379
 
      if ForkExec(Misc.Value_Nonempty(Config.Mv_Binary),
 
417
      if ForkExec(Misc.Value_Nonempty(Config.Binary(Mv)),
380
418
                  UBS_Array'(0 => ToUBS("mv"),
381
419
                             1 => ToUBS("-f"),
382
420
                             2 => ToUBS(D1),
393
431
   -- View a file with a pager.
394
432
   procedure Pager (F : in String) is
395
433
   begin
396
 
      if ForkExec(Misc.Value_Nonempty(Config.Less_Binary),
 
434
      if ForkExec(Misc.Value_Nonempty(Config.Binary(Less)),
397
435
                  UBS_Array'(0 => ToUBS("less"),
398
436
                             1 => ToUBS(F))) /= 0 then
399
437
         Misc.Error("less failed! (ff4)");
407
445
 
408
446
   procedure Rm_File (F : in String) is
409
447
      Dummy : Integer;
 
448
      pragma Unreferenced(Dummy);
410
449
   begin
411
450
      -- We ignore Rm's return code.
412
 
      Dummy := ForkExec(Misc.Value_Nonempty(Config.Rm_Binary),
 
451
      Dummy := ForkExec(Misc.Value_Nonempty(Config.Binary(Rm)),
413
452
                        UBS_Array'(0 => ToUBS("rm"),
414
453
                                   1 => ToUBS("-f"),
415
454
                                   2 => ToUBS(F)));
423
462
   procedure Rm_Glob (Pattern : in String) is
424
463
      Files : UBS_Array := Glob(Pattern);
425
464
      Dummy : Integer;
 
465
      pragma Unreferenced(Dummy);
426
466
   begin
427
467
      -- Now, rather than deleting all of these at once, we'll give the list
428
468
      -- to a single instantiation of rm.
441
481
               -- and Files(Files'First = Files''First + I - 1).
442
482
               FEA(I + 1) := Files(Files'First + I -1);
443
483
               -- We ignore Rm's return code.
444
 
               Dummy := ForkExec(Misc.Value_Nonempty(Config.Rm_Binary), FEA);
 
484
               Dummy := ForkExec(Misc.Value_Nonempty(Config.Binary(Rm)), FEA);
445
485
            end loop;
446
486
         end;
447
487
      end if;
492
532
                        Source : in String;
493
533
                        Target : in String) is
494
534
   begin
495
 
      if ForkExec_InOut(Misc.Value_Nonempty(Config.Sed_Binary),
 
535
      if ForkExec_InOut(Misc.Value_Nonempty(Config.Binary(Sed)),
496
536
                        UBS_Array'(0 => ToUBS("sed"),
497
537
                                   1 => ToUBS(A)),
498
538
                        Source => Source,
508
548
 
509
549
   procedure Stty_Sane is
510
550
   begin
511
 
      if ForkExec(Misc.Value_Nonempty(Config.Stty_Binary),
 
551
      if ForkExec(Misc.Value_Nonempty(Config.Binary(Stty)),
512
552
               UBS_Array'(0 => ToUBS("stty"),
513
553
                          1 => ToUBS("sane"))) /= 0 then
514
554
         Misc.Error("`stty sane' failed.");
522
562
 
523
563
   function Test_D (D : in String)  return Boolean is
524
564
   begin
525
 
      return ForkExec(Misc.Value_Nonempty(Config.Test_Binary),
 
565
      return ForkExec(Misc.Value_Nonempty(Config.Binary(Test)),
526
566
                      UBS_Array'(0 => ToUBS("test"),
527
567
                                 1 => ToUBS("-d"),
528
568
                                 2 => ToUBS(D))) = 0;
535
575
 
536
576
   function Test_F (D : in String)  return Boolean is
537
577
   begin
538
 
      return ForkExec(Misc.Value_Nonempty(Config.Test_Binary),
 
578
      return ForkExec(Misc.Value_Nonempty(Config.Binary(Test)),
539
579
                      UBS_Array'(0 => ToUBS("test"),
540
580
                                 1 => ToUBS("-f"),
541
581
                                 2 => ToUBS(D))) = 0;
548
588
 
549
589
   function Test_R (D : in String) return Boolean is
550
590
   begin
551
 
      return ForkExec(Misc.Value_Nonempty(Config.Test_Binary),
 
591
      return ForkExec(Misc.Value_Nonempty(Config.Binary(Test)),
552
592
                      UBS_Array'(0 => ToUBS("test"),
553
593
                                 1 => ToUBS("-r"),
554
594
                                 2 => ToUBS(D))) = 0;
559
599
         raise;
560
600
   end Test_R;
561
601
 
 
602
   function Test_P (D : in String) return Boolean is
 
603
   begin
 
604
      return ForkExec(Misc.Value_Nonempty(Config.Binary(Test)),
 
605
                      UBS_Array'(0 => ToUBS("test"),
 
606
                                 1 => ToUBS("-p"),
 
607
                                 2 => ToUBS(D))) = 0;
 
608
   exception
 
609
      when others =>
 
610
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
 
611
                              "Exception raised in Externals.Simple.Test_P");
 
612
         raise;
 
613
   end Test_P;
 
614
 
562
615
   function Test_S (D : in String) return Boolean is
563
616
   begin
564
 
      return ForkExec(Misc.Value_Nonempty(Config.Test_Binary),
 
617
      return ForkExec(Misc.Value_Nonempty(Config.Binary(Test)),
565
618
                      UBS_Array'(0 => ToUBS("test"),
566
619
                                 1 => ToUBS("-S"),
567
620
                                 2 => ToUBS(D))) = 0;
572
625
         raise;
573
626
   end Test_S;
574
627
 
575
 
   -- View a MIME file.
576
 
   procedure View_MIME (F : String) is
577
 
   begin
578
 
      if ForkExec(Misc.Value_Nonempty(Config.Metamail_Binary),
579
 
                  UBS_Array'(0 => ToUBS("metamail"),
580
 
                             1 => ToUBS(F))) /= 0 then
581
 
         Misc.Error("metamail failed! (ff5)");
582
 
      end if;
583
 
   exception
584
 
      when others =>
585
 
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
586
 
                              "Exception raised in Externals.Simple.View_MIME");
587
 
         raise;
588
 
   end View_MIME;
 
628
   -- Guess content type of F using `file'.
 
629
   function Guess_Content_Type (F : in String) return String is
 
630
      use Misc;
 
631
      E1, E2     : Integer;
 
632
      GCT        : constant String        := Temp_File_Name("gct");
 
633
      H          : Ada.Text_IO.File_Type;
 
634
      First_Line : UBS;
 
635
   begin
 
636
      ForkExec2_Out(File1 => Value_Nonempty(Config.Binary(File)),
 
637
                    Argv1 => ToUBS("file "
 
638
                                   & ToStr(Config.Gpg_Options)
 
639
                                   & " -bi "
 
640
                                   & F),
 
641
                    Exit1 => E1,
 
642
                    File2 => Value_Nonempty(Config.Binary(Sed)),
 
643
                    Argv2 => UBS_Array'(0 => ToUBS("sed"),
 
644
                                        1 => ToUBS("s/,.*//")),
 
645
                    Exit2 => E2,
 
646
                    Target => GCT);
 
647
      if E1 /= 0 then
 
648
         Error("Problem generating keylist, GPG barfed (ff7a)");
 
649
      end if;
 
650
      if E2 /= 0 then
 
651
         Error("Problem generating keylist, grep barfed (ff7b)");
 
652
      end if;
 
653
      Ada.Text_IO.Open(File => H,
 
654
                       Mode => Ada.Text_IO.In_File,
 
655
                       Name => GCT);
 
656
      First_Line := Unbounded_Get_Line(H);
 
657
      Ada.Text_IO.Close(H);
 
658
      return ToStr(First_Line);
 
659
   exception
 
660
      when others =>
 
661
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
 
662
                              "Exception raised in Externals.Simple.Guess_Content_Type");
 
663
         raise;
 
664
   end Guess_Content_Type;
 
665
 
 
666
 
 
667
 
 
668
   -- Use locale charmap to get the current keymap.
 
669
   function Get_Charmap return String is
 
670
      use Misc;
 
671
      E          : Integer;
 
672
      GCM        : constant String        := Temp_File_Name("gcm");
 
673
      H          : Ada.Text_IO.File_Type;
 
674
      First_Line : UBS;
 
675
   begin
 
676
      E := ForkExec_Out(File => Value_Nonempty(Config.Binary(Locale)),
 
677
                        Argv => ToUBS("locale charmap"),
 
678
                        Target => GCM);
 
679
      if E /= 0 then
 
680
         Error("Problem extracting charmap from locale (ff10)");
 
681
      end if;
 
682
      Ada.Text_IO.Open(File => H,
 
683
                       Mode => Ada.Text_IO.In_File,
 
684
                       Name => GCM);
 
685
      First_Line := Unbounded_Get_Line(H);
 
686
      Ada.Text_IO.Close(H);
 
687
      return ToStr(First_Line);
 
688
   exception
 
689
      when others =>
 
690
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
 
691
                              "Exception raised in Externals.Simple.Get_Charmap");
 
692
         raise;
 
693
   end Get_Charmap;
 
694
 
 
695
   -- Convert charmaps within a single file (F) from charset CF to
 
696
   --  charset CT.
 
697
   procedure Convert_Charmap (F, CF, CT : in String) is
 
698
      use Misc;
 
699
      E          : Integer;
 
700
      CCM        : constant String        := Temp_File_Name("ccm");
 
701
   begin
 
702
      Misc.Debug("Convert_Charmap: attempt conversion of file `"
 
703
                 & F
 
704
                 & "' from charset `"
 
705
                 & CF
 
706
                 & "' to `"
 
707
                 & CT
 
708
                 & "'");
 
709
      E := ForkExec_InOut(File   => Value_Nonempty(Config.Binary(Iconv)),
 
710
                          Argv   => ToUBS("iconv -f " & CF & " -t " & CT),
 
711
                          Source => F,
 
712
                          Target => CCM);
 
713
      if E /= 0 then
 
714
         Error("Problem converting file charmap (ff15)");
 
715
      end if;
 
716
      -- Overwrite F.
 
717
      Mv_F(CCM, F);
 
718
   exception
 
719
      when others =>
 
720
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
 
721
                              "Exception raised in Externals.Simple.Convert_Charmap");
 
722
         raise;
 
723
   end Convert_Charmap;
 
724
 
 
725
   -- Equivalent of `system'.
 
726
   function System (Argv : in UBS) return Integer is
 
727
      A : UBS_Array := Misc.Split_Arguments(Argv);
 
728
   begin
 
729
      return ForkExec(ToStr(A(A'First)), Argv);
 
730
   exception
 
731
      when others =>
 
732
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
 
733
                              "Exception raised in Externals.Simple.System (Argv=`" & ToStr(Argv) & "'");
 
734
         raise;
 
735
   end System;
 
736
 
 
737
   function System (Argv : in String) return Integer is
 
738
   begin
 
739
      return System(ToUBS(Argv));
 
740
   exception
 
741
      when others =>
 
742
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
 
743
                              "Exception raised in Externals.Simple.System (B)");
 
744
         raise;
 
745
   end System;
589
746
 
590
747
end Externals.Simple;