--- loncom/interface/londocs.pm 2008/12/21 15:47:50 1.314.2.2 +++ loncom/interface/londocs.pm 2008/11/17 14:46:10 1.315 @@ -1,7 +1,7 @@ # The LearningOnline Network # Documents # -# $Id: londocs.pm,v 1.314.2.2 2008/12/21 15:47:50 raeburn Exp $ +# $Id: londocs.pm,v 1.315 2008/11/17 14:46:10 jms Exp $ # # Copyright Michigan State University Board of Trustees # @@ -26,6 +26,22 @@ # http://www.lon-capa.org/ # + +=head1 NAME + +Apache::londocs + +=head1 SYNOPSIS + +This is part of the LearningOnline Network with CAPA project +described at http://www.lon-capa.org. + +=head1 SUBROUTINES + +=over + +=cut + package Apache::londocs; use strict; @@ -53,15 +69,27 @@ my %alreadyseen=(); my $hadchanges; -# Available help topics + +=pod + +=item %help=() + + Available help topics + +=cut my %help=(); -# Mapread read maps into LONCAPA::map:: global arrays -# @order and @resources, determines status -# sets @order - pointer to resources in right order -# sets @resources - array with the resources with correct idx -# +=pod + +=item mapread() + +Mapread read maps into LONCAPA::map:: global arrays +@order and @resources, determines status +sets @order - pointer to resources in right order +sets @resources - array with the resources with correct idx + +=cut sub mapread { my ($coursenum,$coursedom,$map)=@_; @@ -81,7 +109,14 @@ sub storemap { return ($errtext,0); } -# ----------------------------------------- Return hash with valid author names + +=pod + +=item authorhosts() + + Return hash with valid author names + +=cut sub authorhosts { my %outhash=(); @@ -116,7 +151,13 @@ sub authorhosts { } return ($home,$other,%outhash); } -# ------------------------------------------------------ Generate "dump" button +=pod + +=item dumpbutton() + + Generate "dump" button + +=cut sub dumpbutton { my ($home,$other,%outhash)=&authorhosts(); @@ -141,7 +182,14 @@ sub clean { $title=~s/[^\w\/\!\$\%\^\*\-\_\=\+\;\:\,\\\|\`\~]+/\_/gs; return $title; } -# -------------------------------------------------------- Actually dump course + +=pod + +=item dumpcourse() + + Actually dump course + +=cut sub dumpcourse { my ($r) = @_; @@ -263,7 +311,13 @@ sub dumpcourse { } } -# ------------------------------------------------------ Generate "export" button +=pod + +=item exportbutton() + + Generate "export" button + +=cut sub exportbutton { my $type = &Apache::loncommon::course_type(); @@ -273,6 +327,12 @@ sub exportbutton { &Apache::loncommon::help_open_topic('Docs_Export_Course_Docs').''; } +=pod + +=item exportcourse() + +=cut + sub exportcourse { my $r=shift; my $type = &Apache::loncommon::course_type(); @@ -911,8 +971,15 @@ sub store_template { } } -# Imports the given (name, url) resources into the course -# coursenum, coursedom, and folder must precede the list +=pod + +=item group_import() + + Imports the given (name, url) resources into the course + coursenum, coursedom, and folder must precede the list + +=cut + sub group_import { my ($coursenum, $coursedom, $folder, $container, $caller, @files) = @_; @@ -1073,10 +1140,12 @@ sub log_docs { } } +=pod + +=item docs_change_log() + +=cut -# -# Docs Change Log -# sub docs_change_log { my ($r)=@_; my $folder=$env{'form.folder'}; @@ -1280,32 +1349,8 @@ sub do_paste_from_buffer { if (($url=~/\.(page|sequence)$/) && ($url=~/^\/uploaded\//)) { $title=&mt('Copy of').' '.$title; my $newid=$$.time; - my ($oldid,$ext) = ($url=~/^(.+)\.(\w+)$/); - if ($oldid =~ m{^(/uploaded/\Q$coursedom\E/\Q$coursenum\E/)(\D+)(\d+)$}) { - my $path = $1; - my $prefix = $2; - my $ancestor = $3; - if (length($ancestor) > 10) { - $ancestor = substr($ancestor,-10,10); - } - $oldid = $path.$prefix.$ancestor; - } - my $counter = 0; - my $newurl=$oldid.$newid.'.'.$ext; - my $is_unique = &uniqueness_check($newurl); - while (!$is_unique && $counter < 100) { - $counter ++; - $newid ++; - $newurl = $oldid.$newid; - $is_unique = &uniqueness_check($newurl); - } - if (!$is_unique) { - if ($url=~/\.page$/) { - return &mt('Paste failed: an error occurred creating a unique URL for the composite page'); - } else { - return &mt('Paste failed: an error occurred creating a unique URL for the folder'); - } - } + $url=~/^(.+)\.(\w+)$/; + my $newurl=$1.$newid.'.'.$2; my $storefn=$newurl; $storefn=~s{^/\w+/$match_domain/$match_username/}{}; &Apache::lonclonecourse::writefile($env{'request.course.id'},$storefn, @@ -1354,20 +1399,6 @@ sub do_paste_from_buffer { # Store the result } -sub uniqueness_check { - my ($newurl) = @_; - my $unique = 1; - foreach my $res (@LONCAPA::map::order) { - my ($name,$url)=split(/\:/,$LONCAPA::map::resources[$res]); - $url=&LONCAPA::map::qtescape($url); - if ($newurl eq $url) { - $unique = 0; - last; - } - } - return $unique; -} - my %parameter_type = ( 'randompick' => 'int_pos', 'hiddenresource' => 'string_yesno', 'encrypturl' => 'string_yesno', @@ -1942,7 +1973,7 @@ END my $ro_set= ((&LONCAPA::map::getparameter($orderidx,'parameter_randomorder'))[0]=~/^yes$/i?' checked="checked"':''); $rand_order_text =' -'; +'; } if ($ispage) { my $pagename=&escape($pagetitle); @@ -2002,7 +2033,13 @@ ENDPARMS return $line; } -# ---------------------------------------------------------------- tie the hash +=pod + +=item tiehash() + +tie the hash + +=cut sub tiehash { my ($mode)=@_; @@ -2028,7 +2065,15 @@ sub untiehash { return OK; } -# --------------------------------------------------------------- check on this + +=pod + +=item checkonthis() + +check on this + +=cut + sub checkonthis { my ($r,$url,$level,$title)=@_; @@ -2102,9 +2147,15 @@ sub checkonthis { } -# -# ----------------------------------------------------------------- List Symbs -# + +=pod + +=item list_symbs() + +List Symbs + +=cut + sub list_symbs { my ($r) = @_; @@ -2120,9 +2171,14 @@ sub list_symbs { } -# -# -------------------------------------------------------------- Verify Content -# +=pod + +=item verifycontent() + +Verify Content + +=cut + sub verifycontent { my ($r) = @_; my $type = &Apache::loncommon::course_type(); @@ -2152,8 +2208,13 @@ sub verifycontent { &mt('Return to DOCS').''); } +=pod + +=item devalidateversioncache() & checkversions() -# -------------------------------------------------------------- Check Versions +Check Versions + +=cut sub devalidateversioncache { my $src=shift; @@ -2457,7 +2518,13 @@ sub changewarning { $help{'Caching'}.''."\n\n"); } -# =========================================== Breadcrumbs for special functions +=pod + +=item init_breadcrumbs() + +Breadcrumbs for special functions + +=cut sub init_breadcrumbs { my ($form,$text)=@_; @@ -2473,7 +2540,15 @@ sub init_breadcrumbs { bug=>'Instructor Interface'}); } -# ================================================================ Main Handler + +=pod + +=item handler() + +Main Handler + +=cut + sub handler { my $r = shift; &Apache::loncommon::content_type($r,'text/html'); @@ -3378,3 +3453,9 @@ ENDNEWSCRIPT } 1; __END__ + +=pod + +=back + +=cut