1
2(********************************************************************)
3(*                                                                  *)
4(*  tar7.sd7      Tar archiving utility                             *)
5(*  Copyright (C) 1994, 2004, 2005, 2010, 2012  Thomas Mertes       *)
6(*  Copyright (C) 2013, 2019  Thomas Mertes                         *)
7(*                                                                  *)
8(*  This program is free software; you can redistribute it and/or   *)
9(*  modify it under the terms of the GNU General Public License as  *)
10(*  published by the Free Software Foundation; either version 2 of  *)
11(*  the License, or (at your option) any later version.             *)
12(*                                                                  *)
13(*  This program is distributed in the hope that it will be useful, *)
14(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
15(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
16(*  GNU General Public License for more details.                    *)
17(*                                                                  *)
18(*  You should have received a copy of the GNU General Public       *)
19(*  License along with this program; if not, write to the           *)
20(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
21(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
22(*                                                                  *)
23(********************************************************************)
24
25
26$ include "seed7_05.s7i";
27  include "tar_cmds.s7i";
28  include "console.s7i";
29
30
31const proc: main is func
32  local
33    var string: option is "";
34    var char: command is ' ';
35    var string: file_name is "";
36    var boolean: do_view is FALSE;
37    var boolean: do_zip_unzip is FALSE;
38    var boolean: file_arg is FALSE;
39    var array string: arg_list is 0 times "";
40    var integer: index is 0;
41  begin
42    OUT := STD_CONSOLE;
43    if length(argv(PROGRAM)) >= 1 then
44      option := argv(PROGRAM)[1];
45      if option[1] = '-' then
46        option := option [2 .. ];
47      end if;
48      if option <> "" then
49        command := option[1];
50      end if;
51      if command in {'t', 'x', 'c'} then
52        option := option [2 .. ];
53        while option <> "" do
54          if option[1] = 'v' then
55            do_view := TRUE;
56          end if;
57          if option[1] = 'z' then
58            do_zip_unzip := TRUE;
59          end if;
60          if option[1] = 'f' then
61            file_arg := TRUE;
62          end if;
63          option := option [2 .. ];
64        end while;
65        if file_arg then
66          if length(argv(PROGRAM)) >= 2 then
67            file_name := convDosPath(argv(PROGRAM)[2]);
68            arg_list := argv(PROGRAM)[3 .. ];
69          else
70            writeln("tar7: The option 'f' needs a file name.");
71            command := ' ';
72          end if;
73        else
74          writeln("tar7: The option 'f' is missing.");
75          command := ' ';
76          # file_name := "/dev/flp";
77          # arg_list := argv(PROGRAM)[2 .. ];
78        end if;
79        for key index range arg_list do
80          arg_list[index] := convDosPath(arg_list[index]);
81        end for;
82        case command of
83          when {'t'}:
84            tarTell(file_name, arg_list, do_view, do_zip_unzip);
85          when {'x'}:
86            tarXtract(file_name, arg_list, do_view, do_zip_unzip);
87          when {'c'}:
88            tarCreate(file_name, arg_list, do_view, do_zip_unzip);
89        end case;
90      else
91        write("tar7: Illegal option '");
92        write(command);
93        writeln("'. Legal options are 't', 'x' or 'c'.");
94      end if;
95    else
96      writeln("Tar7 Version 1.0 - Tar archiving utility");
97      writeln("Copyright (C) 1994, 2004, 2005, 2010 Thomas Mertes");
98      writeln("This is free software; see the source for copying conditions.  There is NO");
99      writeln("warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.");
100      writeln("Tar7 is written in the Seed7 programming language");
101      writeln("Homepage: http://seed7.sourceforge.net");
102      writeln;
103      writeln("usage: tar7 command[options] argument");
104      writeln;
105      writeln("Commands (one of the commands -c, -t or -x must be specified):");
106      writeln("  -t   Tell about the contents of an archive");
107      writeln("  -x   Extract files from an archive");
108      writeln("  -c   Create a new archive");
109      writeln("The commands can be altered with the following modifiers:");
110      writeln("   v   Verbosely list files processed");
111      writeln("   z   Zip an archve with gzip or decompress a gzip, xz, zstd or lzma archive");
112      writeln("   f   Use archive file provided as argument");
113      writeln;
114      writeln("Example of a tar7 usage:");
115      writeln("  ./s7 tar7 -tvzf ../../seed7_05_20100221.tgz");
116      writeln;
117    end if;
118  end func;
119