Attachment #167383 for bug #36367

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





use Modern::Perl;

use vars qw($AUTOLOAD $context);
BEGIN {
    if ( $ENV{'HTTP_USER_AGENT'} ) { # Only hit when plack is not enabled


figuring out which configuration file to load, and loading it, opening
a connection to the right database, and so forth.

Most scripts will only use one context. They can simply have

  use C4::Context;

at the top.

Other scripts may need to use several contexts. For instance, if a
library has two databases, one for a certain collection, and the other
for everything else, it might be necessary for a script to use two
different contexts to search both databases. Such scripts should use
the C<&set_context> and C<&restore_context> functions, below.

By default, C4::Context reads the configuration from
F</etc/koha/koha-conf.xml>. This may be overridden by setting the C<$KOHA_CONF>
environment variable to the pathname of a configuration file to use.

#     A connection object for the Zebra server

$context = undef;        # Initially, no context is set
@context_stack = ();        # Initially, no saved contexts

sub import {
    # Create the default context ($C4::Context::Context)

or
  set_context C4::Context $context;

  ...
  restore_context C4::Context;

In some cases, it might be necessary for a script to use multiple
contexts. C<&set_context> saves the current context on a stack, then
sets the context to C<$context>, which will be used in future
operations. To restore the previous context, use C<&restore_context>.

=cut

#'

        $new_context = $self;
    }

    # Save the old context, if any, on the stack
    push @context_stack, $context if defined($context);

    # Set the new context
    $context = $new_context;
}

=head2 restore_context

  &restore_context;

Restores the context set by C<&set_context>.

=cut

#'
sub restore_context
{
    my $self = shift;

    if ($#context_stack < 0)
    {
        # Stack underflow.
        die "Context stack underflow";
    }

    # Pop the old context and set it.
    $context = pop @context_stack;

    # FIXME - Should this return something, like maybe the context
    # that was current when this was called?
}

=head2 config

  $value = C4::Context->config("config_variable");

  ...
  C4::Connect->restore_dbh;

C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
C<&set_context> and C<&restore_context>.

C<&set_dbh> saves the current database handle on a stack, then sets
the current database handle to C<$my_dbh>.



    # Pop the old database handle and set it.
    $context->{"dbh"} = pop @{$context->{"dbh_stack"}};

    # FIXME - If it is determined that restore_context should
    # return something, then this function should, too.
}

=head2 userenv




use Getopt::Long qw( GetOptions );

use Koha::Script -cron;
use C4::Context qw($context);
use C4::Log qw( cronlogaction );

my $verbose     = 0;

};
croak "Unable to read configuration file: $conf\n" if $@;

my $original_context = $C4::Context::context;
for my $cloud ( @clouds ) {
    print "Create a cloud\n",
          "  Koha conf file:  ", $cloud->{KohaConf} ? $cloud->{KohaConf} : "default", "\n",

      if $verbose;  

    # Set Koha context if KohaConf is present
    my $set_new_context = 0;
    if ( $cloud->{KohaConf} ) {
        if ( -e $cloud->{KohaConf} ) {
            my $context = C4::Context->new( $cloud->{KohaConf} );
            $context->set_context();
            $set_new_context = 1;
        }
        else {
            carp "Koha conf file doesn't exist: ", $cloud->{KohaConf}, " ; use KOHA_CONF\n";

    my $withcss = $cloud->{Withcss} =~ /^yes/i;
    print $fh $index->html_cloud( $cloud->{KohaIndex}, $withcss );
    close $fh;
    $set_new_context && restore_context C4::Context;
}
$original_context->set_context;

cronlogaction({ action => 'End', info => "COMPLETED" });

- 

Return to bug 36367

Lines 19-25 package C4::Context; Link Here

(-)a/C4/Context.pm (-57 / +1 lines)
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

Lines 27-33 use Pod::Usage qw( pod2usage ); Link Here

(-)a/misc/cronjobs/cloud-kw.pl (-5 / +3 lines)
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	-