[ViewVC] Annotation of: cvs/deliantra/Deliantra/bin/cf-slotutil

#!/opt/bin/perl

use common::sense;

use Deliantra;
use IO::AIO;
use List::Util;

sub scan_files($$) {
   my ($path, $cb) = @_;

   aio_scandir $path, 3, sub {
      my ($dirs, $nondirs) = @_;

      scan_files("$path/$_", $cb) for @$dirs;

      for my $file (@$nondirs) {
         next unless $file =~ /\.arc$/;

         my $data;
         aio_load "$path/$file", $data, sub {
            $cb->("$path/$file", read_arch \$data);
         };
      }
   };
}

sub for_all_arc($) {
   scan_files $ENV{DELIANTRA_ARCHDIR} || ".", $_[0];

   IO::AIO::flush;
}

sub extract {
   my (undef, $filter, @slots) = @ARGV;

   $filter =~ s/%(\w+)/\$_{$1}/g;
   $filter = eval "sub { $filter }"
      or die $@;

   my @res;

   unshift @slots, "_name";

   my @sort   = grep /^\d+$/, @slots;
   my @widths = map s/\=(\d+)$// && $1, grep !/^\d+$/, @slots;
   my @align  = map s/>$// ? "" : "-", @slots;
   my @big;

   local *_;
   for (sort keys %ARCH) {
      *_ = $ARCH{$_};
      next unless &$filter;
      push @res, [@_{@slots}];
   };

   @res = sort {
             "$a->[$_]$b->[$_]" =~ /^\d+$/
                ? $a->[$_] <=> $b->[$_]
                : $a->[$_] cmp $b->[$_]
          } @res
      for @sort;

   for my $row (@res) {
      for (0 .. $#$row) {
         $big[$_] =1 if $row->[$_] =~ /\n/;
      }
   }
   for my $i (0 .. $#widths) {
      $widths[$i] ||= List::Util::max map length $_->[$i], \@slots, @res;
   }

   for (0 .. $#big) {
      $widths[$_] = length $slots[$_] if $big[$_];
   }

   my $format = join " ", map "%$align[$_]$widths[$_]s", 0..$#widths;

   printf "$format\n", map "A$_", map $_ + 1, @widths;
   printf "$format\n", @slots;
   for my $row (@res) {
      print "\n" if @big;

      printf "$format\n", map $big[$_] ? "\x{fffc}" : $row->[$_], 0 .. $#$row;

      for (grep $big[$_], 0 .. $#big) {
         print "$row->[$_]%%\n";
      }
   }
}

sub insert {
   my ($apply) = @_;

   shift @ARGV;
   my $format = <STDIN>;
   my @slots = unpack $format, <STDIN>;
   s/^\s+// for @slots;
   
   my %res;

   while (<STDIN>) {
      next unless /\S/;

      my @row = unpack $format, $_;
      s/^\s+// for @row;

      for (0 .. $#row) {
         next unless $row[$_] eq "\x{fffc}";

         local $/ = "%%\n";
         chomp ($row[$_] = <STDIN>);
      }

      $res{$row[0]} = \@row;
   }

   for_all_arc sub {
      my ($path, $arch) = @_;

      my $chg;

      for (keys %$arch) {
         my $data = $res{$_}
            or next;

         my $arch = $arch->{$_};

         for (0 .. $#$data) {
            next if $data->[$_] eq $arch->{$slots[$_]};
            $chg = 1;
            $arch->{$slots[$_]} = $data->[$_];
         }
      }

      if ($chg) {
         open my $fh, ">:raw:utf8", "$path~"
           or die "$path~: $!";
         print $fh Deliantra::archlist_to_string [
            map $arch->{$_},
               sort keys %$arch
         ];
         close $fh;

         if ($apply) {
            rename "$path~", $path;
         } else {
            system "diff", "-u", $path, "$path~";
            unlink "$path~";
         }
      }
   };
}

binmode STDIN, ":utf8";
binmode STDOUT, ":utf8";

if ($ARGV[0] eq "extract") {
   Deliantra::load_archetypes;
   extract;
} elsif ($ARGV[0] eq "diff") {
   Deliantra::load_archetypes;
   insert 0;
} elsif ($ARGV[0] eq "patch") {
   Deliantra::load_archetypes;
   insert 1;
} else {
   die <<EOF;
Usage:

    $0 extract 'filter' slot...

        extract slots from server archetypes file (NOT the .arc files!)
        Example: $0 extract '%type == 101' level

    $0 diff

        generates a diff against the .arc files found
        in \$DELIANTRA_ARCHDIR or ".".

        Example: $0 diff <file

    $0 patch

        like diff, but applies it in-place

EOF
}


