File Coverage

blib/lib/WE/Util/Support.pm
Criterion Covered Total %
statement 9 263 3.4
branch 0 116 0.0
condition 0 15 0.0
subroutine 3 16 18.7
pod 0 7 0.0
total 12 417 2.8


line stmt bran cond sub pod time code
1             # -*- perl -*-
2              
3             #
4             # $Id: Support.pm,v 1.10 2006/04/18 21:39:44 eserte Exp $
5             # Author: Slaven Rezic
6             #
7             # Copyright (C) 2001 Online Office Berlin. All rights reserved.
8             # Copyright (C) 2002 Slaven Rezic.
9             # This is free software; you can redistribute it and/or modify it under the
10             # terms of the GNU General Public License, see the file COPYING.
11              
12             #
13             # Mail: slaven@rezic.de
14             # WWW: http://we-framework.sourceforge.net
15             #
16              
17             package WE::Util::Support;
18              
19 2     2   3567 use strict;
  2         5  
  2         53  
20 2     2   9 use vars qw($VERSION);
  2         3  
  2         143  
21             $VERSION = sprintf("%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/);
22              
23             =head1 NAME
24              
25             WE::Util::Support - support functions for the WE::DB framework
26              
27             =head1 SYNOPSIS
28              
29             use WE::Util::Support;
30              
31             =head1 DESCRIPTION
32              
33             =cut
34              
35             package WE::DB::Obj;
36 2     2   700 use WE::DB::Obj;
  2         5  
  2         17  
37              
38             # Backward compatibility...
39             if (!WE::DB::Obj->can('idify_params')) {
40             #warn "Define alias idify_params";
41             *idify_params = sub { shift->_idify_params(@_) };
42             }
43              
44             =head2 METHODS in the WE::DB::Obj package
45              
46             =over 4
47              
48             =item create_folder_tree(...)
49              
50             Create a folder tree from file or string.
51              
52             Options are:
53              
54             =over 4
55              
56             =item -string => $string
57              
58             The string with the folder information.
59              
60             =item -file => $file
61              
62             A file with the folder information. Either -string or -file have to exist.
63              
64             =item -rootid => $rootid
65              
66             The root object id to put the top-most folder in. If missing, then the
67             root obejct of the database will be used.
68              
69             =item -standardargs => { ... }
70              
71             Add standard arguments for each created object. The standard arguments
72             will be overwritten by the arguments in the folder information
73             string/file.
74              
75             =back
76              
77             The file or string should contain a list of attributes, prefixed with
78             a "-" and their values. All keys and values should be separated by
79             spaces. To mask spaces in attribute values, just use double quotes.
80             The folder structure is controlled by indentation, that is, top-level
81             folder are not indented, the second-level folders have one space
82             indentation and so on.
83              
84             For the B attribute, there is an exception to handle language </td> </tr> <tr> <td class="h" > <a name="85">85</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> dependent strings: the first two letters should form the ISO 638 code </td> </tr> <tr> <td class="h" > <a name="86">86</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for the language, followed by a colon, followed by the language </td> </tr> <tr> <td class="h" > <a name="87">87</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> dependent string. You can specify as many language strings as you </td> </tr> <tr> <td class="h" > <a name="88">88</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> like. If you do not need language dependent Title strings, then just </td> </tr> <tr> <td class="h" > <a name="89">89</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> use this attribute as the others. </td> </tr> <tr> <td class="h" > <a name="90">90</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="91">91</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Examples for B<Title>: </td> </tr> <tr> <td class="h" > <a name="92">92</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="93">93</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> -Title "language independent string" -Name a_name </td> </tr> <tr> <td class="h" > <a name="94">94</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> -Title "en:english" "de:german" "it:italian" -Name b_name </td> </tr> <tr> <td class="h" > <a name="95">95</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="96">96</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="97">97</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="98">98</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub create_folder_tree { </td> </tr> <tr> <td class="h" > <a name="99">99</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#99-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#99-1"> 0 </a> </td> <td >   </td> <td class="s"> my($self, %args) = @_; </td> </tr> <tr> <td class="h" > <a name="100">100</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $string = $args{'-string'}; </td> </tr> <tr> <td class="h" > <a name="101">101</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#101-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (!defined $string) { </td> </tr> <tr> <td class="h" > <a name="102">102</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#102-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (exists $args{-file}) { </td> </tr> <tr> <td class="h" > <a name="103">103</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#103-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> open(F, $args{-file}) or die "Can't open $args{-file}: $!"; </td> </tr> <tr> <td class="h" > <a name="104">104</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> local $/ = undef; </td> </tr> <tr> <td class="h" > <a name="105">105</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $string = <F>; </td> </tr> <tr> <td class="h" > <a name="106">106</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> close F; </td> </tr> <tr> <td class="h" > <a name="107">107</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="108">108</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> die "Either -file or -string must be given"; </td> </tr> <tr> <td class="h" > <a name="109">109</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="110">110</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="111">111</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $rootid = $args{'-rootid'}; </td> </tr> <tr> <td class="h" > <a name="112">112</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#112-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (!defined $rootid) { </td> </tr> <tr> <td class="h" > <a name="113">113</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $rootid = $self->root_object->Id; </td> </tr> <tr> <td class="h" > <a name="114">114</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="115">115</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#115-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my %std_args = ($args{'-standardargs'} ? %{$args{'-standardargs'}} : ()); </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="116">116</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="117">117</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # first pass: just check the indentation </td> </tr> <tr> <td class="h" > <a name="118">118</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $last_indent = 0; </td> </tr> <tr> <td class="h" > <a name="119">119</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> foreach my $line (split /\n/, $string) { </td> </tr> <tr> <td class="h" > <a name="120">120</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $line =~ /^(\s*)/; </td> </tr> <tr> <td class="h" > <a name="121">121</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $indent = length $1; </td> </tr> <tr> <td class="h" > <a name="122">122</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#122-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($indent > $last_indent+1) { </td> </tr> <tr> <td class="h" > <a name="123">123</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> die "Indentation error in line <$line>\n"; </td> </tr> <tr> <td class="h" > <a name="124">124</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="125">125</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $last_indent = $indent; </td> </tr> <tr> <td class="h" > <a name="126">126</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="127">127</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="128">128</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # second pass: do the right thing </td> </tr> <tr> <td class="h" > <a name="129">129</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> require Text::ParseWords; </td> </tr> <tr> <td class="h" > <a name="130">130</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @indent2objid; </td> </tr> <tr> <td class="h" > <a name="131">131</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $indent2objid[0] = $rootid; </td> </tr> <tr> <td class="h" > <a name="132">132</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> foreach my $line (split /\n/, $string) { </td> </tr> <tr> <td class="h" > <a name="133">133</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $line =~ s/^(\s*)//; </td> </tr> <tr> <td class="h" > <a name="134">134</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $indent = length $1; </td> </tr> <tr> <td class="h" > <a name="135">135</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $parentid = $indent2objid[$indent]; </td> </tr> <tr> <td class="h" > <a name="136">136</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#136-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (!defined $parentid) { </td> </tr> <tr> <td class="h" > <a name="137">137</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> die "Parse error in line $line? Check the indentation!\n"; </td> </tr> <tr> <td class="h" > <a name="138">138</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="139">139</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my %token; </td> </tr> <tr> <td class="h" > <a name="140">140</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my(@token) = Text::ParseWords::shellwords($line); </td> </tr> <tr> <td class="h" > <a name="141">141</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="142">142</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # special handling for languagestrings in Title: </td> </tr> <tr> <td class="h" > <a name="143">143</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for(my $i=0; $i<=$#token; ) { </td> </tr> <tr> <td class="h" > <a name="144">144</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($key, $val) = @token[$i, $i+1]; </td> </tr> <tr> <td class="h" > <a name="145">145</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#145-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($key eq '-Title') { </td> </tr> <tr> <td class="h" > <a name="146">146</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#146-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($val =~ /^(..):(.*)/) { </td> </tr> <tr> <td class="h" > <a name="147">147</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($lang, $string) = ($1,$2); </td> </tr> <tr> <td class="h" > <a name="148">148</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> require WE::Util::LangString; </td> </tr> <tr> <td class="h" > <a name="149">149</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $ls = WE::Util::LangString->new; </td> </tr> <tr> <td class="h" > <a name="150">150</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $ls->{$lang} = $string; </td> </tr> <tr> <td class="h" > <a name="151">151</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $i+=2; </td> </tr> <tr> <td class="h" > <a name="152">152</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> while (1) { </td> </tr> <tr> <td class="h" > <a name="153">153</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $val = $token[$i]; </td> </tr> <tr> <td class="h" > <a name="154">154</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#154-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--condition.html#154-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (!defined $val || $val =~ /^-/) { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#-2"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="155">155</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # next option/no option => write langstring </td> </tr> <tr> <td class="h" > <a name="156">156</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $token{$key} = $ls; </td> </tr> <tr> <td class="h" > <a name="157">157</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> last; </td> </tr> <tr> <td class="h" > <a name="158">158</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } elsif ($val =~ /^(..):(.*)/) { </td> </tr> <tr> <td class="h" > <a name="159">159</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($lang, $string) = ($1,$2); </td> </tr> <tr> <td class="h" > <a name="160">160</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $ls->{$lang} = $string; </td> </tr> <tr> <td class="h" > <a name="161">161</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $i++; </td> </tr> <tr> <td class="h" > <a name="162">162</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="163">163</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> die "Parse error in line $line: either language string or new option expected, but got $val"; </td> </tr> <tr> <td class="h" > <a name="164">164</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="165">165</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="166">166</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="167">167</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $token{$key} = $val; </td> </tr> <tr> <td class="h" > <a name="168">168</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $i+=2; </td> </tr> <tr> <td class="h" > <a name="169">169</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="170">170</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="171">171</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $token{$key} = $val; </td> </tr> <tr> <td class="h" > <a name="172">172</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $i+=2; </td> </tr> <tr> <td class="h" > <a name="173">173</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="174">174</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="175">175</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="176">176</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my %args = (%std_args, %token); </td> </tr> <tr> <td class="h" > <a name="177">177</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $args{'-parent'} = $parentid; </td> </tr> <tr> <td class="h" > <a name="178">178</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $fldr = $self->insert_folder(%args); # XXX handle langstrings? </td> </tr> <tr> <td class="h" > <a name="179">179</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $newobjid = $fldr->Id; </td> </tr> <tr> <td class="h" > <a name="180">180</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $indent2objid[$indent+1] = $newobjid; </td> </tr> <tr> <td class="h" > <a name="181">181</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="182">182</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="183">183</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="184">184</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =item change_order($p_id, \@child_ids) </td> </tr> <tr> <td class="h" > <a name="185">185</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="186">186</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> For the parent collection C<$p_id> the children will be sorted </td> </tr> <tr> <td class="h" > <a name="187">187</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> according to the array reference C<@child_ids>. Children of C<$p_id> </td> </tr> <tr> <td class="h" > <a name="188">188</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> which are not in C<@child_ids> will be put to the back. Throws an </td> </tr> <tr> <td class="h" > <a name="189">189</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> error if one of C<@child_ids> is not a child of C<$p_id>. </td> </tr> <tr> <td class="h" > <a name="190">190</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="191">191</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="192">192</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="193">193</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub change_order { </td> </tr> <tr> <td class="h" > <a name="194">194</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#194-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#194-1"> 0 </a> </td> <td >   </td> <td class="s"> my($self, $p_id, $child_ids_ref) = @_; </td> </tr> <tr> <td class="h" > <a name="195">195</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my(@child_ids) = @$child_ids_ref; </td> </tr> <tr> <td class="h" > <a name="196">196</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->idify_params($p_id, @child_ids); </td> </tr> <tr> <td class="h" > <a name="197">197</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="198">198</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # The connect is here used as a locking mechanism. </td> </tr> <tr> <td class="h" > <a name="199">199</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->connect_if_necessary </td> </tr> <tr> <td class="h" > <a name="200">200</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> (sub { </td> </tr> <tr> <td class="h" > <a name="201">201</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#201-1"> 0 </a> </td> <td >   </td> <td >   </td> <td class="s"> my $p_stored_obj = $self->_get_stored_obj($p_id); </td> </tr> <tr> <td class="h" > <a name="202">202</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#202-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> die "Can't get stored object for <$p_id>" if !$p_stored_obj; </td> </tr> <tr> <td class="h" > <a name="203">203</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # first check whether the children are really the children: </td> </tr> <tr> <td class="h" > <a name="204">204</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @real_children = $self->children_ids($p_id); </td> </tr> <tr> <td class="h" > <a name="205">205</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my(%real_children) = map { ($_=>1) } @real_children; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="206">206</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> foreach my $c_id (@child_ids) { </td> </tr> <tr> <td class="h" > <a name="207">207</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#207-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (!exists $real_children{$c_id}) { </td> </tr> <tr> <td class="h" > <a name="208">208</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> die "The object <$c_id> is not child of <$p_id>!"; </td> </tr> <tr> <td class="h" > <a name="209">209</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="210">210</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="211">211</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @new_child_list = @child_ids; </td> </tr> <tr> <td class="h" > <a name="212">212</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> foreach (@child_ids) { delete $real_children{$_} } </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="213">213</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # put missing ids to the back </td> </tr> <tr> <td class="h" > <a name="214">214</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#214-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (keys %real_children) { </td> </tr> <tr> <td class="h" > <a name="215">215</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> warn "The following ids are unhandled by change_order: @{[ keys %real_children ]}"; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="216">216</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # iterate over array to preserver old order </td> </tr> <tr> <td class="h" > <a name="217">217</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> foreach (@real_children) { </td> </tr> <tr> <td class="h" > <a name="218">218</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#218-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (exists $real_children{$_}) { </td> </tr> <tr> <td class="h" > <a name="219">219</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> push @new_child_list, $_; </td> </tr> <tr> <td class="h" > <a name="220">220</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> delete $real_children{$_}; </td> </tr> <tr> <td class="h" > <a name="221">221</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="222">222</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="223">223</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#223-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (keys %real_children) { </td> </tr> <tr> <td class="h" > <a name="224">224</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> die "Strange! There are still some keys unhandled: @{[ keys %real_children ]}"; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="225">225</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="226">226</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="227">227</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="228">228</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $p_stored_obj->[WE::DB::Obj::CHILDREN] = \@new_child_list; </td> </tr> <tr> <td class="h" > <a name="229">229</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->_store_stored_obj($p_stored_obj); </td> </tr> <tr> <td class="h" > <a name="230">230</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }); </td> </tr> <tr> <td class="h" > <a name="231">231</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="232">232</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="233">233</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =item get_position_array($obj_id, [%args]) </td> </tr> <tr> <td class="h" > <a name="234">234</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="235">235</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> For a given object C<$obj_id>, return an array with the positions of </td> </tr> <tr> <td class="h" > <a name="236">236</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> this object in its parent, and the positions of all predecessors. </td> </tr> <tr> <td class="h" > <a name="237">237</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="238">238</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> The following options are recognized for C<%args>: </td> </tr> <tr> <td class="h" > <a name="239">239</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="240">240</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =over 4 </td> </tr> <tr> <td class="h" > <a name="241">241</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="242">242</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =item -base => C<$base> </td> </tr> <tr> <td class="h" > <a name="243">243</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="244">244</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> The positions are by default 0-based, but can be changed with the </td> </tr> <tr> <td class="h" > <a name="245">245</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> optional argument C<$base>. </td> </tr> <tr> <td class="h" > <a name="246">246</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="247">247</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =item -filter => C<$sub> </td> </tr> <tr> <td class="h" > <a name="248">248</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="249">249</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Specify an optional filter for the recursion process. The filter </td> </tr> <tr> <td class="h" > <a name="250">250</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> options should be a reference to a subroutine. This subroutine is </td> </tr> <tr> <td class="h" > <a name="251">251</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> called with two arguments: the object database reference and the id of </td> </tr> <tr> <td class="h" > <a name="252">252</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> an object to test. If the object should be included into the position </td> </tr> <tr> <td class="h" > <a name="253">253</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> counting, then 1 should be returned, otherwise 0. </td> </tr> <tr> <td class="h" > <a name="254">254</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="255">255</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =item -indexdoc => C<$bool> </td> </tr> <tr> <td class="h" > <a name="256">256</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="257">257</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> If true, then the IndexDoc attribute is used for determining the </td> </tr> <tr> <td class="h" > <a name="258">258</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> document position. </td> </tr> <tr> <td class="h" > <a name="259">259</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="260">260</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =back </td> </tr> <tr> <td class="h" > <a name="261">261</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="262">262</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Note that only the first parent is used, if there are objects with </td> </tr> <tr> <td class="h" > <a name="263">263</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> multiple parents. </td> </tr> <tr> <td class="h" > <a name="264">264</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="265">265</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="266">266</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="267">267</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub get_position_array { </td> </tr> <tr> <td class="h" > <a name="268">268</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#268-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#268-1"> 0 </a> </td> <td >   </td> <td class="s"> my($self, $obj_id, %args) = @_; </td> </tr> <tr> <td class="h" > <a name="269">269</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#269-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $base = defined $args{-base} ? $args{-base} : 0; </td> </tr> <tr> <td class="h" > <a name="270">270</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $filter = $args{-filter}; </td> </tr> <tr> <td class="h" > <a name="271">271</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->idify_params($obj_id); </td> </tr> <tr> <td class="h" > <a name="272">272</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($p_id) = ($self->parent_ids($obj_id))[0]; </td> </tr> <tr> <td class="h" > <a name="273">273</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#273-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return () if !defined $p_id; </td> </tr> <tr> <td class="h" > <a name="274">274</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my(@children_ids) = $self->children_ids($p_id); </td> </tr> <tr> <td class="h" > <a name="275">275</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="276">276</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#276-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($args{'-indexdoc'}) { </td> </tr> <tr> <td class="h" > <a name="277">277</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $p_obj = $self->get_object($p_id); </td> </tr> <tr> <td class="h" > <a name="278">278</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#278-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (!$p_obj) { </td> </tr> <tr> <td class="h" > <a name="279">279</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> die "Can't get object for id $p_id"; </td> </tr> <tr> <td class="h" > <a name="280">280</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="281">281</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#281-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--condition.html#281-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($p_obj->{IndexDoc} && $p_obj->{IndexDoc} == $obj_id) { </td> </tr> <tr> <td class="h" > <a name="282">282</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return $self->get_position_array($p_id, %args); </td> </tr> <tr> <td class="h" > <a name="283">283</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="284">284</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="285">285</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="286">286</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $this_pos; </td> </tr> <tr> <td class="h" > <a name="287">287</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $pos = 0; </td> </tr> <tr> <td class="h" > <a name="288">288</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for my $c_id (@children_ids) { </td> </tr> <tr> <td class="h" > <a name="289">289</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#289-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--condition.html#289-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($filter && !$filter->($self, $c_id)) { </td> </tr> <tr> <td class="h" > <a name="290">290</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> next; </td> </tr> <tr> <td class="h" > <a name="291">291</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="292">292</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#292-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($c_id eq $obj_id) { </td> </tr> <tr> <td class="h" > <a name="293">293</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $this_pos = $pos + $base; </td> </tr> <tr> <td class="h" > <a name="294">294</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> last; </td> </tr> <tr> <td class="h" > <a name="295">295</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="296">296</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $pos++; </td> </tr> <tr> <td class="h" > <a name="297">297</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="298">298</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#298-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (!defined $this_pos) { </td> </tr> <tr> <td class="h" > <a name="299">299</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $err = "Strange: can't find object <$obj_id> in the children collection of its parent <$p_id>."; </td> </tr> <tr> <td class="h" > <a name="300">300</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#300-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($filter) { </td> </tr> <tr> <td class="h" > <a name="301">301</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $err .= "\nMaybe the filter was to strict?"; </td> </tr> <tr> <td class="h" > <a name="302">302</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="303">303</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> die $err; </td> </tr> <tr> <td class="h" > <a name="304">304</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="305">305</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ($self->get_position_array($p_id, -filter => $filter, -base => $base), $this_pos); </td> </tr> <tr> <td class="h" > <a name="306">306</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="307">307</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="308">308</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =item check_integrity </td> </tr> <tr> <td class="h" > <a name="309">309</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="310">310</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Return a C<WE::DB::Obj::Fsck> object with lists of inconsistencies in </td> </tr> <tr> <td class="h" > <a name="311">311</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> the C<WE::DB::Obj> database. </td> </tr> <tr> <td class="h" > <a name="312">312</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="313">313</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="314">314</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="315">315</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub check_integrity { </td> </tr> <tr> <td class="h" > <a name="316">316</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#316-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#316-1"> 0 </a> </td> <td >   </td> <td class="s"> my $self = shift; </td> </tr> <tr> <td class="h" > <a name="317">317</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $contentdb = shift; </td> </tr> <tr> <td class="h" > <a name="318">318</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="319">319</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @undef_values; </td> </tr> <tr> <td class="h" > <a name="320">320</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @broken_values; </td> </tr> <tr> <td class="h" > <a name="321">321</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @not_existing_children; </td> </tr> <tr> <td class="h" > <a name="322">322</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @not_existing_parents; </td> </tr> <tr> <td class="h" > <a name="323">323</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @not_existing_versions; </td> </tr> <tr> <td class="h" > <a name="324">324</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @not_referenced; </td> </tr> <tr> <td class="h" > <a name="325">325</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @wrong_ids; </td> </tr> <tr> <td class="h" > <a name="326">326</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @child_parent_mismatches; </td> </tr> <tr> <td class="h" > <a name="327">327</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @doc_object_without_content; </td> </tr> <tr> <td class="h" > <a name="328">328</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="329">329</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $root_object_missing = 0; </td> </tr> <tr> <td class="h" > <a name="330">330</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="331">331</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my %referenced; </td> </tr> <tr> <td class="h" > <a name="332">332</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="333">333</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $root_obj = $self->root_object; </td> </tr> <tr> <td class="h" > <a name="334">334</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#334-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (!$root_obj) { </td> </tr> <tr> <td class="h" > <a name="335">335</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # This is fatal, don't do any other checks </td> </tr> <tr> <td class="h" > <a name="336">336</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $root_object_missing = 1; </td> </tr> <tr> <td class="h" > <a name="337">337</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> goto RETURN; </td> </tr> <tr> <td class="h" > <a name="338">338</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="339">339</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $referenced{$root_obj->Id} = []; </td> </tr> <tr> <td class="h" > <a name="340">340</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="341">341</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="342">342</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->connect_if_necessary(sub { </td> </tr> <tr> <td class="h" > <a name="343">343</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#343-1"> 0 </a> </td> <td >   </td> <td >   </td> <td class="s"> my @keys = grep { !/^_/ } keys %{ $self->{DB} }; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="344">344</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # XXX Can't use while...each --- segfault with 5.8.0 </td> </tr> <tr> <td class="h" > <a name="345">345</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for my $k (@keys) { </td> </tr> <tr> <td class="h" > <a name="346">346</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $v = $self->{DB}{$k}; </td> </tr> <tr> <td class="h" > <a name="347">347</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#347-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--condition.html#347-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (!defined $v) { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#-2"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="348">348</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> push @undef_values, $k; </td> </tr> <tr> <td class="h" > <a name="349">349</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } elsif (ref $v ne 'ARRAY' || @$v != 4) { </td> </tr> <tr> <td class="h" > <a name="350">350</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> push @broken_values, $k; </td> </tr> <tr> <td class="h" > <a name="351">351</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="352">352</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#352-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($v->[OBJECT]->{Id} ne $k) { </td> </tr> <tr> <td class="h" > <a name="353">353</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> push @wrong_ids, $k; </td> </tr> <tr> <td class="h" > <a name="354">354</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="355">355</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my(@children_ids) = @{$v->[CHILDREN]}; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="356">356</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my(@parent_ids) = @{$v->[PARENTS]}; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="357">357</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my(@version_ids) = @{$v->[VERSIONS]}; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="358">358</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for my $def (["c", \@children_ids, \@not_existing_children], </td> </tr> <tr> <td class="h" > <a name="359">359</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ["p", \@parent_ids, \@not_existing_parents], </td> </tr> <tr> <td class="h" > <a name="360">360</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ["v", \@version_ids, \@not_existing_versions], </td> </tr> <tr> <td class="h" > <a name="361">361</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ) { </td> </tr> <tr> <td class="h" > <a name="362">362</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($type, $ids, $res) = @$def; </td> </tr> <tr> <td class="h" > <a name="363">363</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for my $id (@$ids) { </td> </tr> <tr> <td class="h" > <a name="364">364</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#364-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (!exists $self->{DB}{$id}) { </td> </tr> <tr> <td class="h" > <a name="365">365</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> push @$res, [$k, $id]; </td> </tr> <tr> <td class="h" > <a name="366">366</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="367">367</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#367-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($type ne "p") { </td> </tr> <tr> <td class="h" > <a name="368">368</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> push @{$referenced{$id}}, $k; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="369">369</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="370">370</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="371">371</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="372">372</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="373">373</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for my $id (@children_ids) { </td> </tr> <tr> <td class="h" > <a name="374">374</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#374-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (exists $self->{DB}{$id}) { </td> </tr> <tr> <td class="h" > <a name="375">375</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $c = $self->{DB}{$id}; </td> </tr> <tr> <td class="h" > <a name="376">376</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> CHECK_PARENT: { </td> </tr> <tr> <td class="h" > <a name="377">377</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for my $p_id (@{$c->[PARENTS]}) { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="378">378</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#378-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($p_id eq $k) { </td> </tr> <tr> <td class="h" > <a name="379">379</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> last CHECK_PARENT; </td> </tr> <tr> <td class="h" > <a name="380">380</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="381">381</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="382">382</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> push @child_parent_mismatches, [$k, $id]; </td> </tr> <tr> <td class="h" > <a name="383">383</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="384">384</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="385">385</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="386">386</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#386-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($contentdb) { </td> </tr> <tr> <td class="h" > <a name="387">387</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $o = $v->[WE::DB::Obj::OBJECT]; </td> </tr> <tr> <td class="h" > <a name="388">388</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#388-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($o->is_doc) { </td> </tr> <tr> <td class="h" > <a name="389">389</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $f = $contentdb->filename($o); </td> </tr> <tr> <td class="h" > <a name="390">390</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#390-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (!-e $f) { </td> </tr> <tr> <td class="h" > <a name="391">391</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> push @doc_object_without_content, $o->Id; </td> </tr> <tr> <td class="h" > <a name="392">392</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="393">393</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="394">394</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="395">395</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="396">396</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="397">397</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="398">398</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for my $k (@keys) { </td> </tr> <tr> <td class="h" > <a name="399">399</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#399-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (!exists $referenced{$k}) { </td> </tr> <tr> <td class="h" > <a name="400">400</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> push @not_referenced, $k; </td> </tr> <tr> <td class="h" > <a name="401">401</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="402">402</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="403">403</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }); </td> </tr> <tr> <td class="h" > <a name="404">404</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="405">405</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> RETURN: </td> </tr> <tr> <td class="h" > <a name="406">406</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> @not_existing_children = sort {$a->[0]<=>$b->[0]} @not_existing_children; </td> </tr> <tr> <td class="h" > <a name="407">407</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> @not_existing_parents = sort {$a->[0]<=>$b->[0]} @not_existing_parents; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="408">408</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> @not_existing_versions = sort {$a->[0]<=>$b->[0]} @not_existing_versions; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="409">409</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> @not_referenced = sort {$a<=>$b} @not_referenced; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="410">410</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="411">411</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> bless { "undef_values" => \@undef_values, </td> </tr> <tr> <td class="h" > <a name="412">412</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "broken_values" => \@broken_values, </td> </tr> <tr> <td class="h" > <a name="413">413</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "wrong_ids" => \@wrong_ids, </td> </tr> <tr> <td class="h" > <a name="414">414</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "not_existing_children" => \@not_existing_children, </td> </tr> <tr> <td class="h" > <a name="415">415</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "not_existing_parents" => \@not_existing_parents, </td> </tr> <tr> <td class="h" > <a name="416">416</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "not_existing_versions" => \@not_existing_versions, </td> </tr> <tr> <td class="h" > <a name="417">417</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "not_referenced" => \@not_referenced, </td> </tr> <tr> <td class="h" > <a name="418">418</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "child_parent_mismatches" => \@child_parent_mismatches, </td> </tr> <tr> <td class="h" > <a name="419">419</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "doc_object_without_content" => \@doc_object_without_content, </td> </tr> <tr> <td class="h" > <a name="420">420</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "root_object_missing" => $root_object_missing, </td> </tr> <tr> <td class="h" > <a name="421">421</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }, 'WE::DB::Obj::Fsck'; </td> </tr> <tr> <td class="h" > <a name="422">422</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="423">423</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="424">424</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =item repair_database($errors, %args) </td> </tr> <tr> <td class="h" > <a name="425">425</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="426">426</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Take a C<WE::DB::Obj::Fsck> object with lists of inconsistencies and </td> </tr> <tr> <td class="h" > <a name="427">427</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> tries to repair the C<WE::DB::Obj> database. C<%args> may be: </td> </tr> <tr> <td class="h" > <a name="428">428</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="429">429</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =over </td> </tr> <tr> <td class="h" > <a name="430">430</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="431">431</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =item -verbose </td> </tr> <tr> <td class="h" > <a name="432">432</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="433">433</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Be verbose if set to a true value. </td> </tr> <tr> <td class="h" > <a name="434">434</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="435">435</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =back </td> </tr> <tr> <td class="h" > <a name="436">436</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="437">437</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="438">438</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="439">439</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # errors is the return value of check_integrity() (a WE::DB::Obj::Fsck object) </td> </tr> <tr> <td class="h" > <a name="440">440</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub repair_database { </td> </tr> <tr> <td class="h" > <a name="441">441</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#441-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#441-1"> 0 </a> </td> <td >   </td> <td class="s"> my($self, $errors, %args) = @_; </td> </tr> <tr> <td class="h" > <a name="442">442</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#442-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $v = 1 if $args{-verbose}; </td> </tr> <tr> <td class="h" > <a name="443">443</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $root_object_id = $args{-rootobjectid}; </td> </tr> <tr> <td class="h" > <a name="444">444</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->connect_if_necessary(sub { </td> </tr> <tr> <td class="h" > <a name="445">445</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#445-1"> 0 </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#445-1"> 0 </a> </td> <td >   </td> <td >   </td> <td class="s"> if ($errors->{root_object_missing}) { </td> </tr> <tr> <td class="h" > <a name="446">446</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#446-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (!defined $root_object_id) { </td> </tr> <tr> <td class="h" > <a name="447">447</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> die "rootobjectid not specified"; </td> </tr> <tr> <td class="h" > <a name="448">448</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="449">449</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->{DB}{'_root_object'} = $root_object_id; </td> </tr> <tr> <td class="h" > <a name="450">450</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="451">451</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> foreach my $id (@{ $errors->{"not_referenced"} }) { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="452">452</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#452-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> warn "Remove object $id from database\n" if $v; </td> </tr> <tr> <td class="h" > <a name="453">453</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> delete $self->{DB}{$id}; </td> </tr> <tr> <td class="h" > <a name="454">454</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="455">455</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for my $def ([CHILDREN, "not_existing_children", "child"], </td> </tr> <tr> <td class="h" > <a name="456">456</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> [PARENTS, "not_existing_parents", "parent"], </td> </tr> <tr> <td class="h" > <a name="457">457</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> [VERSIONS, "not_existing_versions", "version"], </td> </tr> <tr> <td class="h" > <a name="458">458</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ) { </td> </tr> <tr> <td class="h" > <a name="459">459</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($index, $key, $label) = @$def; </td> </tr> <tr> <td class="h" > <a name="460">460</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for my $def2 (@{ $errors->{$key} }) { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="461">461</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($id, $refid) = @$def2; </td> </tr> <tr> <td class="h" > <a name="462">462</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $o = $self->{DB}{$id}; </td> </tr> <tr> <td class="h" > <a name="463">463</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#463-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (!$o) { </td> </tr> <tr> <td class="h" > <a name="464">464</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> warn "Object $id does not exist anymore, skipping...\n"; </td> </tr> <tr> <td class="h" > <a name="465">465</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="466">466</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#466-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> warn "Remove $label $refid from $id\n" if $v; </td> </tr> <tr> <td class="h" > <a name="467">467</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> @{$o->[$index]} = grep { $_ ne $refid } @{$o->[$index]}; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="468">468</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->{DB}{$id} = $o; </td> </tr> <tr> <td class="h" > <a name="469">469</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="470">470</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="471">471</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="472">472</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#472-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($errors->{doc_object_without_content}) { </td> </tr> <tr> <td class="h" > <a name="473">473</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for my $id (@{ $errors->{doc_object_without_content} }) { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="474">474</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#474-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> warn "Remove doc object $id from database (no content file)\n" </td> </tr> <tr> <td class="h" > <a name="475">475</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if $v; </td> </tr> <tr> <td class="h" > <a name="476">476</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> delete $self->{DB}{$id}; </td> </tr> <tr> <td class="h" > <a name="477">477</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="478">478</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="479">479</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#479-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> warn "Cannot repair undef_values\n" if @{ $errors->{"undef_values"} }; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="480">480</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#480-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> warn "Cannot repair broken_values\n" if @{ $errors->{"broken_values"} }; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="481">481</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }); </td> </tr> <tr> <td class="h" > <a name="482">482</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="483">483</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="484">484</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =back </td> </tr> <tr> <td class="h" > <a name="485">485</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="486">486</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="487">487</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="488">488</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> package WE::DB::Content; </td> </tr> <tr> <td class="h" > <a name="489">489</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="490">490</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head2 METHODS in the WE::DB::Content package </td> </tr> <tr> <td class="h" > <a name="491">491</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="492">492</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =over </td> </tr> <tr> <td class="h" > <a name="493">493</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="494">494</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =item check_integrity($objdb) </td> </tr> <tr> <td class="h" > <a name="495">495</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="496">496</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Return a C<WE::DB::Content::Fsck> object with lists of inconsistencies </td> </tr> <tr> <td class="h" > <a name="497">497</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> in the C<WE::DB::Content> database. The check is done against the </td> </tr> <tr> <td class="h" > <a name="498">498</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> C<WE::DB::Obj> database C<$objdb>. </td> </tr> <tr> <td class="h" > <a name="499">499</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="500">500</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="501">501</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="502">502</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub check_integrity { </td> </tr> <tr> <td class="h" > <a name="503">503</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#503-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#503-1"> 0 </a> </td> <td >   </td> <td class="s"> my($self, $objdb) = @_; </td> </tr> <tr> <td class="h" > <a name="504">504</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="505">505</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @extra_files; </td> </tr> <tr> <td class="h" > <a name="506">506</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @unreferenced_files; </td> </tr> <tr> <td class="h" > <a name="507">507</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="508">508</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $objdb->connect_if_necessary(sub { </td> </tr> <tr> <td class="h" > <a name="509">509</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#509-1"> 0 </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#509-1"> 0 </a> </td> <td >   </td> <td >   </td> <td class="s"> opendir(D, $self->Directory) or die "Can't open " . $self->Directory . ": $!"; </td> </tr> <tr> <td class="h" > <a name="510">510</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> while(my $f = readdir D) { </td> </tr> <tr> <td class="h" > <a name="511">511</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#511-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> next if $f =~ /^\.\.?$/; </td> </tr> <tr> <td class="h" > <a name="512">512</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($id) = $f =~ /^(\d+)\./; </td> </tr> <tr> <td class="h" > <a name="513">513</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#513-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (defined $id) { </td> </tr> <tr> <td class="h" > <a name="514">514</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#514-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (!exists $objdb->{DB}{$id}) { </td> </tr> <tr> <td class="h" > <a name="515">515</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> push @unreferenced_files, $f; </td> </tr> <tr> <td class="h" > <a name="516">516</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="517">517</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="518">518</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#518-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($f !~ /^(\.svn|CVS|\.cvsignore|\.keep_me|RCS)$/) { </td> </tr> <tr> <td class="h" > <a name="519">519</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> push @extra_files, $f; </td> </tr> <tr> <td class="h" > <a name="520">520</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="521">521</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="522">522</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="523">523</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> closedir D; </td> </tr> <tr> <td class="h" > <a name="524">524</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }); </td> </tr> <tr> <td class="h" > <a name="525">525</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="526">526</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> bless {"unreferenced_files" => \@unreferenced_files, </td> </tr> <tr> <td class="h" > <a name="527">527</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "extra_files" => \@extra_files, </td> </tr> <tr> <td class="h" > <a name="528">528</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }, 'WE::DB::Content::Fsck'; </td> </tr> <tr> <td class="h" > <a name="529">529</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="530">530</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="531">531</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =item repair_database($errors, %args) </td> </tr> <tr> <td class="h" > <a name="532">532</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="533">533</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Take a C<WE::DB::Content::Fsck> object with lists of inconsistencies </td> </tr> <tr> <td class="h" > <a name="534">534</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> and tries to repair the C<WE::DB::Content> database. C<%args> may be: </td> </tr> <tr> <td class="h" > <a name="535">535</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="536">536</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =over </td> </tr> <tr> <td class="h" > <a name="537">537</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="538">538</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =item -verbose </td> </tr> <tr> <td class="h" > <a name="539">539</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="540">540</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Be verbose if set to a true value. </td> </tr> <tr> <td class="h" > <a name="541">541</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="542">542</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =back </td> </tr> <tr> <td class="h" > <a name="543">543</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="544">544</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="545">545</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="546">546</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # errors is the return value of check_integrity() (a </td> </tr> <tr> <td class="h" > <a name="547">547</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # WE::DB::Content::Fsck object) </td> </tr> <tr> <td class="h" > <a name="548">548</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub repair_database { </td> </tr> <tr> <td class="h" > <a name="549">549</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#549-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#549-1"> 0 </a> </td> <td >   </td> <td class="s"> my($self, $errors, %args) = @_; </td> </tr> <tr> <td class="h" > <a name="550">550</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#550-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $v = 1 if $args{-verbose}; </td> </tr> <tr> <td class="h" > <a name="551">551</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> require File::Spec; </td> </tr> <tr> <td class="h" > <a name="552">552</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for my $file (@{ $errors->{unreferenced_files} }) { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="553">553</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $path = File::Spec->catfile($self->Directory, $file); </td> </tr> <tr> <td class="h" > <a name="554">554</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> warn "unlink $path\n"; </td> </tr> <tr> <td class="h" > <a name="555">555</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#555-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> unlink $path or warn "Can't unlink $path: $!"; </td> </tr> <tr> <td class="h" > <a name="556">556</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="557">557</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#557-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (@{ $errors->{extra_files} }) { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="558">558</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> warn "Please remove extra files manually, e.g. with </td> </tr> <tr> <td class="h" > <a name="559">559</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> cd @{[ $self->Directory ]} && rm -i @{ $errors->{extra_files} } </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="560">560</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "; </td> </tr> <tr> <td class="h" > <a name="561">561</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="562">562</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="563">563</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="564">564</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="565">565</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> package WE::DB::Fsck; </td> </tr> <tr> <td class="h" > <a name="566">566</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="567">567</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub has_errors { </td> </tr> <tr> <td class="h" > <a name="568">568</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#568-1"> 0 </a> </td> <td >   </td> <td >   </td> <td class="s"> my $errors = shift; </td> </tr> <tr> <td class="h" > <a name="569">569</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> foreach (values %$errors) { </td> </tr> <tr> <td class="h" > <a name="570">570</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#570-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--condition.html#570-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (ref $_ eq 'ARRAY' && @$_) { </td> </tr> <tr> <td class="h" > <a name="571">571</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return 1; </td> </tr> <tr> <td class="h" > <a name="572">572</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="573">573</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="574">574</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#574-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($errors->has_fatal_errors) { </td> </tr> <tr> <td class="h" > <a name="575">575</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return 1; </td> </tr> <tr> <td class="h" > <a name="576">576</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="577">577</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> 0; </td> </tr> <tr> <td class="h" > <a name="578">578</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="579">579</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="580">580</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub has_fatal_errors { </td> </tr> <tr> <td class="h" > <a name="581">581</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--subroutine.html#581-1"> 0 </a> </td> <td >   </td> <td >   </td> <td class="s"> my $errors = shift; </td> </tr> <tr> <td class="h" > <a name="582">582</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-WE-Util-Support-pm--branch.html#582-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return $errors->{root_object_missing} ? 1 : 0; </td> </tr> <tr> <td class="h" > <a name="583">583</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="584">584</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="585">585</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> package WE::DB::Obj::Fsck; </td> </tr> <tr> <td class="h" > <a name="586">586</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> @WE::DB::Obj::Fsck::ISA = 'WE::DB::Fsck'; </td> </tr> <tr> <td class="h" > <a name="587">587</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="588">588</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> package WE::DB::Content::Fsck; </td> </tr> <tr> <td class="h" > <a name="589">589</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> @WE::DB::Content::Fsck::ISA = 'WE::DB::Fsck'; </td> </tr> <tr> <td class="h" > <a name="590">590</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="591">591</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> 1; </td> </tr> <tr> <td class="h" > <a name="592">592</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="593">593</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> __END__ </td> </tr> </table> </body> </html>