urgent multi-draft fixes from amalfi
[stet:stet.git] / stetsubs.pl
1 # Copyright (C) 2005, 2006   Software Freedom Law Center, Inc.
2 # Author: Orion Montoya <orion@mdcclv.com>
3 #
4 # This software gives you freedom; it is licensed to you under version
5 # 3 of the GNU Affero General Public License, along with the
6 # additional permission in the following paragraph.
7 #
8 # This notice constitutes a grant of such permission as is necessary
9 # to combine or link this software, or a modified version of it, with
10 # Request Tracker (RT), published by Jesse Vincent and Best Practical
11 # Solutions, LLC, or a derivative work of RT, and to copy, modify, and
12 # distribute the resulting work.  RT is licensed under version 2 of
13 # the GNU General Public License.
14 #  
15 # This software is distributed WITHOUT ANY WARRANTY, without even the
16 # implied warranties of MERCHANTABILITY and FITNESS FOR A PARTICULAR
17 # PURPOSE.  See the GNU Affero General Public License for further
18 # details.
19 #  
20 # You should have received a copy of the GNU Affero General Public
21 # License, version 3, and the GNU General Public License, version 2,
22 # along with this software.  If not, see <http://www.gnu.org/licenses/>.
23
24 use CGI qw/standard/;
25 use MIME::Base64;
26 use Frontier::Client;
27 use URI::Escape;
28
29 require "/var/www/stet/xmlpass.pl";
30
31 sub stripCrap($) {
32     my $crappy = shift;
33     $crappy =~ s/(.*)\?.*/$1/;
34     $crappy =~ s/.*\/([^\/]+)/$1/;
35     return $crappy;
36 }
37
38 sub cleanNoteSel($) {
39     my $item = shift;
40     my $noteSelection = $$item->FirstCustomFieldValue('NoteSelection');
41     $noteSelection =~ s/</&lt;/g;
42     $noteSelection =~ s/>/&gt;/g;
43     return $noteSelection;
44 }
45
46 sub showAgree($$) {
47     my $item = shift;
48     my $name = shift;
49     my $agr_vals;
50     my $showagree = ''; 
51     $agr_vals = $$item->CustomFieldValues(7);
52     if ($resp == 1) {
53         if (($name) && ($agr_vals->HasEntry("$name\n"))) {
54             $showagree = "unagree";
55         }
56         else {
57             $showagree = "agree";
58         }
59     }
60     else {
61         $showagree = "<a href=\"http://gplv3.fsf.org/login_form?came_from=/comments/\">login</a> to agree";
62     }
63 #    print STDERR "showagree is $showagree\n";
64     return $showagree, $agr_vals->Count;
65 }
66
67
68 sub showAgreeStr($) {
69     my $item = shift;
70     my $agr_vals;
71     our ($resp,$name);
72         my $showagree = '';     
73     $agr_vals = $$item->CustomFieldValues(7);
74         if ($resp == 1) {
75             while (my $value = $agr_vals->Next) {
76                 if (($name) && ($value->Content eq $name)) {
77 #                   $showagree = "<a label=\"you have indicated that you agree with this\" name=\"you have indicated that you agree with this\">unagree</a>";
78                     $showagree = "unagree";
79                 }
80             }
81             if (!$showagree) {
82                 $showagree = "agree";
83             }
84         }
85         else {
86             $showagree = "login";
87         }
88
89         return $showagree, $agr_vals->count;
90 }
91
92
93 my $server;
94 sub getUser($) {
95
96     my $CurrentUser = RT::CurrentUser->new;
97     my ($username, $password) = userpass();
98
99 #    print STDERR "entering getUser with external passwords.\n";
100     my $name;
101     our ($pass,$resp,$server);
102     if (($name, $pass) = split(/:/, decode_base64(CGI::cookie('__ac')))) {
103         $name =~ s/\"//g;
104         $server = Frontier::Client->new(url => 'http://'.$username.':'.$password.'@gplv3.fsf.org:8800/launch/acl_users/Users/acl_users'); #,
105 #                                          username => $username,
106 #                                          password =>  $password);
107         my $respref = $server->call('authRemoteUser',$name,$pass);
108         $resp = $$respref;
109     }
110     else {
111         $resp = 0;
112     }
113 #    print STDERR "resp to getUser was $resp\n";
114     
115 # mangle name for testing:
116 #       $name = $name."createtest2"; # have used 1, 45
117 #    print STDERR "name is $name and currentuser hash is ".$CurrentUser."\n";
118 # authorized users get privileges
119     if ($resp == 1) {
120         $CurrentUser->LoadByName($name);
121 #       print STDERR "current $resp a user is ".$CurrentUser->id."(".$CurrentUser->Name.")\n";
122     }
123     if (($resp ==1) && (!$CurrentUser->id)) {
124         my ($val, $msg) = createUser($name,$pass);
125         print STDERR "trying to create a user $name, got \"$val : $msg\"\n";
126         $CurrentUser->LoadByName($name);
127         print STDERR "created current $resp b user is ".$CurrentUser->id."(".$CurrentUser->Name.")\n";
128     }
129     elsif (!$CurrentUser->id) {
130 # unauthorized users get to see the public queues
131         $CurrentUser->LoadByName("public"); 
132         print STDERR "current $resp c user is ".$CurrentUser->id."(".$CurrentUser->Name.")\n";
133     }
134     $session->{'CurrentUser'} = $CurrentUser;
135     return ($CurrentUser, $resp, $name);
136 }
137
138 #}
139
140 sub shortOrg ($) {
141     my $user = shift;
142     if ($user->Organization) {
143         if ($user->Organization =~ /^[A-Z]$/) {
144             return " (of ".$user->Organization.") ";
145         }
146         else {
147             return " (".$user->Organization.") ";
148         }
149     }
150 }
151 sub longOrg ($) {
152     my $user = shift;
153     if ($user->Organization) {
154         if ($user->Organization =~ /^[A-Z]$/) {
155             $X = $user->Organization;
156             return " (of Committee <a href=\"http://gplv3.fsf.org/comments/rt/readsay.html?Query='CF.DiscussionGroup'%20LIKE%20'".$X."'\">".$X."</a>) ";
157         }
158         else {
159             return " (".$user->Organization.") ";
160         }
161     }
162 }
163
164 sub longOrgTxt ($) {
165     my $user = shift;
166     if ($user->Organization) {
167         if ($user->Organization =~ /^[A-Z]$/) {
168             $X = $user->Organization;
169             return " (of Committee $X) ";
170         }
171         else {
172             return " (".$user->Organization.") ";
173         }
174     }
175 }
176
177 sub createUser($$) {
178 my $name = shift;
179 my $pass = shift;
180 my $UserObj = RT::User->new(RT::CurrentUser->new('RT_System'));
181 our $server;
182 my $email = '';
183
184 eval{ $email = $server->call('getEmail',$name) };
185
186 if ($email) { print STDERR "got email $email\n"; }
187 else { $email = $name; }
188
189 my ($val, $msg) = $UserObj->Create(
190
191
192         Name                  => $name,
193         RealName              => $name,
194         ExternalContactInfoId => $name,
195         EmailAddress          => $email,
196         ContactInfoSystem     => "gnuxmlrpc",
197         Privileged           => 1,
198         Disabled            => 0,
199                                       );
200
201 #                                  %{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
202 #                                  Name   => $user,
203 #                                  Gecos  => $user,
204 #                                  Disabled => '0',
205 #                                  );
206
207 $UserObj->SetPassword($pass);
208
209     return ($val, $msg);
210 }
211
212 sub humanQuery {
213     $query = shift;
214     $query =~ s/'CF.NoteUrl' LIKE/in file/g;
215     $query =~ s/'CF.NoteUrl' NOT LIKE/not in file/g;
216 #    $query =~ s/'CF.NoteUrl' LIKE//g;
217 #    $query =~ s/'CF.NoteUrl' NOT LIKE//g;
218     
219     $query =~ s/'CF.NoteSelection' LIKE/selected text matches/g;
220     $query =~ s/'CF.NoteSelection' NOT LIKE/selected text does not match/g;
221     $query =~ s/'CF.NoteStartNodeId' LIKE/in section id/g;
222     $query =~ s/'CF.NoteStartNodeId' NOT LIKE/not in section id/g;
223     $query =~ s/'CF.Agreeers' LIKE/agreeers include/g;
224     $query =~ s/'CF.Agreeers' NOT LIKE/agreeers do not include/g;
225
226     $query =~ s/Requestor.Name LIKE/submitter matches/g;
227     $query =~ s/ AND /, and /g;
228     $query =~ s/ OR /, or /g;
229     return $query;
230 }
231
232 # {{{ sub myCFValueUpdater 
233
234 sub myCFValueUpdater {
235 #           print STDERR "stetsubs.pl 157\n";
236     my %args = (
237         ARGSRef => undef,
238         @_
239     );
240
241     my @results;
242
243     my $ARGSRef = $args{'ARGSRef'};
244
245     # Build up a list of tickets that we want to work with
246     my %tickets_to_mod;
247     my %custom_fields_to_mod;
248     foreach my $arg ( keys %{$ARGSRef} ) {
249         if ( $arg =~ /^Ticket-(\d+)-CustomField-(\d+)-/ ) {
250
251             # For each of those tickets, find out what custom fields we want to work with.
252             $custom_fields_to_mod{$1}{$2} = 1;
253 #           print STDERR "Web.pm 1059 ticket $1 field $2\n";
254         }
255     }
256
257     # For each of those tickets
258     foreach my $tick ( keys %custom_fields_to_mod ) {
259         my $Ticket = $args{'TicketObj'};
260         if (!$Ticket or $Ticket->id != $tick) {
261             $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
262             $Ticket->Load($tick);
263         }
264
265         # For each custom field  
266         foreach my $cf ( keys %{ $custom_fields_to_mod{$tick} } ) {
267
268             my $CustomFieldObj = RT::CustomField->new($session{'CurrentUser'});
269             $CustomFieldObj->LoadById($cf);
270
271             foreach my $arg ( keys %{$ARGSRef} ) {
272                 # since http won't pass in a form element with a null value, we need
273                 # to fake it
274                 if ($arg =~ /^(.*?)-Values-Magic$/ ) {
275                     # We don't care about the magic, if there's really a values element;
276                     next if (exists $ARGSRef->{$1.'-Values'}) ;
277
278                     $arg = $1."-Values";
279                     $ARGSRef->{$1."-Values"} = undef;
280                 
281                 }
282                 next unless ( $arg =~ /^Ticket-$tick-CustomField-$cf-/ );
283                 my @values =
284                   ( ref( $ARGSRef->{$arg} ) eq 'ARRAY' ) 
285                   ? @{ $ARGSRef->{$arg} }
286                   : split /\n/, $ARGSRef->{$arg} ;
287
288                 #for poor windows boxen that pass in "\r\n"
289                 local $/ = "\r";
290                 chomp @values;
291
292                 if ( ( $arg =~ /-AddValue$/ ) || ( $arg =~ /-Value$/ ) ) {
293                     foreach my $value (@values) {
294                         next unless length($value);
295                         my ( $val, $msg ) = $Ticket->AddCustomFieldValue(
296                             Field => $cf,
297                             Value => $value
298                         );
299                         push ( @results, $msg );
300                     }
301                 }
302                 elsif ( $arg =~ /-DeleteValues$/ ) {
303                     foreach my $value (@values) {
304                         next unless length($value);
305                         my ( $val, $msg ) = $Ticket->DeleteCustomFieldValue(
306                             Field => $cf,
307                             Value => $value
308                         );
309                         push ( @results, $msg );
310                     }
311                 }
312                 elsif ( $arg =~ /-Values$/ and $CustomFieldObj->Type !~ /Entry/) {
313                     my $cf_values = $Ticket->CustomFieldValues($cf);
314
315                     my %values_hash;
316                     foreach my $value (@values) {
317                         next unless length($value);
318
319                         # build up a hash of values that the new set has
320                         $values_hash{$value} = 1;
321
322                         unless ( $cf_values->HasEntry($value) ) {
323                             my ( $val, $msg ) = $Ticket->AddCustomFieldValue(
324                                 Field => $cf,
325                                 Value => $value
326                             );
327                             push ( @results, $msg );
328                         }
329
330                     }
331                     while ( my $cf_value = $cf_values->Next ) {
332                         unless ( $values_hash{ $cf_value->Content } == 1 ) {
333                             my ( $val, $msg ) = $Ticket->DeleteCustomFieldValue(
334                                 Field => $cf,
335                                 Value => $cf_value->Content
336                             );
337                             push ( @results, $msg);
338
339                         }
340
341                     }
342                 }
343                 elsif ( $arg =~ /-Values$/ ) {
344                     my $cf_values = $Ticket->CustomFieldValues($cf);
345
346                     # keep everything up to the point of difference, delete the rest
347                     my $delete_flag;
348                     foreach my $old_cf (@{$cf_values->ItemsArrayRef}) {
349                         if (!$delete_flag and @values and $old_cf->Content eq $values[0]) {
350                             shift @values;
351                             next;
352                         }
353
354                         $delete_flag ||= 1;
355                         $old_cf->Delete;
356                     }
357
358                     # now add/replace extra things, if any
359                     foreach my $value (@values) {
360                         my ( $val, $msg ) = $Ticket->AddCustomFieldValue(
361                             Field => $cf,
362                             Value => $value
363                         );
364                         push ( @results, $msg );
365                     }
366                 }
367                 else {
368                     push ( @results, "User asked for an unknown update type for custom field " . $cf->Name . " for ticket " . $Ticket->id );
369                 }
370             }
371         }
372         return (@results);
373     }
374 }
375
376 # }}}
377
378
379 1;