Revision:	1.5
Committed:	Sat May 15 00:22:26 2010 UTC (14 years ago) by root
Branch:	MAIN
CVS Tags:	rel-2_01, rel-2_0, HEAD
Changes since 1.4:	+1 -2 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#!/opt/bin/perl
2
3	root	1.5	use common::sense;
4	root	1.1
5			use Deliantra;
6			use IO::AIO;
7			use List::Util;
8
9			sub scan_files($$) {
10			my ($path, $cb) = @_;
11
12			aio_scandir $path, 3, sub {
13			my ($dirs, $nondirs) = @_;
14
15			scan_files("$path/$_", $cb) for @$dirs;
16
17			for my $file (@$nondirs) {
18			next unless $file =~ /\.arc$/;
19
20			my $data;
21			aio_load "$path/$file", $data, sub {
22			$cb->("$path/$file", read_arch \$data);
23			};
24			}
25			};
26			}
27
28			sub for_all_arc($) {
29			scan_files $ENV{DELIANTRA_ARCHDIR} \|\| ".", $_[0];
30
31			IO::AIO::flush;
32			}
33
34			sub extract {
35			my (undef, $filter, @slots) = @ARGV;
36
37			$filter =~ s/%(\w+)/\$_{$1}/g;
38			$filter = eval "sub { $filter }"
39			or die $@;
40
41			my @res;
42
43			unshift @slots, "_name";
44
45	root	1.3	my @sort = grep /^\d+$/, @slots;
46			my @widths = map s/\=(\d+)$// && $1, grep !/^\d+$/, @slots;
47			my @align = map s/>$// ? "" : "-", @slots;
48	root	1.1	my @big;
49
50			local *_;
51			for (sort keys %ARCH) {
52			*_ = $ARCH{$_};
53			next unless &$filter;
54			push @res, [@_{@slots}];
55			};
56
57	root	1.3	@res = sort {
58			"$a->[$_]$b->[$_]" =~ /^\d+$/
59			? $a->[$_] <=> $b->[$_]
60			: $a->[$_] cmp $b->[$_]
61			} @res
62			for @sort;
63
64	root	1.1	for my $row (@res) {
65			for (0 .. $#$row) {
66			$big[$_] =1 if $row->[$_] =~ /\n/;
67			}
68			}
69			for my $i (0 .. $#widths) {
70			$widths[$i] \|\|= List::Util::max map length $_->[$i], \@slots, @res;
71			}
72
73			for (0 .. $#big) {
74			$widths[$_] = length $slots[$_] if $big[$_];
75			}
76
77	root	1.3	my $format = join " ", map "%$align[$_]$widths[$_]s", 0..$#widths;
78
79	root	1.1	printf "$format\n", map "A$_", map $_ + 1, @widths;
80			printf "$format\n", @slots;
81			for my $row (@res) {
82			print "\n" if @big;
83
84			printf "$format\n", map $big[$_] ? "\x{fffc}" : $row->[$_], 0 .. $#$row;
85
86			for (grep $big[$_], 0 .. $#big) {
87			print "$row->[$_]%%\n";
88			}
89			}
90			}
91
92			sub insert {
93	root	1.2	my ($apply) = @_;
94
95	root	1.1	shift @ARGV;
96			my $format = <STDIN>;
97			my @slots = unpack $format, <STDIN>;
98	root	1.4	s/^\s+// for @slots;
99	root	1.1
100			my %res;
101
102			while (<STDIN>) {
103			next unless /\S/;
104
105			my @row = unpack $format, $_;
106	root	1.4	s/^\s+// for @row;
107	root	1.1
108			for (0 .. $#row) {
109			next unless $row[$_] eq "\x{fffc}";
110
111			local $/ = "%%\n";
112			chomp ($row[$_] = <STDIN>);
113			}
114
115			$res{$row[0]} = \@row;
116			}
117
118			for_all_arc sub {
119			my ($path, $arch) = @_;
120
121			my $chg;
122
123			for (keys %$arch) {
124			my $data = $res{$_}
125			or next;
126
127			my $arch = $arch->{$_};
128
129			for (0 .. $#$data) {
130			next if $data->[$_] eq $arch->{$slots[$_]};
131			$chg = 1;
132			$arch->{$slots[$_]} = $data->[$_];
133			}
134			}
135
136			if ($chg) {
137			open my $fh, ">:raw:utf8", "$path~"
138			or die "$path~: $!";
139			print $fh Deliantra::archlist_to_string [
140			map $arch->{$_},
141			sort keys %$arch
142			];
143			close $fh;
144	root	1.2
145			if ($apply) {
146			rename "$path~", $path;
147			} else {
148			system "diff", "-u", $path, "$path~";
149			unlink "$path~";
150			}
151	root	1.1	}
152			};
153			}
154
155			binmode STDIN, ":utf8";
156			binmode STDOUT, ":utf8";
157
158			if ($ARGV[0] eq "extract") {
159	root	1.4	Deliantra::load_archetypes;
160	root	1.1	extract;
161			} elsif ($ARGV[0] eq "diff") {
162	root	1.4	Deliantra::load_archetypes;
163	root	1.2	insert 0;
164	root	1.4	} elsif ($ARGV[0] eq "patch") {
165			Deliantra::load_archetypes;
166	root	1.2	insert 1;
167	root	1.1	} else {
168			die <<EOF;
169			Usage:
170
171			$0 extract 'filter' slot...
172
173			extract slots from server archetypes file (NOT the .arc files!)
174			Example: $0 extract '%type == 101' level
175
176	root	1.2	$0 diff
177	root	1.1
178			generates a diff against the .arc files found
179			in \$DELIANTRA_ARCHDIR or ".".
180
181			Example: $0 diff <file
182
183	root	1.4	$0 patch
184	root	1.2
185			like diff, but applies it in-place
186
187	root	1.1	EOF
188			}
189
190
191