View | Details | Raw Unified | Return to bug 36367
Collapse All | Expand All

(-)a/C4/Context.pm (-57 / +1 lines)
Lines 19-25 package C4::Context; Link Here
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
21
22
use vars qw($AUTOLOAD $context @context_stack);
22
use vars qw($AUTOLOAD $context);
23
BEGIN {
23
BEGIN {
24
    if ( $ENV{'HTTP_USER_AGENT'} ) { # Only hit when plack is not enabled
24
    if ( $ENV{'HTTP_USER_AGENT'} ) { # Only hit when plack is not enabled
25
25
Lines 79-96 This module takes care of setting up the context for a script: Link Here
79
figuring out which configuration file to load, and loading it, opening
79
figuring out which configuration file to load, and loading it, opening
80
a connection to the right database, and so forth.
80
a connection to the right database, and so forth.
81
81
82
Most scripts will only use one context. They can simply have
83
84
  use C4::Context;
85
86
at the top.
87
88
Other scripts may need to use several contexts. For instance, if a
89
library has two databases, one for a certain collection, and the other
90
for everything else, it might be necessary for a script to use two
91
different contexts to search both databases. Such scripts should use
92
the C<&set_context> and C<&restore_context> functions, below.
93
94
By default, C4::Context reads the configuration from
82
By default, C4::Context reads the configuration from
95
F</etc/koha/koha-conf.xml>. This may be overridden by setting the C<$KOHA_CONF>
83
F</etc/koha/koha-conf.xml>. This may be overridden by setting the C<$KOHA_CONF>
96
environment variable to the pathname of a configuration file to use.
84
environment variable to the pathname of a configuration file to use.
Lines 116-122 environment variable to the pathname of a configuration file to use. Link Here
116
#     A connection object for the Zebra server
104
#     A connection object for the Zebra server
117
105
118
$context = undef;        # Initially, no context is set
106
$context = undef;        # Initially, no context is set
119
@context_stack = ();        # Initially, no saved contexts
120
107
121
sub import {
108
sub import {
122
    # Create the default context ($C4::Context::Context)
109
    # Create the default context ($C4::Context::Context)
Lines 196-209 sub new { Link Here
196
or
183
or
197
  set_context C4::Context $context;
184
  set_context C4::Context $context;
198
185
199
  ...
200
  restore_context C4::Context;
201
202
In some cases, it might be necessary for a script to use multiple
203
contexts. C<&set_context> saves the current context on a stack, then
204
sets the context to C<$context>, which will be used in future
205
operations. To restore the previous context, use C<&restore_context>.
206
207
=cut
186
=cut
208
187
209
#'
188
#'
Lines 230-268 sub set_context Link Here
230
        $new_context = $self;
209
        $new_context = $self;
231
    }
210
    }
232
211
233
    # Save the old context, if any, on the stack
234
    push @context_stack, $context if defined($context);
235
236
    # Set the new context
212
    # Set the new context
237
    $context = $new_context;
213
    $context = $new_context;
238
}
214
}
239
215
240
=head2 restore_context
241
242
  &restore_context;
243
244
Restores the context set by C<&set_context>.
245
246
=cut
247
248
#'
249
sub restore_context
250
{
251
    my $self = shift;
252
253
    if ($#context_stack < 0)
254
    {
255
        # Stack underflow.
256
        die "Context stack underflow";
257
    }
258
259
    # Pop the old context and set it.
260
    $context = pop @context_stack;
261
262
    # FIXME - Should this return something, like maybe the context
263
    # that was current when this was called?
264
}
265
266
=head2 config
216
=head2 config
267
217
268
  $value = C4::Context->config("config_variable");
218
  $value = C4::Context->config("config_variable");
Lines 700-708 sub new_dbh Link Here
700
  ...
650
  ...
701
  C4::Connect->restore_dbh;
651
  C4::Connect->restore_dbh;
702
652
703
C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
704
C<&set_context> and C<&restore_context>.
705
706
C<&set_dbh> saves the current database handle on a stack, then sets
653
C<&set_dbh> saves the current database handle on a stack, then sets
707
the current database handle to C<$my_dbh>.
654
the current database handle to C<$my_dbh>.
708
655
Lines 746-754 sub restore_dbh Link Here
746
693
747
    # Pop the old database handle and set it.
694
    # Pop the old database handle and set it.
748
    $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
695
    $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
749
750
    # FIXME - If it is determined that restore_context should
751
    # return something, then this function should, too.
752
}
696
}
753
697
754
=head2 userenv
698
=head2 userenv
(-)a/misc/cronjobs/cloud-kw.pl (-5 / +3 lines)
Lines 27-33 use Pod::Usage qw( pod2usage ); Link Here
27
use Getopt::Long qw( GetOptions );
27
use Getopt::Long qw( GetOptions );
28
28
29
use Koha::Script -cron;
29
use Koha::Script -cron;
30
use C4::Context;
30
use C4::Context qw($context);
31
use C4::Log qw( cronlogaction );
31
use C4::Log qw( cronlogaction );
32
32
33
my $verbose     = 0;
33
my $verbose     = 0;
Lines 58-63 eval { Link Here
58
};
58
};
59
croak "Unable to read configuration file: $conf\n" if $@;
59
croak "Unable to read configuration file: $conf\n" if $@;
60
60
61
my $original_context = $C4::Context::context;
61
for my $cloud ( @clouds ) {
62
for my $cloud ( @clouds ) {
62
    print "Create a cloud\n",
63
    print "Create a cloud\n",
63
          "  Koha conf file:  ", $cloud->{KohaConf} ? $cloud->{KohaConf} : "default", "\n",
64
          "  Koha conf file:  ", $cloud->{KohaConf} ? $cloud->{KohaConf} : "default", "\n",
Lines 69-80 for my $cloud ( @clouds ) { Link Here
69
      if $verbose;  
70
      if $verbose;  
70
71
71
    # Set Koha context if KohaConf is present
72
    # Set Koha context if KohaConf is present
72
    my $set_new_context = 0;
73
    if ( $cloud->{KohaConf} ) {
73
    if ( $cloud->{KohaConf} ) {
74
        if ( -e $cloud->{KohaConf} ) {
74
        if ( -e $cloud->{KohaConf} ) {
75
            my $context = C4::Context->new( $cloud->{KohaConf} );
75
            my $context = C4::Context->new( $cloud->{KohaConf} );
76
            $context->set_context();
76
            $context->set_context();
77
            $set_new_context = 1;
78
        }
77
        }
79
        else {
78
        else {
80
            carp "Koha conf file doesn't exist: ", $cloud->{KohaConf}, " ; use KOHA_CONF\n";
79
            carp "Koha conf file doesn't exist: ", $cloud->{KohaConf}, " ; use KOHA_CONF\n";
Lines 90-97 for my $cloud ( @clouds ) { Link Here
90
    my $withcss = $cloud->{Withcss} =~ /^yes/i;
89
    my $withcss = $cloud->{Withcss} =~ /^yes/i;
91
    print $fh $index->html_cloud( $cloud->{KohaIndex}, $withcss );
90
    print $fh $index->html_cloud( $cloud->{KohaIndex}, $withcss );
92
    close $fh;
91
    close $fh;
93
    $set_new_context && restore_context C4::Context;
94
}
92
}
93
$original_context->set_context;
95
94
96
cronlogaction({ action => 'End', info => "COMPLETED" });
95
cronlogaction({ action => 'End', info => "COMPLETED" });
97
96
98
- 

Return to bug 36367