← Back to branch summary

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

« back to all changes in this revision

Viewing changes to misc.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:
misc.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.Characters.Latin_1;
7
17
with Ada.Command_Line;
23
20
with Ada.Strings;
24
21
with Ada.Strings.Fixed;
25
22
with Ada.Text_IO;
 
23
with Externals.Simple;
 
24
with Help;
26
25
with Version_ID;
27
26
 
28
27
package body Misc is
130
129
         raise;
131
130
   end Trim_Leading_Spaces;
132
131
 
133
 
   -- Create our own temporary file names.
134
 
   function Temp_File_Name (Tail : String) return String is
 
132
   -- Create our own temporary file names.  To prevent collisions when
 
133
   --  the same Tail is used, we'll also insert a sequence number.
 
134
   Temp_File_Sequence_Number : Natural := 0;
 
135
   function Temp_File_Name (Tail                : String;
 
136
                            Use_Sequence_Number : Boolean := True) return String is
135
137
   begin
136
 
      return ToStr(Topal_Directory)
137
 
        & "/temp"
138
 
        & Trim_Leading_Spaces(Integer'Image(Our_PID))
139
 
        & Tail;
 
138
      -- If Topal_Directory doesn't exist, we'll create it.
 
139
      if not Externals.Simple.Test_D(ToStr(Topal_Directory)) then
 
140
         Externals.Simple.Mkdir_P(ToStr(Topal_Directory));
 
141
      end if;
 
142
      if Use_Sequence_Number then
 
143
         Temp_File_Sequence_Number := Temp_File_Sequence_Number + 1;
 
144
         return ToStr(Topal_Directory)
 
145
           & "/temp-"
 
146
           & Trim_Leading_Spaces(Integer'Image(Our_PID))
 
147
           & "-"
 
148
           & Trim_Leading_Spaces(Integer'Image(Temp_File_Sequence_Number))
 
149
           & "-"
 
150
           & Tail;
 
151
      else
 
152
         return ToStr(Topal_Directory)
 
153
           & "/temp-"
 
154
           & Trim_Leading_Spaces(Integer'Image(Our_PID))
 
155
           & "-"
 
156
           & Tail;
 
157
      end if;
140
158
   exception
141
159
      when others =>
142
160
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
188
206
         raise;
189
207
   end Unbounded_Get_Line;
190
208
 
 
209
   -- Eat and fold an entire file.
 
210
   function Read_Fold (File : in String) return UBS is
 
211
      F : Ada.Text_IO.File_Type;
 
212
      U : UBS := NullUBS;
 
213
   begin
 
214
      Debug("Opening file `" & File & "' for folded read into variable");
 
215
      Ada.Text_IO.Open(File => F,
 
216
                       Mode => Ada.Text_IO.In_File,
 
217
                       Name => File);
 
218
  Read_Loop:
 
219
      loop
 
220
         declare
 
221
            use type UBS;
 
222
         begin
 
223
            U := U & Unbounded_Get_Line(F);
 
224
         exception
 
225
            when Ada.IO_Exceptions.End_Error => exit Read_Loop; -- Okay.
 
226
         end;
 
227
      end loop Read_Loop;
 
228
      Ada.Text_IO.Close(File => F);
 
229
      return U;
 
230
   exception
 
231
      when others =>
 
232
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
 
233
                              "Exception raised in Misc.Read_Fold");
 
234
         raise;
 
235
   end Read_Fold;
 
236
 
191
237
   -- Open and close the result file.
192
238
   procedure Open_Result_File (Resultfile : in String) is
193
239
   begin
218
264
      use Ada.Text_IO;
219
265
   begin
220
266
      Put_Line("Topal " & Version_ID.Release
221
 
               & "  Copyright (C) 2001,2002 Phillip J. Brooke");
222
 
      Put_Line("Topal comes with ABSOLUTELY NO WARRANTY; "
223
 
               & "for details see the file `COPYING'.");
224
 
      Put_Line("This is free software, and you are welcome to redistribute "
225
 
               & "it under certain ");
226
 
      Put_Line("conditions; again, see the file `COPYING'.");
 
267
               & " (" & Version_ID.Build_Date & ")");
 
268
      Put_Line("Copyright (C) 2001--2008 Phillip J. Brooke");
 
269
      Help.Disclaimer;
227
270
      New_Line;
228
271
   exception
229
272
      when others =>
262
305
   -- search).  `"' can be included literally by stuffing: `""'.
263
306
   function Split_Arguments (A : UBS) return UBS_Array is
264
307
      BA : UBS_Big_Array;
265
 
      AS : String := ToStr(A);
 
308
      AS : constant String := ToStr(A);
266
309
      TI : Integer := 0;
267
310
      use UAP;
268
311
 
364
407
         raise;
365
408
   end Split_Arguments;
366
409
 
 
410
   function Split_GPG_Colons (AS : String) return UBS_Array is
 
411
      CC : Natural;
 
412
      use Ada.Strings.Fixed;
 
413
   begin
 
414
      Debug("Split_GPG_Colons invoked with `"
 
415
        & AS
 
416
            & "'");
 
417
      -- Count the number of colons.
 
418
      CC := Count(AS, ":");
 
419
      declare
 
420
         RA   : UBS_Array(0..CC);
 
421
         L, R : Natural;
 
422
      begin
 
423
         L := AS'First;
 
424
         for I in 0 .. CC loop
 
425
            -- Find the next right point.
 
426
            -- If we're working on the last entry, we don't find a colon.
 
427
            if I = CC then
 
428
               R := AS'Last;
 
429
            else
 
430
               R := Index(AS(L..AS'Last), ":") - 1;
 
431
            end if;
 
432
            -- Copy the entry...
 
433
            RA(I) := ToUBS(AS(L..R));
 
434
            -- Update L.
 
435
            L := R + 2;
 
436
         end loop;
 
437
         return RA;
 
438
      end;
 
439
   exception
 
440
      when others =>
 
441
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
 
442
           "Exception raised in Misc.Split_GPG_Colons");
 
443
         raise;
 
444
   end Split_GPG_Colons;
 
445
 
367
446
   -- Get the basename of a filename.
368
447
   function Basename (S : String) return String is
369
448
      -- Index of last (if any) `/'.
391
470
         raise;
392
471
   end Command_Basename;
393
472
 
 
473
   -- Turn hexadecimal string into value.
 
474
   function Hex_Decode (S : in String) return Natural is
 
475
      V : Natural := 0;
 
476
   begin
 
477
      for I in S'Range loop
 
478
         V := V * 16;
 
479
         if S(I) in '0'..'9' then
 
480
            V := V + Character'Pos(S(I)) - Character'Pos('0');
 
481
         elsif S(I) in 'A' .. 'F' then
 
482
            V := V + Character'Pos(S(I)) - Character'Pos('A') + 10;
 
483
         elsif S(I) in 'a' .. 'f' then
 
484
            V := V + Character'Pos(S(I)) - Character'Pos('a') + 10;
 
485
         else
 
486
            raise Constraint_Error;
 
487
         end if;
 
488
      end loop;
 
489
      return V;
 
490
   exception
 
491
      when others =>
 
492
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
 
493
                              "Exception raised in Misc.Hex_Decode");
 
494
         raise;
 
495
   end Hex_Decode;
 
496
 
 
497
 
 
498
 
394
499
end Misc;