lib/TWiki/Compatibility.pm
author Colas Nahaboo <colas@nahaboo.net>
Sat, 26 Jan 2008 15:50:53 +0100
changeset 0 414e01d06fd5
child 2 7bc60a767fa4
permissions -rw-r--r--
RELEASE 4.2.0 freetown
     1 # Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
     2 #
     3 # Copyright (C) 1999-2007 TWiki Contributors.
     4 # All Rights Reserved. TWiki Contributors
     5 # are listed in the AUTHORS file in the root of this distribution.
     6 # NOTE: Please extend that file, not this notice.
     7 #
     8 # This program is free software; you can redistribute it and/or
     9 # modify it under the terms of the GNU General Public License
    10 # as published by the Free Software Foundation; either version 2
    11 # of the License, or (at your option) any later version. For
    12 # more details read LICENSE in the root of this distribution.
    13 #
    14 # This program is distributed in the hope that it will be useful,
    15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
    16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    17 #
    18 # As per the GPL, removal of this notice is prohibited.
    19 #
    20 package TWiki::Compatibility;
    21 
    22 use Assert;
    23 
    24 =pod
    25 
    26 ---+ package TWiki::Compatibility
    27 
    28 Support for compatibility with old TWiki versions. Packaged
    29 separately because 99.999999% of the time this won't be needed.
    30 
    31 =cut
    32 
    33 sub _upgradeCategoryItem {
    34     my ( $catitems, $ctext ) = @_;
    35     my $catname = '';
    36     my $scatname = '';
    37     my $catmodifier = '';
    38     my $catvalue = '';
    39     my @cmd = split( /\|/, $catitems );
    40     my $src = '';
    41     my $len = @cmd;
    42     if( $len < '2' ) {
    43         # FIXME
    44         return ( $catname, $catmodifier, $catvalue )
    45     }
    46     my $svalue = '';
    47 
    48     my $i;
    49     my $itemsPerLine;
    50 
    51     # check for CategoryName=CategoryValue parameter
    52     my $paramCmd = '';
    53     my $cvalue = ''; # was$query->param( $cmd[1] );
    54     if( $cvalue ) {
    55         $src = "<!---->$cvalue<!---->";
    56     } elsif( $ctext ) {
    57         foreach( split( /\r?\n/, $ctext ) ) {
    58             if( /$cmd[1]/ ) {
    59                 $src = $_;
    60                 last;
    61             }
    62         }
    63     }
    64 
    65     if( $cmd[0] eq 'select' || $cmd[0] eq 'radio') {
    66         $catname = $cmd[1];
    67         $scatname = $catname;
    68         #$scatname =~ s/[^a-zA-Z0-9]//g;
    69         my $size = $cmd[2];
    70         for( $i = 3; $i < $len; $i++ ) {
    71             my $value = $cmd[$i];
    72             $svalue = $value;
    73             if( $src =~ /$value/ ) {
    74                $catvalue = $svalue;
    75             }
    76         }
    77 
    78     } elsif( $cmd[0] eq 'checkbox' ) {
    79         $catname = $cmd[1];
    80         $scatname = $catname;
    81         #$scatname =~ s/[^a-zA-Z0-9]//g;
    82         if( $cmd[2] eq 'true' || $cmd[2] eq '1' ) {
    83             $i = $len - 4;
    84             $catmodifier = 1;
    85         }
    86         $itemsPerLine = $cmd[3];
    87         for( $i = 4; $i < $len; $i++ ) {
    88             my $value = $cmd[$i];
    89             $svalue = $value;
    90             # I18N: FIXME - need to look at this, but since it's upgrading
    91             # old forms that probably didn't use I18N, it's not a high
    92             # priority.
    93             if( $src =~ /$value[^a-zA-Z0-9\.]/ ) {
    94                 $catvalue .= ", " if( $catvalue );
    95                 $catvalue .= $svalue;
    96             }
    97         }
    98 
    99     } elsif( $cmd[0] eq 'text' ) {
   100         $catname = $cmd[1];
   101         $scatname = $catname;
   102         #$scatname =~ s/[^a-zA-Z0-9]//g;
   103         $src =~ /<!---->(.*)<!---->/;
   104         if( $1 ) {
   105             $src = $1;
   106         } else {
   107             $src = '';
   108         }
   109         $catvalue = $src;
   110     }
   111 
   112     return ( $catname, $catmodifier, $catvalue )
   113 }
   114 
   115 =pod
   116 
   117 ---++ StaticMethod upgradeCategoryTable( $session, $web, $topic, $meta, $text ) -> $text
   118 
   119 Upgrade old style category table
   120 
   121 May throw TWiki::OopsException
   122 
   123 =cut
   124 
   125 sub upgradeCategoryTable {
   126     my( $session, $web, $topic, $meta, $text ) = @_;
   127 
   128     my $icat = $session->templates->readTemplate( 'twikicatitems' );
   129 
   130     if( $icat ) {
   131         my @items = ();
   132         # extract category section and build category form elements
   133         my( $before, $ctext, $after) = split( /<!--TWikiCat-->/, $text );
   134         # cut TWikiCat part
   135         $text = $before || '';
   136         $text .= $after if( $after );
   137         $ctext = '' if( ! $ctext );
   138 
   139         my $ttext = '';
   140         foreach( split( /\r?\n/, $icat ) ) {
   141             my( $catname, $catmod, $catvalue ) = _upgradeCategoryItem( $_, $ctext );
   142             if( $catname ) {
   143                 push @items, ( [$catname, $catmod, $catvalue] );
   144             }
   145         }
   146         my $prefs = $session->{prefs};
   147         my $listForms = $prefs->getWebPreferencesValue( 'WEBFORMS', $web );
   148         $listForms =~ s/^\s*//go;
   149         $listForms =~ s/\s*$//go;
   150         my @formTemplates = split( /\s*,\s*/, $listForms );
   151         my $defaultFormTemplate = '';
   152         $defaultFormTemplate = $formTemplates[0] if ( @formTemplates );
   153 
   154         if( ! $defaultFormTemplate ) {
   155             $session->writeWarning( "Form: can't get form definition to convert category table " .
   156                                   " for topic $web.$topic" );
   157             foreach my $oldCat ( @items ) {
   158                 my $name = $oldCat->[0];
   159                 my $value = $oldCat->[2];
   160                 $meta->put( 'FORM', { name => '' } );
   161                 $meta->putKeyed( 'FIELD',
   162                             { name => $name,
   163                               title => $name,
   164                               value => $value
   165                             } );
   166             }
   167             return;
   168         }
   169 
   170         require TWiki::Form;
   171         my $def = new TWiki::Form($session, $web, $defaultFormTemplate );
   172         $meta->put( 'FORM', { name => $defaultFormTemplate } );
   173 
   174         foreach my $fieldDef ( @{$def->getFields()} ) {
   175             my $value = '';
   176             foreach my $oldCatP ( @items ) {
   177                 my @oldCat = @$oldCatP;
   178                 my $name = $oldCat[0] || '';
   179                 $name =~ s/[^A-Za-z0-9_\.]//go;
   180                 if( $name eq $fieldDef->{name} ) {
   181                     $value = $oldCat[2];
   182                     last;
   183                 }
   184             }
   185             $meta->putKeyed( 'FIELD',
   186                              {
   187                               name => $fieldDef->{name},
   188                               title => $fieldDef->{title},
   189                               value => $value,
   190                              } );
   191         }
   192 
   193     } else {
   194         $session->writeWarning( "Form: get find category template twikicatitems for Web $web" );
   195     }
   196     return $text;
   197 }
   198 
   199 #Get file attachment attributes for old html
   200 #format.
   201 sub _getOldAttachAttr {
   202     my( $session, $atext ) = @_;
   203     my $fileName='';
   204 	my $filePath='';
   205 	my $fileSize='';
   206 	my $fileDate='';
   207 	my $fileUser='';
   208 	my $fileComment='';
   209     my $before='';
   210 	my $item='';
   211 	my $after='';
   212     my $users = $session->{users};
   213 
   214     ( $before, $fileName, $after ) = split( /<(?:\/)*TwkFileName>/, $atext );
   215     if( ! $fileName ) { $fileName = ''; }
   216     if( $fileName ) {
   217         ( $before, $filePath,    $after ) = split( /<(?:\/)*TwkFilePath>/, $atext );
   218         if( ! $filePath ) { $filePath = ''; }
   219         $filePath =~ s/<TwkData value="(.*)">//go;
   220         if( $1 ) { $filePath = $1; } else { $filePath = ''; }
   221         $filePath =~ s/\%NOP\%//goi;   # delete placeholder that prevents WikiLinks
   222         ( $before, $fileSize,    $after ) = split( /<(?:\/)*TwkFileSize>/, $atext );
   223         if( ! $fileSize ) { $fileSize = '0'; }
   224         ( $before, $fileDate,    $after ) = split( /<(?:\/)*TwkFileDate>/, $atext );
   225         if( ! $fileDate ) { 
   226             $fileDate = '';
   227         } else {
   228             $fileDate =~ s/&nbsp;/ /go;
   229             require TWiki::Time;
   230             $fileDate = TWiki::Time::parseTime( $fileDate );
   231         }
   232         ( $before, $fileUser, $after ) = split( /<(?:\/)*TwkFileUser>/, $atext );
   233         if( ! $fileUser ) {
   234             $fileUser = '';
   235         } else {
   236             $fileUser = $users->getLoginName($fileUser) if $fileUser;
   237         }
   238         $fileUser =~ s/ //go;
   239         ( $before, $fileComment, $after ) = split( /<(?:\/)*TwkFileComment>/, $atext );
   240         if( ! $fileComment ) { $fileComment = ''; }
   241     }
   242 
   243     return ( $fileName, $filePath, $fileSize, $fileDate, $fileUser, $fileComment );
   244 }
   245 
   246 =pod
   247 
   248 ---++ migrateToFileAttachmentMacro ( $session, $meta, $text  ) -> $text
   249 
   250 Migrate old HTML format
   251 
   252 =cut
   253 
   254 sub migrateToFileAttachmentMacro {
   255     my ( $session, $meta, $text ) = @_;
   256     ASSERT($meta->isa( 'TWiki::Meta')) if DEBUG;
   257 
   258     my ( $before, $atext, $after ) = split( /<!--TWikiAttachment-->/, $text );
   259     $text = $before || '';
   260     $text .= $after if( $after );
   261     $atext  = '' if( ! $atext  );
   262 
   263     if( $atext =~ /<TwkNextItem>/ ) {
   264         my $line = '';
   265         foreach $line ( split( /<TwkNextItem>/, $atext ) ) {
   266             my( $fileName, $filePath, $fileSize, $fileDate, $fileUser, $fileComment ) =
   267               _getOldAttachAttr( $session, $line );
   268 
   269             if( $fileName ) {
   270                 $meta->putKeyed( 'FILEATTACHMENT',
   271                             {
   272                              name    => $fileName,
   273                              version => '',
   274                              path    => $filePath,
   275                              size    => $fileSize,
   276                              date    => $fileDate,
   277                              user    => $fileUser,
   278                              comment => $fileComment,
   279                              attr    => ''
   280                             });
   281             }
   282         }
   283     } else {
   284         # Format of macro that came before META:ATTACHMENT
   285         my $line = '';
   286         require TWiki::Attrs;
   287         foreach $line ( split( /\r?\n/, $atext ) ) {
   288             if( $line =~ /%FILEATTACHMENT{\s"([^"]*)"([^}]*)}%/ ) {
   289                 my $name = $1;
   290                 my $values = new TWiki::Attrs( $2 );
   291                 $values->{name} = $name;
   292                 $meta->putKeyed( 'FILEATTACHMENT', $values );
   293             }
   294         }
   295     }
   296 
   297     return $text;
   298 }
   299 
   300 =pod
   301 
   302 ---++ upgradeFrom1v0beta ( $session, $meta  ) -> $text
   303 
   304 =cut
   305 
   306 sub upgradeFrom1v0beta {
   307     my( $session, $meta ) = @_;
   308     my $users = $session->{users};
   309     require TWiki::Time;
   310 
   311     my @attach = $meta->find( 'FILEATTACHMENT' );
   312     foreach my $att ( @attach ) {
   313         my $date = $att->{date} || 0;
   314         if( $date =~ /-/ ) {
   315             $date =~ s/&nbsp;/ /go;
   316             $date = TWiki::Time::parseTime( $date );
   317         }
   318         $att->{date} = $date;
   319         $att->{user} = $users->webDotWikiName($att->{user});
   320     }
   321 }
   322 
   323 1;