ppcrcd/conf.dir/usr: bin bin/xmltar.pl bin/xmluntar.pl lib/ppcrcd/xmltar.pl lib/ppcrcd/xmluntar.pl
sparky
cvs at pld-linux.org
Thu Jan 5 21:07:01 CET 2006
Author: sparky
Date: Thu Jan 5 21:06:56 2006
New Revision: 6740
Added:
ppcrcd/conf.dir/usr/bin/
ppcrcd/conf.dir/usr/bin/xmltar.pl (contents, props changed)
ppcrcd/conf.dir/usr/bin/xmluntar.pl (contents, props changed)
ppcrcd/conf.dir/usr/lib/ppcrcd/xmltar.pl (contents, props changed)
ppcrcd/conf.dir/usr/lib/ppcrcd/xmluntar.pl (contents, props changed)
Log:
- my utility for packaging text files in one xml file (configuration can
be easyly edited without unpacking files)
Added: ppcrcd/conf.dir/usr/bin/xmltar.pl
==============================================================================
--- (empty file)
+++ ppcrcd/conf.dir/usr/bin/xmltar.pl Thu Jan 5 21:06:56 2006
@@ -0,0 +1 @@
+link ../lib/ppcrcd/xmltar.pl
\ No newline at end of file
Added: ppcrcd/conf.dir/usr/bin/xmluntar.pl
==============================================================================
--- (empty file)
+++ ppcrcd/conf.dir/usr/bin/xmluntar.pl Thu Jan 5 21:06:56 2006
@@ -0,0 +1 @@
+link ../lib/ppcrcd/xmluntar.pl
\ No newline at end of file
Added: ppcrcd/conf.dir/usr/lib/ppcrcd/xmltar.pl
==============================================================================
--- (empty file)
+++ ppcrcd/conf.dir/usr/lib/ppcrcd/xmltar.pl Thu Jan 5 21:06:56 2006
@@ -0,0 +1,221 @@
+#!/usr/bin/perl
+# $Id$
+#
+use strict;
+#use warnings;
+
+sub help {
+print <<EOF;
+xmltar.pl - script for storing multiple files in one xml archive.
+Specially useful for storing text like documentation and configuration files.
+As everything is text it is possible to edit stored files without extracting
+them. Special vim folds help a lot when storing many files.
+One xmltar file cannot be stored into annother.
+
+Options:
+-v, -nv - enable/disable verbose output (default: disabled)
+-c, -nc - enable/disable comments and vim folds (default: enabled)
+-p - stay in place, archive files respecting to current \$PWD
+-r - if specified file don't exists mark it ar removed
+-s <str> - use <str> as tab in archive
+-- - end of options, everything after is a file
+
+If no file is specified it will read file list from standart input,
+one per line.
+
+EOF
+exit 0;
+}
+
+my $verbose = 0;
+my $comment = 1;
+my $stayinplace = 0;
+my $removed = 0;
+my $stepadd = " ";
+
+my @filelist;
+while ( defined $ARGV[0] ) {
+ my $arg = shift @ARGV;
+ # I would use switch but it's in perl-modules
+ help() if $arg =~ /^-(-?help|h)$/;
+ $verbose = 1 if $arg eq "-v";
+ $verbose = 0 if $arg eq "-nv";
+ $comment = 1 if $arg eq "-c";
+ $comment = 0 if $arg eq "-nc";
+ $stayinplace = 1 if $arg eq "-p";
+ if ($arg eq "-r") { $stayinplace = 1; $removed = 1; }
+ $stepadd = shift @ARGV if $arg eq "-s";
+ if ($arg eq "--") {
+ push(@filelist, shift @ARGV) while ( $ARGV[0] );
+ last;
+ }
+ next if $arg =~ /^-(v|nv|c|nc|p|r|s)$/;
+ push @filelist, $arg;
+}
+
+
+my %multilink;
+
+sub lastname {
+ $_ = $_[0];
+ s|.*/||;
+ s/&/&/g;
+ s/"/"/g;
+ return $_;
+}
+
+sub packfile {
+ my ($file, $step, $localdir, $level) = @_;
+
+ my ( $links, $inode) = (stat "$file")[3, 1];
+ if ( $links > 1 ) {
+ if ( $multilink{$inode} ) {
+ warn "L $file\n" if $verbose;
+ print $step."<!--L $localdir".lastname($file)." {{{$level -->\n" if $comment;
+ print $step.'<xmltar:hardlink name="'.lastname($file).'">';
+ print $multilink{$inode};
+ print "</xmltar:hardlink>\n";
+ return;
+ }
+ $multilink{$inode}=$localdir.lastname($file);
+ }
+ warn "F $file\n" if $verbose;
+
+ unless ( open F_IN, $file ) {
+ warn "Can't read file \"$file\": $!\n";
+ return;
+ }
+ print $step."<!--F $localdir".lastname($file)." {{{$level -->\n" if $comment;
+ print $step.'<xmltar:file mode="';
+ printf "%04o", ((stat $file)[2]) & 07777;
+ print '" name="'.lastname($file)."\">\n";
+ while ( <F_IN> ) {
+ print $_;
+ }
+ print "</xmltar:file>\n";
+}
+
+sub packlink {
+ my ($link, $step, $localdir, $level) = @_;
+ warn "S $link\n" if $verbose;
+
+ print $step."<!--S $localdir".lastname($link)." {{{$level -->\n" if $comment;
+ print $step.'<xmltar:symlink name="'.lastname($link).'">';
+ print readlink $link;
+ print "</xmltar:symlink>\n";
+}
+
+sub packdir {
+ my ($dir, $step, $localdir, $level) = @_;
+ warn "D $dir\n" if $verbose;
+ $localdir .= lastname($dir) . "/";
+
+ print $step."<!--D $localdir {{{$level -->\n" if $comment;
+ $level++;
+ print $step . '<xmltar:dir mode="';
+ printf "%04o", ((stat $dir)[2]) & 07777;
+ print '" name="'.lastname($dir)."\">\n";
+ opendir DIR, $dir or warn "Can't open dir '$dir': $!\n";
+ foreach my $file ( sort readdir DIR ) {
+ next if $file =~ /^\.{1,2}$/;
+ $file = $dir ."/". $file;
+ if (-d $file) {
+ packdir($file, $step.$stepadd, $localdir, $level);
+ next;
+ }
+ if (-l $file) {
+ packlink($file, $step.$stepadd, $localdir, $level);
+ next;
+ }
+ if (-f $file) {
+ packfile($file, $step.$stepadd, $localdir, $level);
+ next;
+ }
+ warn "Unknown type or no file: $file\n";
+ }
+ closedir DIR;
+ print $step . "</xmltar:dir>\n";
+}
+
+unless ( @filelist ) {
+ warn "specify files, one per line\n";
+ while ( <> ) {
+ chomp;
+ push @filelist, $_;
+ }
+}
+
+unless ( $stayinplace ) {
+ foreach my $file (@filelist) {
+ if (-d $file) {
+ $file =~ s/\/$//;
+ packdir($file, "", "", 1);
+ next;
+ }
+ if (-l $file) {
+ packlink($file, "", "", 1);
+ next;
+ }
+ if (-f $file) {
+ packfile($file, "", "", 1);
+ next;
+ }
+ warn "Unknown type or no file: $file\n";
+ }
+} else {
+ my $dir="";
+ my $level=1;
+ my $step="";
+ foreach my $file (sort @filelist) {
+ die "only local files, $file\n" if $file =~ /^\// or $file =~ /\.\./;
+ $file =~ s/\/$//;
+ $file = $file;
+ while ( $file !~ /^$dir/ ) {
+ $dir =~ s/[^\/]*\/$//;
+ $step =~ s/$stepadd$//;
+ $level--;
+ print $step . "</xmltar:dir>\n";
+ }
+ ( my $filename = $file ) =~ s/^$dir//;
+ while ( $filename =~ s/^(.*?)\/// ) {
+ $dir .= $1."/";
+ print $step."<!--D $dir {{{$level -->\n" if $comment;
+ print $step . '<xmltar:dir name="'.lastname($1)."\">\n";
+ $level++;
+ $step .= $stepadd;
+ }
+ if (-d $file) {
+ packdir($file, $step, $dir, $level);
+ next;
+ }
+ if (-l $file) {
+ packlink($file, $step, $dir, $level);
+ next;
+ }
+ if (-f $file) {
+ packfile($file, $step, $dir, $level);
+ next;
+ }
+ if ( $removed ) {
+ unless (-e $file) {
+ print $step."<!--R $dir".lastname($file)." {{{$level -->\n" if $comment;
+ print $step.'<xmltar:removed name="'.lastname($file)."\" />\n";
+ next;
+ }
+ }
+ warn "Unknown type or no file: $file\n";
+ }
+
+ while ( $dir ) {
+ $dir =~ s/[^\/]*\/$//;
+ $step =~ s/$stepadd$//;
+ $level--;
+ print $step . "</xmltar:dir>\n";
+ }
+
+}
+
+# prevent vim from detecting this
+print "\n<!-- v"."im: set syntax=xml";
+print " fdm=marker" if $comment;
+print ": -->\n";
Added: ppcrcd/conf.dir/usr/lib/ppcrcd/xmluntar.pl
==============================================================================
--- (empty file)
+++ ppcrcd/conf.dir/usr/lib/ppcrcd/xmluntar.pl Thu Jan 5 21:06:56 2006
@@ -0,0 +1,155 @@
+#!/usr/bin/perl
+# $Id$
+#
+use strict;
+#use warnings;
+use File::Path;
+
+my $verbose = 0;
+my $comment = 0;
+
+my @filelist;
+while ( $ARGV[0] ) {
+ my $arg = shift @ARGV;
+ $verbose = 1 if $arg eq "-v";
+ $comment = 1 if $arg eq "-c";
+ next if $arg =~ /^-[vc]$/;
+ push @filelist, $arg;
+}
+
+ at ARGV = @filelist;
+
+sub convname {
+ $_ = $_[0];
+ s/"/"/g;
+ s/&/&/g;
+ s/</</g;
+ s/>/>/g;
+ return $_;
+}
+
+my $leftmany = 0;
+my $dir = "./";
+my $L;
+
+while ( $L = <> ) {
+ chomp $L;
+ $L =~ s/^\s*//;
+ next unless $L;
+ if ( $L =~ s/^<xmltar:hardlink\s+(.*?)>(.*?)<\/xmltar:hardlink>// ) {
+ my $to = $2;
+ my %opts = ( map { /([a-z]+)="(.*?)"/g } $1 );
+ unless ( $opts{"name"} ) {
+ warn "hardlink has no name!\n";
+ redo;
+ }
+ my $new = $dir.convname($opts{"name"});
+ rmtree($new);
+ warn "L $new\n" if $verbose;
+ link $to, $new or
+ warn "Can't create hardlink '$new' -> '$to': $!\n";
+ chmod oct($opts{"mode"}), $to if $opts{"mode"};
+ redo;
+ }
+ if ( $L =~ s/^<xmltar:symlink\s+(.*?)>(.*?)<\/xmltar:symlink>// ) {
+ my $to = $2;
+ my %opts = ( map { /([a-z]+)="(.*?)"/g } $1 );
+ unless ( $opts{"name"} ) {
+ warn "symlink has no name!\n";
+ redo;
+ }
+ my $new = $dir.convname($opts{"name"});
+ rmtree($new);
+ warn "S $new\n" if $verbose;
+ symlink $to, $new or
+ warn "Can't create symlink '$new' -> '$to': $!\n";
+ redo;
+ }
+ if ( $L =~ s/^<xmltar:dir\s+(.*?)>// ) {
+ my %opts = ( map { /([a-z]+)="(.*?)"/g } $1 );
+ unless ( $opts{"name"} ) {
+ warn "dir has no name!\n";
+ redo;
+ }
+ $dir .= convname($opts{"name"})."/";
+ warn "D $dir\n" if $verbose;
+ unless ( -d $dir ) {
+ rmtree($dir);
+ mkdir $dir or die "Error creating dir $dir; $!\n";
+ }
+ chmod oct($opts{"mode"}), $dir if $opts{"mode"};
+ redo;
+ }
+ if ( $L =~ s/^<\/xmltar:dir>// ) {
+ $dir =~ s|[^/]*/$|| or warn "Error undir!!!$!\n";
+ redo;
+ }
+ if ( $L =~ s/^<xmltar:file\s+(.*?)>// ) {
+ my %opts = ( map { /([a-z]+)="(.*?)"/g } $1 );
+ unless ( $opts{"name"} ) {
+ warn "file has no name!\n";
+ redo;
+ }
+ my $file = $dir.convname($opts{"name"});
+ rmtree($file);
+ warn "F $file\n" if $verbose;
+ open F_OUT, "> $file" or die "Can't create file $file: $!\n";
+ if ( $L ) {
+ warn "Warning: file '$file' should start in next line\n";
+ if ( $L =~ s/^(.*?)<\/xmltar:file>// ) {
+ # onle line file
+ print F_OUT $1;
+ close F_OUT;
+ chmod oct($opts{"mode"}), $file if $opts{"mode"};
+ redo;
+ } else {
+ print F_OUT $L;
+ }
+ }
+ while ( my $Fline = <> ) {
+ if ( $Fline =~ s/^(.*?)<\/xmltar:file>// ) {
+ print F_OUT $1;
+ chomp $Fline;
+ $L = $Fline;
+ last;
+ }
+ print F_OUT $Fline;
+ }
+ close F_OUT;
+ chmod oct($opts{"mode"}), $file if $opts{"mode"};
+ redo;
+ }
+ if ( $L =~ s/^<xmltar:removed\s+(.*?)\/>// ) {
+ my %opts = ( map { /([a-z]+)="(.*?)"/g } $1 );
+ unless ( $opts{"name"} ) {
+ warn "removed has no name!\n";
+ redo;
+ }
+ my $torm = $dir.convname($opts{"name"});
+ warn "R $torm\n" if $verbose;
+ rmtree($torm);
+ redo;
+ }
+ if ( $L =~ s/^<!--(.*?)-->// ) {
+ print "Comment: $1\n" if $comment;
+ redo;
+ }
+ if ( $L =~ s/^<!--(.*)$// ) {
+ my $buf = $1;
+ while ( my $Fline = <> ) {
+ if ( $Fline =~ s/^(.*?)-->// ) {
+ $buf .= $1;
+ $L = $Fline;
+ last;
+ }
+ $buf .= $Fline;
+ }
+ print "Comment: $buf\n" if $comment;
+ redo;
+ }
+ warn "Error: left '$L'\n" if $leftmany < 8;
+ warn "Error: more left...\n" if $leftmany == 8;
+ $leftmany++;
+}
+
+warn "Left in total $leftmany lines!\n" if $leftmany;
More information about the pld-cvs-commit
mailing list