#!/usr/bin/perl #Migrate tCMS1 data to tCMS2 flat file data model use strict; use warnings; use JSON::MaybeXS; use File::Slurper(); use HTML::Parser; use UUID::Tiny ':std'; use File::Copy; use DateTime; #Edit this to be whatever you need it to be my $docroot = "/var/www/teodesian.net/doc"; my $dir = "/var/www/teodesian.net/doc/microblog/"; opendir( my $dh, $dir ) or die; my @days = grep { !/^\./ } readdir $dh; closedir $dh; my $ring = JSON::MaybeXS->new(); foreach my $day (@days) { opendir( my $dht, "$dir/$day" ) or die; my @times = grep { !/^\./ } readdir $dht; closedir $dht; my ( $month, $date, $year ) = split( /\./, $day ); foreach my $time (@times) { my ( $hour, $min, $sec ) = split( /:/, $time ); my $data; my $file = "$dir/$day/$time"; print "Migrate $file\n"; eval { my $content = File::Slurper::read_text($file); $data = $ring->decode($content); $data = json_remap($data); }; $data = html_post($file) unless $data; my $dt = DateTime->new( year => $year + 2000, month => $month, day => $date, hour => $hour, minute => $min, second => $sec, ); $data->{created} = $dt->epoch(); $data->{id} = $data->{created}; $data->{tags} = [ 'public', 'news' ]; $data->{version} = 0; open( my $fh, '>', "data/files/$data->{created}" ) or die; print $fh encode_json( [$data] ); close $fh; } } # Migrate blog posts $dir = "$docroot/blog"; opendir( my $bh, $dir ) or die; my @blogs = grep { -f "$dir/$_" } readdir $bh; closedir $bh; my $offset = 0; foreach my $post ( sort { my $anum = $a =~ m/^(\d*)-/; my $bnum = $b =~ m/^(\d*)-/; $b <=> $a } @blogs ) { my $postname = $post; $postname =~ s/^\d*-//g; $postname =~ s/\.post$//g; my $content = File::Slurper::read_text("$dir/$post"); my $data = { title => $postname, data => $content, tags => [ 'blog', 'public' ], }; my ( undef, undef, undef, undef, $uid, undef, undef, undef, undef, $ctime ) = stat("$dir/$post"); my $user = lc( getpwuid($uid) ); $user = scalar( grep { $user eq $_ } qw{/sbin/nologin www-data} ) ? 'nobody' : $user; $data->{user} = $user; $ctime += $offset; $data->{created} = $ctime; $data->{id} = $ctime; $data->{href} = "/blog/$ctime"; $data->{version} = 0; print "Migrate blog post '$post'\n"; open( my $fh, '>', "data/files/$data->{created}" ) or die; print $fh encode_json( [$data] ); close $fh; $offset--; } exit 0; my $vdir = "$docroot/fileshare/video"; opendir( my $vh, $vdir ) or die; my @vidyas = grep { -f "$vdir/$_" && $_ =~ m/\.m4v$/ } readdir $vh; closedir $vh; foreach my $vid (@vidyas) { my $postname = $vid; $postname =~ s/_/ /g; $postname =~ s/\.mv4$//g; my $data = { title => $postname, data => "Description forthcoming", tags => [ 'video', 'public' ], preview => "/img/sys/testpattern.jpg", }; my ( undef, undef, undef, undef, $uid, undef, undef, undef, undef, $ctime ) = stat("$vdir/$vid"); my $user = lc( getpwuid($uid) ); $user = scalar( grep { $user eq $_ } qw{/sbin/nologin www-data} ) ? 'nobody' : $user; $data->{user} = $user; $data->{created} = $ctime; $data->{id} = $ctime; $data->{href} = "/assets/$ctime-$vid"; $data->{version} = 0; #Copy over the video File::Copy::copy( "$vdir/$vid", "www/assets/$ctime-$vid" ); print "Migrate video '$vid'\n"; open( my $fh, '>', "data/files/$data->{created}" ) or die; print $fh encode_json( [$data] ); close $fh; } sub json_remap { my $json = shift; return { preview => $json->{"image"}, data => $json->{"comment"}, user => lc( $json->{"poster"} ), title => $json->{"title"}, audio_href => $json->{"audio"}, href => $json->{"url"}, video_href => $json->{"video"}, }; } sub html_post { my $file = shift; my $is_first_link = 1; my $data = { data => '', href => '' }; my $p = HTML::Parser->new( handlers => [ start => [ sub { my ( $self, $attr, $text, $tagname ) = @_; if ( $tagname eq 'a' && $is_first_link ) { $data->{href} = $attr->{href}; return; } return if $is_first_link; return if $tagname eq 'hr'; $data->{data} .= $text; }, 'self, attr, text,tagname' ], text => [ sub { my ( $self, $attr, $text, $tagname ) = @_; if ($is_first_link) { $data->{title} .= $text; return; } $data->{data} .= $text; }, 'self, attr, text,tagname' ], end => [ sub { my ( $self, $attr, $text, $tagname ) = @_; if ( $tagname eq 'a' && $is_first_link ) { $is_first_link = 0; return; } return if $is_first_link; $data->{data} .= $text; }, 'self, attr, text,tagname' ], ], ); $p->parse_file($file); #Get the user name from ownership my ( undef, undef, undef, undef, $uid, undef, undef, undef, undef, $ctime ) = stat($file); my $user = lc( getpwuid($uid) ); $user = scalar( grep { $user eq $_ } qw{/sbin/nologin www-data} ) ? 'nobody' : $user; $data->{user} = $user; $data->{created} = $ctime; return $data; }