Return to renamefile.pl CVS log

Up to [Local Repository] / db / prgsrc

Annotation of db/prgsrc/renamefile.pl, revision 1.2

1.1       boris       1: #!/usr/local/bin/perl -w
                      2: 
                      3: =head1 NAME
                      4: 
                      5: renamefile.pl - renaming file in database
                      6: 
                      7: =head1 SYNOPSIS
                      8: 
                      9: renamefile.pl  I<source> I<target>
                     10: 
                     11: 
                     12: =head1 DESCRIPTION
                     13: 
                     14: The script will rename source to target in the database
                     15: 
                     16: 
                     17: 
                     18: =head1 BUGS
                     19: 
                     20: The database, user and password are hardcoded. 
                     21: 
                     22: =head1 SEE ALSO
                     23: 
                     24: createindex.pl(1), updatedb.pl(1), updateindex.pl(1), deletefiles.pl(1)
                     25: 
                     26: =head1 AUTHOR
                     27: 
                     28: Boris Veytsman
                     29: 
1.2     ! boris      30: =head1 $Id: renamefile.pl,v 1.1 2001/07/28 21:31:37 boris Exp $
1.1       boris      31: 
                     32: =cut
                     33: 
                     34:     use strict;
                     35: 
                     36: use DBI;
                     37: 
                     38: MAIN: 
                     39: {
                     40:     my $USAGE="Usage: renamefile.pl source target\n";
                     41:     if (scalar @ARGV <=> 2) {
                     42:        die $USAGE;
                     43:     }
                     44:     my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "") 
                     45:        or die "Can't connect to DB chgk\n";
                     46: 
                     47:     my ($source,$target)=@ARGV;
                     48:     my $sth=$dbh->prepare("
                     49:          select Title from Tournaments where
                     50:          Type='þ' and FileName='$source'");
                     51:     $sth->execute;
                     52:     if(!$sth->rows) {
                     53:        print STDERR "There is no file $source in the database\n";
1.2     ! boris      54:        $sth->finish;
        !            55:        $dbh->disconnect;
1.1       boris      56:        exit 1;
                     57:     }
                     58:     my ($Title)=$sth->fetchrow;
                     59:     $sth=$dbh->prepare("
                     60:          select Title from Tournaments where
                     61:          Type='þ' and FileName='$target'");
                     62:     $sth->execute;
                     63:     if($sth->rows) {
                     64:        ($Title)=$sth->fetchrow;
                     65:        print STDERR "The file $source already exists. The title is $Title\n";
1.2     ! boris      66:        $sth->finish;
        !            67:        $dbh->disconnect;
1.1       boris      68:        exit 1;
                     69:     }
                     70:     
                     71:     $sth=$dbh->prepare("
                     72:        update Tournaments set FileName='$target' where Filename='$source'");
                     73:     $sth->execute;
                     74:     
                     75:     $dbh->disconnect;
                     76:     exit 0;
                     77: }
                     78: