[Openinteract-commits] CVS: OpenInteract/pkg/base_page/script scan_for_new.pl,NONE,1.1

[Chris W. <la...@us...>]

Update of /cvsroot/openinteract/OpenInteract/pkg/base_page/script
In directory usw-pr-cvs1:/tmp/cvs-serv14979/script

Added Files:
	scan_for_new.pl 
Log Message:
added script to scan a directory for new files and add them


--- NEW FILE: scan_for_new.pl ---
#!/usr/bin/perl -w

# $Id: scan_for_new.pl,v 1.1 2001/11/26 06:28:18 lachoy Exp $

use strict;
use Class::Date qw( now );
use File::Find;
use OpenInteract::Startup;

use constant DEBUG => 1;

my $NOW                 = now;
my $DATE_PATTERN        = '%Y-%m-%d';
my $DEFAULT_ACTIVE_DAYS = 365;

my ( %EXISTING, %NEW );
my ( @OPT_skip );
my ( $OPT_root, $OPT_debug, $OPT_active_days );

{
    my %opts = ( 'skip=s'   => \@OPT_skip,
                 'root=s'   => \$OPT_root,
                 'active=s' => \$OPT_active_days,
                 'debug'    => \$OPT_debug );
    my $R = OpenInteract::Startup->setup_static_environment_options( '', \%opts );

    $OPT_root ||= $R->CONFIG->get_dir( 'html' );
    unless ( $OPT_root =~ m|/$| ) { $OPT_root = "$OPT_root/" }

    $OPT_active_days ||= $DEFAULT_ACTIVE_DAYS;
    $OPT_debug ||= DEBUG;

    %EXISTING = map { $_ => 1 }
                    @{ $R->page->db_select({ select => [ 'location' ],
                                             return => 'single-list' }) };
    find( \&descend, $OPT_root );

    foreach my $location ( sort keys %NEW ) {
        my %page_info = get_page_info( $R, $location );
        add_new_location( $R, $location, \%page_info );
        $OPT_debug && warn "--Added new location $location\n";
    }

}


sub descend {
    my $filename = $_;
    my $full_dir = $File::Find::dir;
    $full_dir =~ s/^$OPT_root//;
    for ( @OPT_skip ) { return if ( $full_dir =~ /$_/ ) }
    my $location = '/' . join( '/', $full_dir, $filename );
    return if ( $EXISTING{ $location } );
    $NEW{ $location }++;
}


sub get_page_info {
    my ( $R, $location ) = @_;
    my %info = ();
    my $full_filename = join( '/', $OPT_root, $location );
    open( FILE, $full_filename ) || die "Cannot open ($full_filename): $!";

    while ( <FILE> ) {
        $info{title} = $1 if ( m|<title>(.*?)</title>| );
    }
    close( FILE );
    return %info;
}


sub add_new_location {
    my ( $R, $location, $page_info ) = @_;
    my $expire_date = $NOW + "${OPT_active_days}D";
    $R->page->new({ location   => $location,
                    mime_type  => 'text/html',
                    title      => $page_info->{title},
                    is_active  => 'yes',
                    active_on  => $NOW->strftime( $DATE_PATTERN ),
                    expires_on => $expire_date->strftime( $DATE_PATTERN ) })
            ->save();
}

__END__

=pod

=head1 NAME

scan_for_new.pl - Scan for new pages in a tree and add new ones to the database

=head1 SYNOPSIS

 $ export OIWEBSITE=/home/httpd/mysite
 $ perl scan_for_new --skip=^images

=head1 DESCRIPTION

This script scans a directory tree (by default the tree with 'html/'
as the root in your website directory) and adds any new files to the
database.

=head1 BUGS

None known.

=head1 TO DO

Nothing known.

=head1 SEE ALSO

=head1 COPYRIGHT

Copyright (c) 2001 intes.net, inc.. All rights reserved.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHORS

Chris Winters <ch...@cw...>

=cut