--- >

19c25 < --- > 22,31c28,29 < < --- > > 42,50c40,41 <

<
< < < < <

--- >

> Contact Information diff -r eprints-2.3.6/perl_lib/EPrints/AnApache.pm eprints-2.3.7/perl_lib/EPrints/AnApache.pm 68,72d67 < # hjm Thu Nov 27 16:08:35 GMT 2003 < # This is a workaround for what is apparently a bug in libapreq2-2.02-dev which < # truncates uploads at around 700K. This should use the bb interface when this < # bug is fixed. < 79,81c74 < require CGI; < < my $cgi = CGI->new; --- > my $cgi = $session->get_query; 92,94c85 < require CGI; < < my $cgi = CGI->new; --- > my $cgi = $session->get_query; 148c139 < my $upload = $session->get_apr->upload( $paramid ); --- > my $cgi = $session->get_query; 151,152c142,143 < $upload->fh, < $upload->filename ); --- > $cgi->upload( $paramid ), > $cgi->param( $paramid ) ); 159c150 < my $upload = $session->get_apr->upload( $paramid ); --- > my $cgi = $session->get_query; 162,163c153,154 < $upload->fh, < $upload->filename, --- > $cgi->upload( $paramid ), > $cgi->param( $paramid ), diff -r eprints-2.3.6/perl_lib/EPrints/Document.pm eprints-2.3.7/perl_lib/EPrints/Document.pm 1338,1344c1338,1340 < my $eprint = $self->get_eprint; < if( !defined $eprint ) < { < return ""; < } < my $words_file = $eprint->local_path."/". < $self->get_value( "docid" ).".words"; --- > my $words_file = $self->words_file; > return '' unless defined $words_file; > 1358a1355,1378 > > sub words_file > { > my( $self ) = @_; > return $self->cache_file( 'words' ); > } > > sub indexcodes_file > { > my( $self ) = @_; > return $self->cache_file( 'indexcodes' ); > } > > sub cache_file > { > my( $self, $suffix ) = @_; > > my $eprint = $self->get_eprint; > return unless( defined $eprint ); > > return $eprint->local_path."/". > $self->get_value( "docid" ).".".$suffix; > } > diff -r eprints-2.3.6/perl_lib/EPrints/EPrint.pm eprints-2.3.7/perl_lib/EPrints/EPrint.pm 871,872c871 < my @req_formats = @{$self->{session}->get_archive()->get_conf( < "required_formats" )}; --- > my @req_formats = $self->required_formats; 1053a1053,1079 > ###################################################################### > =pod > > =item @formats = $eprint->required_formats > > Return a list of the required formats for this > eprint. Only one of the required formats is required, not all. > > An empty list means no format is required. > > =cut > ###################################################################### > > sub required_formats > { > my( $self ) = @_; > > my $fmts = $self->{session}->get_archive()->get_conf( > "required_formats" ); > if( ref( $fmts ) ne "ARRAY" ) > { > # function pointer then... > $fmts = &{$fmts}($self->{session},$self); > } > > return @{$fmts}; > } 1295,1296c1321,1323 < It only makes sense to call this on eprints in the "archive" and < "deletion" datasets. --- > If called on inbox or buffer, remove the abstract page. > > Always create the symlinks for documents in the secure area. 1308,1314c1335,1342 < if( $ds_id ne "archive" && $ds_id ne "deletion" ) < { < $self->{session}->get_archive()->log( < "Attempt to generate static files for record ". < $eprintid." in dataset $ds_id (may only generate ". < "static for deletion and archive" ); < } --- > > # if( $ds_id ne "archive" && $ds_id ne "deletion" ) > # { > # $self->{session}->get_archive()->log( > # "Attempt to generate static files for record ". > # $eprintid." in dataset $ds_id (may only generate ". > # "static for deletion and archive" ); > # } 1354a1383,1388 > my @docs = $self->get_all_documents(); > foreach my $doc ( @docs ) > { > my $linkdir = EPrints::Document::_secure_symlink_path( $self ); > $doc->create_symlink( $self, $linkdir ); > } diff -r eprints-2.3.6/perl_lib/EPrints/MetaField/Basic.pm eprints-2.3.7/perl_lib/EPrints/MetaField/Basic.pm 151c151 < $th = $session->make_element( "th" ); --- > $th = $session->make_element( "th", class=>"empty_heading" ); 156c156 < $th = $session->make_element( "th" ); --- > $th = $session->make_element( "th", class=>"empty_heading" ); 217a218,227 > my $assist; > if( $self->{input_assist} ) > { > $assist = $session->make_doc_fragment; > $assist->appendChild( $session->render_internal_buttons( > $self->{name}."_assist" => > $session->phrase( > "lib/metafield:assist" ) ) ); > } > 220c230 < return $self->get_input_elements_single( --- > my $elements = $self->get_input_elements_single( 225a236,252 > if( defined $self->{input_advice_right} ) > { > my $advice = &{$self->{input_advice_right}}( $session, $self, $value ); > my $row = pop @{$elements}; > push @{$row}, { el=>$advice }; > push @{$elements}, $row; > } > if( defined $self->{input_advice_below} ) > { > my $advice = &{$self->{input_advice_below}}( $session, $self, $value ); > push @{$elements}, [ {el=>$advice,colspan=>3} ]; > } > if( defined $assist ) > { > push @{$elements}, [ {el=>$assist,colspan=>3} ]; > } > return $elements; 331c358,369 < push @{$rows}, [ $col1, @{$section->[$n]}, $lastcol ]; --- > my $row = [ $col1, @{$section->[$n]}, $lastcol ]; > if( defined $self->{input_advice_right} ) > { > my $advice = &{$self->{input_advice_right}}( $session, $self, $value->[$i-1] ); > push @{$row}, { el=>$advice }; > } > push @{$rows}, $row; > if( defined $self->{input_advice_below} ) > { > my $advice = &{$self->{input_advice_below}}( $session, $self, $value->[$i-1] ); > push @{$rows}, [ {},{el=>$advice,colspan=>3} ]; > } 344a383,386 > if( defined $assist ) > { > $more->appendChild( $assist ); > } 1119a1162,1164 > input_advice_right => $EPrints::MetaField::UNDEF, > input_advice_below => $EPrints::MetaField::UNDEF, > input_assist => 0, diff -r eprints-2.3.6/perl_lib/EPrints/MetaField/Fulltext.pm eprints-2.3.7/perl_lib/EPrints/MetaField/Fulltext.pm 70,71c70,71 < my $words_file = $eprint->local_path."/". $doc->get_value( "docid" ).".words"; < my $indexcodes_file = $eprint->local_path."/". $doc->get_value( "docid" ).".indexcodes"; --- > my $words_file = $doc->words_file; > my $indexcodes_file = $doc->indexcodes_file; 75,81c75 < if( !defined $s1[9] ) < { < # no words file! < return( [], [], [] ); < } < < if( defined $s2[9] && $s2[9] > $s1[9] ) --- > if( defined $s1[9] && defined $s2[9] && $s2[9] > $s1[9] ) diff -r eprints-2.3.6/perl_lib/EPrints/MetaField/Id.pm eprints-2.3.7/perl_lib/EPrints/MetaField/Id.pm 39a40,52 > sub get_search_conditions_not_ex > { > my( $self, $session, $dataset, $search_value, $match, $merge, > $search_mode ) = @_; > > return EPrints::SearchCondition->new( > '=', > $dataset, > $self, > $search_value ); > } > > diff -r eprints-2.3.6/perl_lib/EPrints/MetaField/Text.pm eprints-2.3.7/perl_lib/EPrints/MetaField/Text.pm 106c106 < return EPrints::SearchCondition->new( "TRUE" ); --- > return EPrints::SearchCondition->new( "PASS" ); diff -r eprints-2.3.6/perl_lib/EPrints/MetaField.pm eprints-2.3.7/perl_lib/EPrints/MetaField.pm 166a167,181 > # warn of non-applicable parameters; handy for spotting > # typos in the config file. > foreach my $p_id ( keys %properties ) > { > # skip warning on ID fields, it's not relevant > last if( $self->{type} eq "id" ); > # no warning if it's a valid param > next if( defined $self->{field_defaults}->{$p_id} ); > # these params are always valid but have no defaults > next if( $p_id eq "field_defaults" ); > next if( $p_id eq "archive" ); > next if( $p_id eq "dataset" ); > $self->{archive}->log( "Field '".$self->{name}."' has invalid parameter:\n$p_id => $properties{$p_id}" ); > } > diff -r eprints-2.3.6/perl_lib/EPrints/Rewrite.pm eprints-2.3.7/perl_lib/EPrints/Rewrite.pm 6,7d5 < use Apache::Request; < 24a23,24 > my $args = $r->args; > if( $args ne "" ) { $args = '?'.$args; } 68c68 < return redir( $r, sprintf( "%s/%d%s",$urlpath, $n, $tail ) ); --- > return redir( $r, sprintf( "%s/%d%s",$urlpath, $n, $tail ).$args ); 76c76 < return redir( $r, sprintf( "%s/archive/%08d%s",$urlpath, $n, $tail ) ); --- > return redir( $r, sprintf( "%s/archive/%08d%s",$urlpath, $n, $tail ).$args ); 92c92 < return redir( $r, sprintf( "%s/archive/%08d%s",$urlpath, $n, $tail )); --- > return redir( $r, sprintf( "%s/archive/%08d%s",$urlpath, $n, $tail ).$args); 98c98 < return redir( $r, sprintf( "%s/%d%s",$urlpath, $n, $tail ) ); --- > return redir( $r, sprintf( "%s/%d%s",$urlpath, $n, $tail ).$args ); diff -r eprints-2.3.6/perl_lib/EPrints/SearchCondition.pm eprints-2.3.7/perl_lib/EPrints/SearchCondition.pm 60a61,62 > 'CANPASS'=>0, # should only be used in optimisation > 'PASS'=>0, # should only be used in optimisation 90c92 < if( $op eq "AND" || $op eq "OR" ) --- > if( $op eq "AND" || $op eq "OR" || $op eq "CANPASS" ) 94c96 < elsif( $op eq "FALSE" || $op eq "TRUE" ) --- > elsif( $op eq "FALSE" || $op eq "TRUE" || $op eq "PASS" ) 233a236,243 > if( $self->{op} eq "PASS" ) > { > $item->get_session->get_archive->log( < PASS condition used in 'item_matches', should have been optimised! > END > return( 0 ); > } > 432a443,450 > if( $self->{op} eq "PASS" ) > { > $session->get_archive->log( < PASS condition used in 'process', should have been optimised! > END > return( 0 ); > } > 584,586c602 < < # cjg < # I'm not sure if this helps, but it doesn't hurt either. --- > # internal means don't strip canpass off the front. 589c605 < my( $self ) = @_; --- > my( $self, $internal ) = @_; 595c611 < $sub_op->optimise; --- > $sub_op->optimise( 1 ); 627a644,690 > > # strip passes or become a canpass if all pass > my $canpass = 1; > my $mustpass = 0; > my @passops = (); > my @sureops = (); > foreach my $sub_op ( @{$self->{sub_ops}} ) > { > if( $sub_op->{op} eq "PASS" ) > { > $mustpass = 1; > next; > } > if( $sub_op->{op} eq "CANPASS" ) > { > push @passops, $sub_op->{sub_ops}->[0]; > next; > } > push @sureops, $sub_op; > $canpass = 0; > } > if( $canpass ) > { > $self->{sub_ops} = \@passops; > } > else > { > $self->{sub_ops} = \@sureops; > } > > > # flatten sub opts with the same type > # so OR( A, OR( B, C ) ) becomes OR(A,B,C) > my $flat_ops = []; > foreach my $sub_op ( @{$self->{sub_ops}} ) > { > if( $sub_op->{op} eq $self->{op} ) > { > push @{$flat_ops}, > @{$sub_op->{sub_ops}}; > next; > } > > push @{$flat_ops}, $sub_op; > } > $self->{sub_ops} = $flat_ops; > 630a694,696 > # if an OR contains TRUE or an > # AND contains FALSE then we can > # cancel it all out. 642,648d707 < < if( $sub_op->{op} eq $self->{op} ) < { < push @{$self->{sub_ops}}, < @{$sub_op->{sub_ops}}; < next; < } 661a721,728 > > if( $canpass || $mustpass ) > { > my $newop = new EPrints::SearchCondition(); > $newop->copy_from( $self ); > $self->{op} = "CANPASS"; > $self->{sub_ops} = [ $newop ]; > } 663a731,742 > > # do final clean up stuff, if any > if( !$internal ) > { > if( $self->{op} eq "CANPASS" ) > { > my $sop = $self->{sub_ops}->[0]; > $self->copy_from( $sop ); > } > } > > diff -r eprints-2.3.6/perl_lib/EPrints/SearchExpression.pm eprints-2.3.7/perl_lib/EPrints/SearchExpression.pm 117c117,118 < "preamble_phrase", "title_phrase", "search_fields" ); --- > "preamble_phrase", "title_phrase", "search_fields", > "controls" ); 305a307,310 > $self->{controls} = {} unless( defined $self->{controls} ); > $self->{controls}->{top} = 0 unless( defined $self->{controls}->{top} ); > $self->{controls}->{bottom} = 1 unless( defined $self->{controls}->{bottom} ); > 501a507,510 > if( $self->{controls}->{top} ) > { > $form->appendChild( $self->render_controls ); > } 504,506d512 < my $div; < my $menu; < 509c515 < $menu = $self->{session}->render_option_list( --- > my $menu = $self->{session}->render_option_list( 531c537,549 < $div = $self->{session}->make_element( --- > if( $self->{controls}->{bottom} ) > { > $form->appendChild( $self->render_controls ); > } > > return( $form ); > } > > sub render_controls > { > my( $self ) = @_; > > my $div = $self->{session}->make_element( 539,541c557 < $form->appendChild( $div ); < < return( $form ); --- > return $div; 894d909 < 1030a1046 > my $cspan; 1041c1057,1059 < $bits{controls}->appendChild( $a ); --- > $cspan = $self->{session}->make_element( 'span', class=>"searchcontrol" ); > $cspan->appendChild( $a ); > $bits{controls}->appendChild( $cspan ); 1050c1068,1070 < $bits{controls}->appendChild( $a ); --- > $cspan = $self->{session}->make_element( 'span', class=>"searchcontrol" ); > $cspan->appendChild( $a ); > $bits{controls}->appendChild( $cspan ); 1055c1075,1077 < $bits{controls}->appendChild( $a ); --- > $cspan = $self->{session}->make_element( 'span', class=>"searchcontrol" ); > $cspan->appendChild( $a ); > $bits{controls}->appendChild( $cspan ); 1066c1088,1090 < $bits{controls}->appendChild( $a ); --- > $cspan = $self->{session}->make_element( 'span', class=>"searchcontrol" ); > $cspan->appendChild( $a ); > $bits{controls}->appendChild( $cspan ); 1701c1725,1726 < if( !defined $offset && !defined $count ) --- > # quick solutions if we don't need to order anything... > if( !defined $offset && !defined $count && !defined $self->{order} ) 1717,1719d1741 < < # we are returning all matches, but there's no < # easy shortcut. 1720a1743,1746 > > # If the above tests failed then > # we are returning all matches, but there's no > # easy shortcut. Ah well.. diff -r eprints-2.3.6/perl_lib/EPrints/Session.pm eprints-2.3.7/perl_lib/EPrints/Session.pm 100d99 < use Apache::Cookie; 102a102 > use CGI; 145c145 < $self->{apr} = Apache::Request->new( $self->{request} ); --- > $self->{query} = new CGI; 246,259c246,249 < # First choice is from param... < < # my $apr = Apache::Request->new( $request ); < # my $asked_lang = $apr->param("lang"); < # if( EPrints::Utils::is_set( $asked_lang ) ) < # { < # push @prefs, $asked_lang; < # } < #print STDERR "DEBUG: ".$apr->param("stage")."\n"; < < # Second choice is cookie < my $cookies = Apache::Cookie->fetch( $request ); #hash ref < my $cookie = $cookies->{$archive->get_conf( "lang_cookie_name")}; < if( defined $cookie ) --- > my $cookies = EPrints::AnApache::header_in( > $request, > 'Cookie' ); > if( defined $cookies ) 261c251,258 < push @prefs, $cookie->value; --- > foreach my $cookie ( split( /;\s*/, $cookies ) ) > { > my( $k, $v ) = split( '=', $cookie ); > if( $k eq $archive->get_conf( "lang_cookie_name") ) > { > push @prefs, $v; > } > } 263a261 > # then look at the accept language header 317c315 < sub get_apr --- > sub get_query 321c319 < return $self->{apr}; --- > return $self->{query}; 1943c1941 < my $value = ( $self->{apr}->param( $name ) ); --- > my $value = ( $self->{query}->param( $name ) ); 1952c1950 < @result = $self->{apr}->param( $name ); --- > @result = $self->{query}->param( $name ); 1956c1954 < @result = $self->{apr}->param; --- > @result = $self->{query}->param; 2369c2367 < "must-revalidate" ); --- > "no-store, no-cache, must-revalidate" ); 2376c2374 < my $cookie = Apache::Cookie->new( $self->{request}, --- > my $cookie = $self->{query}->cookie( 2382c2380 < $cookie->bake; --- > $self->{request}->header_out( "Set-Cookie"=>$cookie ); diff -r eprints-2.3.6/perl_lib/EPrints/SubmissionForm.pm eprints-2.3.7/perl_lib/EPrints/SubmissionForm.pm 272a273,281 > if( $self->{session}->get_archive->get_conf( 'log_submission_timing' ) ) > { > if( $stage ne "meta" ) > { > $self->log_submission_stage($stage); > } > # meta gets logged after pageid is worked out > } > 323a333,356 > =pod > > =item $submissionform->log_submission_stage > > undocumented > > =cut > ###################################################################### > > sub log_submission_stage > { > my( $self, $stage ) = @_; > > my $fn = EPrints::Config::get("var_path")."/submission_timings.".$self->{session}->get_archive->get_id.".log"; > unless( open( SLOG, ">>$fn" ) ) > { > $self->{session}->get_archive->log( "Could not append to $fn" ); > } > my @data = ( time, $self->{eprintid}, $self->{user}->get_id, $stage, $self->{action} ); > print SLOG join( "\t", @data )."\n"; > close SLOG; > } > > ###################################################################### 414a448 > $self->{eprintid} = $self->{eprint}->get_id; 1437a1472,1476 > if( $self->{session}->get_archive->get_conf( 'log_submission_timing' ) ) > { > $self->log_submission_stage( "meta.".$self->{pageid} ); > } > 1593c1632 < my @reqformats = @{$self->{session}->get_archive()->get_conf( "required_formats" )}; --- > my @reqformats = $self->{eprint}->required_formats; 1623a1663,1667 > my $buttoncode = "lib/submissionform:action_newdoc"; > if( scalar @docs == 0 ) > { > $buttoncode = "lib/submissionform:action_firstdoc"; > } 1625,1626c1669 < newdoc => $self->{session}->phrase( < "lib/submissionform:action_newdoc" ) ) ); --- > newdoc => $self->{session}->phrase( $buttoncode ) ) ); diff -r eprints-2.3.6/perl_lib/EPrints/User.pm eprints-2.3.7/perl_lib/EPrints/User.pm 564a565 > custom_order => "-datestamp", 579a581,583 > $searchexp->{custom_order}="-datestamp"; > $searchexp->{order} = $EPrints::SearchExpression::CustomOrder; > diff -r eprints-2.3.6/perl_lib/EPrints/Utils.pm eprints-2.3.7/perl_lib/EPrints/Utils.pm 1703c1703 < if( $_ == 44 || $_ == 45 || $_ == 46 || $_ == 58 ) { push @out, $_; next; } --- > if( $_ == 44 || $_ == 45 || $_ == 46 || $_ == 58 || $_ == 95 ) { push @out, $_; next; } diff -r eprints-2.3.6/perl_lib/EPrints/VLit.pm eprints-2.3.7/perl_lib/EPrints/VLit.pm 81c81,83 < my $apr = Apache::Request->new( $r ); --- > my %args = $r->args; > my $version = $args{xuversion}; > my $locspec = $args{locspec}; 83,86c85 < my $version = $apr->param( "xuversion" ); < my $locspec = $apr->param( "locspec" ); < < if( !defined $version && !defined $apr->param( "mode" ) ) --- > if( !defined $version && !defined $args{mode} ) 125c124 < &$fn( $filename, $lsparam, $locspec, $r, $apr, $baseurl ); --- > &$fn( $filename, $lsparam, $locspec, $r, $baseurl ); 192c191 < =item EPrints::VLit::ls_charrange( $filename, $param, $locspec, $r, $apr, $baseurl ) --- > =item EPrints::VLit::ls_charrange( $filename, $param, $locspec, $r, $baseurl ) 201c200 < my( $filename, $param, $locspec, $r, $apr, $baseurl ) = @_; --- > my( $filename, $param, $locspec, $r, $baseurl ) = @_; 227c226,227 < my $mode = $apr->param( "mode" ); --- > my %args = $r->args; > my $mode = $args{mode}; 438c438 < =item EPrints::VLit::ls_area( $file, $param, $resspec, $r, $apr, $baseurl ) --- > =item EPrints::VLit::ls_area( $file, $param, $resspec, $r, $baseurl ) 447c447 < my( $file, $param, $resspec, $r, $apr, $baseurl ) = @_; --- > my( $file, $param, $resspec, $r, $baseurl ) = @_; 455a456 > my %args = $r->args; 457c458 < if( $apr->param( "scale" ) ) --- > if( $args{scale} ) 459c460 < $s = $apr->param( "scale" ); --- > $s = $args{scale};