root/trunk/midgard/tools/yamp/remove_unapproved_withsg.pl

Revision 7286, 13.4 kB (checked in by rambo, 4 years ago)

hopefully fixed the "possible precedence problem"s

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
Line 
1 #!/usr/bin/perl -w
2
3 #-----------------------------------------------------------------------------------------------------------
4 #       File: remove_unapproved_withsg.pl
5 #
6 #          Parser for xml files exported by repligard. 
7 #          Removes unapproved (or changed after approve) entries
8 #
9 #          Sitegroups enabled version
10 #
11 #       By: "Eero 'Rambo' af Heurlin" <rambo@nemein.com>
12 #
13 #-----------------------------------------------------------------------------------------------------------
14
15 use strict;
16 use utf8;
17 use XML::Parser::Expat;
18 use Time::Local;
19 use Getopt::Std;
20
21 # Get the file name from the command line
22 my %Opts;
23 getopt('', \%Opts);
24 # foreach my $kkk (keys %Opts) {
25 #         print "DEBUG: option $kkk=".$Opts{$kkk}."\n";
26 # }
27
28 my $skip_pages=$Opts{p};
29 my $skip_articles=$Opts{a};
30 my $skip_snippetdirs=$Opts{d};
31 my $skip_styles=$Opts{s};
32 my $check_sg0=$Opts{r};
33
34
35 my $file = $ARGV[0] || die( &usage );
36
37 # Some bit buckets
38 my $current_id = "";
39 my $cur_content = "";
40 my $obj_content = "";
41 my $current_obj_type = "";
42 my %current_obj_data;
43 my $start = "";
44 my $end = "";
45 my $cnt = 0;
46 my $dom = "";
47 my $nam = "";
48 my $val = "";
49
50 # Some arrays (or actually hashes on perl language) for data jugling
51 my %base_objects; # Keys are GUIDs, values are second level hashes matching midgard object structure
52 my %parameters;   # -- '' --
53 my %blobs;        # -- '' --
54 my %xml_data;     # Keys are GUIDs, values are the actual XML data (including the start and end tags, which include the GUID again
55 my %parametermap; # Keys are GUIDs (for matching to the %base_objects) values are second level arrays that have as value the GUID of the parameter
56 my %blobmap;      # -- '' -- (naturally for blob)
57
58 # Define which objects are children to "base objects"
59 my %child_object_names;
60 $child_object_names{"BLOBS"}=1;
61 $child_object_names{"RECORD_EXTENSION"}=1;
62
63
64 my $parser = new XML::Parser::Expat;
65
66 # Set up the handlers for the parser
67 $parser->setHandlers( 'Start'         => \&start_handler,
68                         'End'           => \&end_handler,
69                         'Default'       => \&default_handler);
70
71 open(FILE, $file) || die "Couldn't open file $!\n";
72
73 $parser->parse(*FILE);
74
75 close(FILE);
76
77 my $guid="";
78 # Walk the base objects hash and call check subroutines which determine whether to keep a certain element or not
79 foreach $guid (keys %base_objects) {
80         %current_obj_data=();
81         foreach my $k (keys %{$base_objects{$guid}}) {
82                 $current_obj_data{$k}=$base_objects{$guid}{$k};
83         }
84    
85 #        print "DEBUG: object type: ".$current_obj_data{"__TABLE__"}.", deleted: ".$current_obj_data{"__DELETED__"}."\n";
86     
87         if (!$current_obj_data{"__DELETED__"}) {
88            if (clean_tag_simple($current_obj_data{"sitegroup"}) or $check_sg0) { # Do not clean SG0 objects by default
89               my $type=uc($current_obj_data{"__TABLE__"});
90               if ($type eq "ARTICLE") {
91                  check_article($guid, %current_obj_data); 
92               }
93               elsif ($type eq "PAGE") {
94                  check_page($guid, %current_obj_data);
95               }
96               elsif ($type eq "STYLE") {
97                  check_style($guid, %current_obj_data);
98               }
99               elsif ($type eq "SNIPPETDIR") {
100                  check_snippetdir($guid, %current_obj_data);
101               }
102            }
103         }
104    
105 }
106
107
108
109 open (OUTFILE, ">$file.cleaned") || die "Couldn't open $file.cleaned $!\n";
110 print OUTFILE "$start\n";
111 for my $k (keys %xml_data) {
112     print OUTFILE $xml_data{$k};
113 }
114 print OUTFILE "\n$end";
115 print OUTFILE "\n";
116
117
118 close OUTFILE;
119
120  unlink $file || die "could not delete $file : $!";
121  rename ("$file.cleaned", "$file") or die "could not rename $file.cleaned : $!";
122
123 #-----------------------------------------------------------------------------------------------------------
124 #       Sub routines
125 #-----------------------------------------------------------------------------------------------------------
126
127 sub check_article {
128     if ($skip_articles) { return 1; }
129     my ($l_guid, %current_obj_data) = @_;
130 #    print "DEBUG: check_article l_guid: $l_guid\n";
131     my $astamp=repligard_string_to_time(clean_tag_simple($current_obj_data{"approved"}));
132     my $rstamp=repligard_string_to_time(clean_tag_simple($current_obj_data{"revised"}));
133 #    print "DEBUG: astamp=$astamp, rstamp=$rstamp\n";
134     # Simple revised > approved check
135     if ($rstamp > $astamp) { remove_obj($l_guid); }
136     # Timed checks
137     $dom="";
138     $nam="";
139     $val="";
140     my @paramdata=(0,0,0,0);
141     foreach my $kk (values %{$parametermap{$l_guid}}) {
142             $dom=clean_tag_cdata($parameters{$kk}{"domain"});
143             if ($dom eq "approve_time") {
144                $nam=clean_tag_cdata($parameters{$kk}{"name"});
145                $val=clean_tag_cdata($parameters{$kk}{"value"});
146 #              print "DEBUG: dom=$dom, name=$nam, val=$val\n";
147                if ($nam eq "endhours") {
148                   $paramdata[0]=$val;
149                } elsif ($nam eq "endminutes") {
150                   $paramdata[1]=$val;
151                } elsif ($nam eq "starthours") {
152                   $paramdata[2]=$val;
153                } elsif ($nam eq "startminutes") {
154                   $paramdata[3]=$val;
155                }
156             }
157     }
158     my $atstart_str=clean_tag_simple($current_obj_data{"calstart"})." ".sprintf("%02d", $paramdata[2]).":".sprintf("%02d", $paramdata[3]).":00";
159     my $atstart=repligard_string_to_time($atstart_str);
160     my $atend_str=clean_tag_simple($current_obj_data{"calstart"})." ".sprintf("%02d", $paramdata[0]).":".sprintf("%02d", $paramdata[1]).":00";
161     my $atend=repligard_string_to_time($atend_str)+(24*3600*clean_tag_simple($current_obj_data{"caldays"}));
162 #    print "DEBUG: atstart=$atstart atend=$atend \n";
163     if ($atstart) { # Check if we have reached timed approve start time
164        if (time() < $atstart) { remove_obj($l_guid); }
165     }
166     if ($atend > $atstart) { # Check if there is end time set to approval and if we have reached it
167        if (time() > $atend) { remove_obj($l_guid); }
168     }
169 }
170
171 sub check_page {
172     if ($skip_pages) { return 1; }
173     my ($l_guid, %current_obj_data) = @_;
174     check_generic($l_guid, %current_obj_data);
175 }   
176
177 sub check_style {
178     if ($skip_styles) { return 1; }
179     my ($l_guid, %current_obj_data) = @_;
180     check_generic($l_guid, %current_obj_data);
181 }   
182
183 sub check_snippetdir {
184     if ($skip_snippetdirs) { return 1; }
185     my ($l_guid, %current_obj_data) = @_;
186     check_generic($l_guid, %current_obj_data);
187 }   
188
189
190 sub check_generic {
191     my ($l_guid, %current_obj_data) = @_;
192     my @paramdata=(0,0);
193     foreach my $kk (values %{$parametermap{$l_guid}}) {
194             $dom=clean_tag_cdata($parameters{$kk}{"domain"});
195             if ($dom eq "approval") {
196                $nam=clean_tag_cdata($parameters{$kk}{"name"});
197                $val=clean_tag_cdata($parameters{$kk}{"value"});
198 #              print "DEBUG: dom=$dom, name=$nam, val=$val\n";
199                if ($nam eq "startdate") {
200                   $paramdata[0]=$val;
201                } elsif ($nam eq "status") {
202                   $paramdata[1]=$val;
203                }
204             }
205     }
206     my ($sdate, $status)=@paramdata;
207     if (($status eq "always") | ($status eq "now")) { return 1; }
208     if ((!$status) | ($status eq "not") | ($status eq "change")) {
209        remove_obj($l_guid);
210     }
211     if (($status eq "startdate") & (time() < $sdate)) {
212        remove_obj($l_guid);
213     }
214 }
215
216
217 sub repligard_string_to_time {
218     my ($str) = @_;
219     $_ = $str;
220     my ($year, $month, $day, $hour, $min, $sec) = /(\d{4,4})-?(\d{2,2})-?(\d{2,2})\s?(\d{2,2}):?(\d{2,2}):?(\d{2,2})/;
221 #    print "DEBUG: str=\"$str\" year=$year, month=$month, day=$day, hour=$hour, min=$min, sec=$sec\n";
222     if (($day>=1) & ($month>=1) & ($year>=1)) {
223        return timelocal($sec,$min,$hour,$day,$month-1,$year); # timelocal uses 0 based months...
224     } else {
225        return 0;
226     }
227 }
228
229 sub clean_tag_simple {
230     my ($str) = @_;
231 #    print "DEBUG: str=\"$str\"\n";
232     $_=$str;
233     my ($tag, $ret)=/<([^>]+)>([^<]+)<[^>]+>/;
234 #    print "DEBUG: tag=$tag, ret=$ret\n";
235     return $ret;
236 }
237
238 sub clean_tag_cdata {
239     my ($str) = @_;
240 #   print "DEBUG clean_tag_cdata: str=\"$str\"\n";
241     $_=$str;
242     my ($ret)=/<[^>]+>(.*)<[^>]+>/;
243 #   print "DEBUG clean_tag_cdata: phase 1 \"$ret\"\n";
244     $_=$ret;
245     ($ret)=/<!\[CDATA\[(.*)\]\]>/;
246 #   print "DEBUG clean_tag_cdata: phase 2 \"$ret\"\n";     
247     return $ret;
248 }
249
250
251 sub remove_obj {
252     my ($l_guid) = @_;
253     # Remove the object from XML data
254     delete ($xml_data{$l_guid});
255     # Remove object parameters
256     foreach my $kk (values %{$parametermap{$l_guid}}) {
257             delete ($xml_data{$kk});
258     }
259     # Remove object attachments
260     foreach my $kk (values %{$blobmap{$l_guid}}) {
261             delete ($xml_data{$kk});
262     }
263    
264     # Remove direct child objects like (page-)elements and snippets
265     if (uc($base_objects{$l_guid}{"__TABLE__"}) eq "PAGE") {
266         remove_children("PAGEELEMENT", "page", $l_guid);
267     } elsif (uc($base_objects{$l_guid}{"__TABLE__"}) eq "STYLE") {
268         remove_children("ELEMENT", "style", $l_guid);
269     } elsif (uc($base_objects{$l_guid}{"__TABLE__"}) eq "SNIPPETDIR") {
270         remove_children("SNIPPET", "up", $l_guid);
271     }
272    
273
274 }
275
276 sub remove_children {
277     my ($check_child_table, $check_child_link, $l_guid)=@_;
278     if ($check_child_table & $check_child_link) {       
279         foreach my $ll_guid (keys %base_objects) {
280                 my %ll_current_obj_data=();
281                 foreach my $kk (keys %{$base_objects{$ll_guid}}) {
282                         $ll_current_obj_data{$kk}=$base_objects{$ll_guid}{$kk};
283                 }
284                 if (!$ll_current_obj_data{"__DELETE__"} & ($ll_current_obj_data{"__TABLE__"} eq uc($check_child_table))) {
285                    if (clean_tag_simple($ll_current_obj_data{$check_child_link}) eq $l_guid) {
286                       remove_obj($ll_guid);
287                    }
288                 }
289         }
290     }   
291 }
292
293 sub start_handler {
294         my ($p, $element, %attributes) = @_;
295         my @context_list=$p->context();
296         my $d=$p->depth();
297         my $context="";
298         if ($d > 0) {
299            $context=uc($context_list[$d-1]);
300            if ($context eq "DATABASE") {
301               $current_obj_type=uc($element);
302               $current_obj_data{"__TABLE__"}=$element;
303               $current_obj_data{"id"}=$attributes{"id"};
304               $current_obj_data{"__DELETED__"}='';
305               if ($attributes{"deleted"}) {
306                  $current_obj_data{"__DELETED__"}=$attributes{"deleted"};
307               }
308               $current_id=$attributes{"id"};
309            }
310         }
311
312 #        print "DEBUG: start element: \"$element\" depth: $d context: \"$context\" current_obj_type: \"$current_obj_type\" \n";
313
314         if( uc( $element ) eq "DATABASE" ){
315                 $start = $cur_content.$p->recognized_string();
316 #               print "DEBUG-XML: \"$start\"\n";
317                 $cur_content="";
318         }
319         else {
320            
321                $cur_content .= $p->recognized_string();
322         }
323 }
324
325
326 sub end_handler {
327         my ($p, $element) = @_;
328         my @context_list=$p->context();
329         my $d=$p->depth();
330         my $context="";
331         if ($d > 0) {
332            $context=uc($context_list[$d-1]);
333         }
334
335 #        print "DEBUG: end element: \"$element\" depth: $d context: \"$context\" current_obj_type: \"$current_obj_type\" \n";
336
337
338         if( uc( $element ) eq "DATABASE" ){
339                 $end = $cur_content.$p->recognized_string();
340 #               print "DEBUG-XML: \"$end\"\n";
341                 $cur_content="";
342         }
343         else{
344            
345              $cur_content .= $p->recognized_string();
346
347              $obj_content .= $cur_content;
348              if (uc($element) eq $current_obj_type) { # End tag for object
349 #               print "DEBUG-XML: \"$obj_content\" \n";
350                 
351                 if (!$child_object_names{$current_obj_type}) {
352                    # %base_objects{$current_id}=%current_obj_data;
353                    for my $k (keys %current_obj_data) {
354                        $base_objects{$current_id}{$k}=$current_obj_data{$k};
355                        for ($base_objects{$current_id}{$k}) {
356                               s/^\s+//;
357                               s/\s+$//;
358                        } 
359                    }
360                 } else {
361                    if ($current_obj_type eq "RECORD_EXTENSION") {
362                       # %parameters{$current_id}=%current_obj_data;
363                       for my $k (keys %current_obj_data) {
364                           $parameters{$current_id}{$k}=$current_obj_data{$k};
365                           for ($parameters{$current_id}{$k}) {
366                               s/^\s+//;
367                               s/\s+$//;
368                           } 
369                       }
370                       if (!$current_obj_data{"__DELETED__"}) {
371                          $_=$current_obj_data{"oid"};
372                          my ($boguid)=/<oid>([^<]*)<\/oid>/;
373 #                        print "DEBUG: record_ext parent GUID: $boguid \n";
374                          # TODO: place current guid to parametermap
375                          $cnt=0;
376                          foreach my $k (keys %{$parametermap{$boguid}}) {
377                                  $cnt++;
378                          }
379 #                        print "DEBUG: count: $cnt \n";
380                          $parametermap{$boguid}{$cnt}=$current_id;
381                       }
382                    } else {
383                       # %blobs{$current_id}=%current_obj_data;
384                       for my $k (keys %current_obj_data) {
385                           $blobs{$current_id}{$k}=$current_obj_data{$k};
386                           for ($blobs{$current_id}{$k}) {
387                               s/^\s+//;
388                               s/\s+$//;
389                           } 
390                       }
391                       if (!$current_obj_data{"__DELETED__"}) {
392                          $_=$current_obj_data{"pid"};
393                          my ($boguid)=/<pid>([^<]*)<\/pid>/;
394 #                        print "DEBUG: blob parent GUID: $boguid \n";
395                          # TODO: place current guid to blobmap
396                          $cnt=0;
397                          foreach my $k (keys %{$blobmap{$boguid}}) {
398                                  $cnt++;
399                          }
400 #                        print "DEBUG: count: $cnt \n";
401                          $blobmap{$boguid}{$cnt}=$current_id;
402                       }
403                    }
404                 }
405                
406                 $xml_data{$current_id}=$obj_content;
407                  
408                 $obj_content = "";
409                 $current_id = "";
410                 $current_obj_type="";
411                 %current_obj_data=();
412
413              } else {
414                 $current_obj_data{$element}=$cur_content;
415              }
416
417              $cur_content="";
418         }
419 }
420
421 sub default_handler {
422         my ($p, $string) = @_;
423         $cur_content .= $string;
424 }
425
426
427 sub usage {
428         print<<EOP;
429 remove_unapproved.pl [options] <filename>
430   options:
431       -p don't check page approvals
432       -s don't check style approvals
433       -d don't check snippetdir approvals
434       -a don't check article approvals
435       -r check also SG0 object approvals
436 EOP
437 }
438
439 #-----------------------------------------------------------------------------------------------------------
440
Note: See TracBrowser for help on using the browser.