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